artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Fix for pmatch on bootstrappable syntax-rules.

Browse source 
* module/mes/pmatch.scm (ppat): Do not use let.
* tests/pmatch.test ("pmatch nyacc minimal", "pmatch nyacc"): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-12-09 15:04:32 +01:00
parent 49de95fe5d
commit 2aafee0163
2 changed files with 30 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
module/mes/pmatch.scm
View file

@ -77,6 +77,7 @@
((_ v (x . y) kt kf) ((_ v (x . y) kt kf)
(if (pair? v) (if (pair? v)
(let ((vx (car v)) (vy (cdr v))) (let ((vx (car v)) (vy (cdr v)))
(ppat vx x (ppat vy y kt kf) kf)) ;;(ppat vx x (ppat vy y kt kf) kf) ;; FIXME: broken with syntax.scm
(ppat (car v) x (ppat (cdr v) y kt kf) kf))
kf)) kf))
((_ v lit kt kf) (if (eq? v (quote lit)) kt kf)))) ((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))

49
tests/pmatch.test
View file

@ -41,26 +41,33 @@ exit $?
(pmatch o (pmatch o
(_ o)))) (_ o))))
(pass-if-equal "pmatch" "main" (pass-if-equal "pmatch nyacc minimal" "main"
(let ((ast '(fctn-defn (let* ((ast '(("main") PARAM-LIST))
(decl-spec-list (type-spec (fixed-type "int"))) (mets (pmatch ast
(ftn-declr (((,name) _) name))))
(ident "main") ;;(format (current-error-port) "mets: ~s\n" mets)
(param-list mets))
(param-decl
(decl-spec-list (type-spec (fixed-type "int"))) (pass-if-equal "pmatch nyacc" "main"
(param-declr (ident "argc"))) (let ((ast '(fctn-defn
(param-decl (decl-spec-list (type-spec (fixed-type "int")))
(decl-spec-list (type-spec (fixed-type "char"))) (ftn-declr
(param-declr (ident "main")
(ptr-declr (pointer) (array-of (ident "argv"))))))) (param-list
(compd-stmt (param-decl
(block-item-list (decl-spec-list (type-spec (fixed-type "int")))
(if (gt (p-expr (ident "argc")) (p-expr (fixed "1"))) (param-declr (ident "argc")))
(return (p-expr (ident "argc")))) (param-decl
(return (p-expr (fixed "42")))))))) (decl-spec-list (type-spec (fixed-type "char")))
(pmatch ast (param-declr
((fctn-defn _ (ftn-declr (ident ,name) _) _) name) (ptr-declr (pointer) (array-of (ident "argv")))))))
(_ 'bla)))) (compd-stmt
(block-item-list
(if (gt (p-expr (ident "argc")) (p-expr (fixed "1")))
(return (p-expr (ident "argc"))))
(return (p-expr (fixed "42"))))))))
(pmatch ast
((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
(_ 'bla))))
(result 'report) (result 'report)