mes: Fix for pmatch on bootstrappable syntax-rules.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 9 Dec 2017 14:04:32 +0000 (15:04 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 9 Dec 2017 14:04:32 +0000 (15:04 +0100)
* module/mes/pmatch.scm (ppat): Do not use let.
* tests/pmatch.test ("pmatch nyacc minimal", "pmatch nyacc"): Test it.

module/mes/pmatch.scm
tests/pmatch.test

index ef782a8b105618e7da2bae80353551a106e86ea3..207cdb527bf3b14cac4d4c05b5505480ae3f1c53 100644 (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))))
index f59b66deedd240165333d5708f1a6ff869ff764e..0e045841f32bfdd0dfd099b61d47912f527d6a19 100755 (executable)
@@ -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)