andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mes: Fix for pmatch on bootstrappable syntax-rules. 

* 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)
(if (pair? 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))
((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))

49
tests/pmatch.test
View File

@ -41,26 +41,33 @@ exit $?
(pmatch o
(_ o))))
(pass-if-equal "pmatch" "main"
(let ((ast '(fctn-defn
(decl-spec-list (type-spec (fixed-type "int")))
(ftn-declr
(ident "main")
(param-list
(param-decl
(decl-spec-list (type-spec (fixed-type "int")))
(param-declr (ident "argc")))
(param-decl
(decl-spec-list (type-spec (fixed-type "char")))
(param-declr
(ptr-declr (pointer) (array-of (ident "argv")))))))
(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))))
(pass-if-equal "pmatch nyacc minimal" "main"
(let* ((ast '(("main") PARAM-LIST))
(mets (pmatch ast
(((,name) _) name))))
;;(format (current-error-port) "mets: ~s\n" mets)
mets))
(pass-if-equal "pmatch nyacc" "main"
(let ((ast '(fctn-defn
(decl-spec-list (type-spec (fixed-type "int")))
(ftn-declr
(ident "main")
(param-list
(param-decl
(decl-spec-list (type-spec (fixed-type "int")))
(param-declr (ident "argc")))
(param-decl
(decl-spec-list (type-spec (fixed-type "char")))
(param-declr
(ptr-declr (pointer) (array-of (ident "argv")))))))
(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)