From 2aafee0163c37c1efa9dcaafcb5da1bb9392db41 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 9 Dec 2017 15:04:32 +0100
Subject: [PATCH] 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.
---
 module/mes/pmatch.scm |  3 ++-
 tests/pmatch.test     | 49 ++++++++++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 22 deletions(-)

diff --git a/module/mes/pmatch.scm b/module/mes/pmatch.scm
index ef782a8b..207cdb52 100644
--- a/module/mes/pmatch.scm
+++ b/module/mes/pmatch.scm
@@ -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))))
diff --git a/tests/pmatch.test b/tests/pmatch.test
index f59b66de..0e045841 100755
--- a/tests/pmatch.test
+++ b/tests/pmatch.test
@@ -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)