From 1ae749b25fc37508dcce7549b95122f5a336511e Mon Sep 17 00:00:00 2001
From: Matt Wette <matt.wette@gmail.com>
Date: Wed, 15 Feb 2017 19:58:29 -0800
Subject: [PATCH] nyacc: I think cpp is working now

---
 module/nyacc/lang/c99/body.scm           | 27 +++++++-----------------
 module/nyacc/lang/c99/mach.d/c99act.scm  |  4 ++--
 module/nyacc/lang/c99/mach.d/c99xact.scm |  4 ++--
 module/nyacc/lang/c99/mach.scm           | 19 ++++++++---------
 4 files changed, 21 insertions(+), 33 deletions(-)

diff --git a/module/nyacc/lang/c99/body.scm b/module/nyacc/lang/c99/body.scm
index 5c1db345..511b7d34 100644
--- a/module/nyacc/lang/c99/body.scm
+++ b/module/nyacc/lang/c99/body.scm
@@ -355,14 +355,6 @@
 	      ((pragma) #t) ;; ignore for now
 	      (else (error "bad cpp flow stmt"))))
 
-	  (define (eval-cpp-stmt/code stmt)
-	    (with-throw-handler
-	     'cpp-error
-	     (lambda () (eval-cpp-stmt-1/code stmt))
-	     (lambda (key fmt . rest)
-	       (report-error fmt rest)
-	       (throw 'c99-error "CPP error"))))
-
 	  (define (eval-cpp-stmt-1/file stmt)
 	    (case (car stmt)
 	      ((if) (cpi-push))
@@ -389,15 +381,17 @@
 	      ((pragma) #t) ;; need to work this
 	      (else (error "bad cpp flow stmt"))))
 	    
-	  (define (eval-cpp-stmt/file stmt)
+	  (define (eval-cpp-stmt stmt)
 	    (with-throw-handler
 	     'cpp-error
-	     (lambda () (eval-cpp-stmt-1/file stmt))
+	     (lambda ()
+	       (case mode
+		 ((code) (eval-cpp-stmt-1/code stmt))
+		 ((file) (eval-cpp-stmt-1/file stmt))))
 	     (lambda (key fmt . rest)
 	       (report-error fmt rest)
 	       (throw 'c99-error "CPP error"))))
 
-
 	  ;; Composition of @code{read-cpp-line} and @code{eval-cpp-line}.
 	  ;; We should not be doing this!
 	  (define (read-cpp-stmt ch)
@@ -416,13 +410,10 @@
  		 ((read-comm ch #t) => assc-$)
 		 ((read-cpp-stmt ch) =>
 		  (lambda (stmt)
+		    (eval-cpp-stmt stmt)
 		    (case mode
-		      ((code)
-		       (eval-cpp-stmt/code stmt)
-		       (iter (read-char)))
-		      ((file)
-		       (eval-cpp-stmt/file stmt)
-		       (assc-$ `(cpp-stmt ,stmt))))))
+		      ((code) (iter (read-char)))
+		      ((file) (assc-$ `(cpp-stmt . ,stmt))))))
 		 (else (iter ch))))
 	       ((read-ident ch) =>
 		(lambda (name)
@@ -453,10 +444,8 @@
 
 	  ;; Loop between reading tokens and skipping tokens via CPP logic.
 	  (let iter ((pair (read-token)))
-	    ;;(simple-format #t "iter ~S\n" (car ppxs)) (sleep 1)
 	    (case (car ppxs)
 	      ((keep)
-	       ;;(simple-format #t "lx=>~S\n" pair)
 	       pair)
 	      ((skip-done skip-look)
 	       (iter (read-token)))
diff --git a/module/nyacc/lang/c99/mach.d/c99act.scm b/module/nyacc/lang/c99/mach.d/c99act.scm
index 859c3e78..b6398085 100644
--- a/module/nyacc/lang/c99/mach.d/c99act.scm
+++ b/module/nyacc/lang/c99/mach.d/c99act.scm
@@ -704,7 +704,7 @@
    ;; external-declaration-list => external-declaration-list external-decla...
    (lambda ($2 $1 . $rest)
      (if (eqv? (sx-tag $2) 'extern-block)
-       (tl-extend $1 (sx-tail $2 2))
+       (tl-extend $1 (sx-tail $2 1))
        (tl-append $1 $2)))
    ;; external-declaration => function-definition
    (lambda ($1 . $rest) $1)
@@ -762,7 +762,7 @@
    ;; lone-comment => '$lone-comm
    (lambda ($1 . $rest) `(comment ,$1))
    ;; cpp-statement => 'cpp-stmt
-   (lambda ($1 . $rest) $1)
+   (lambda ($1 . $rest) `(cpp-stmt ,$1))
    ;; pragma => 'cpp-pragma
    (lambda ($1 . $rest) $1)
    ))
diff --git a/module/nyacc/lang/c99/mach.d/c99xact.scm b/module/nyacc/lang/c99/mach.d/c99xact.scm
index 666fc5f2..f9c6e12f 100644
--- a/module/nyacc/lang/c99/mach.d/c99xact.scm
+++ b/module/nyacc/lang/c99/mach.d/c99xact.scm
@@ -704,7 +704,7 @@
    ;; external-declaration-list => external-declaration-list external-decla...
    (lambda ($2 $1 . $rest)
      (if (eqv? (sx-tag $2) 'extern-block)
-       (tl-extend $1 (sx-tail $2 2))
+       (tl-extend $1 (sx-tail $2 1))
        (tl-append $1 $2)))
    ;; external-declaration => function-definition
    (lambda ($1 . $rest) $1)
@@ -762,7 +762,7 @@
    ;; lone-comment => '$lone-comm
    (lambda ($1 . $rest) `(comment ,$1))
    ;; cpp-statement => 'cpp-stmt
-   (lambda ($1 . $rest) $1)
+   (lambda ($1 . $rest) `(cpp-stmt ,$1))
    ;; pragma => 'cpp-pragma
    (lambda ($1 . $rest) $1)
    ))
diff --git a/module/nyacc/lang/c99/mach.scm b/module/nyacc/lang/c99/mach.scm
index 4c776f05..a58e1c76 100644
--- a/module/nyacc/lang/c99/mach.scm
+++ b/module/nyacc/lang/c99/mach.scm
@@ -429,13 +429,12 @@
      )
 
     (parameter-declaration
-     (declaration-specifiers declarator
-			     ($$ `(param-decl ,(tl->list $1)
-					       (param-declr ,$2))))
-     (declaration-specifiers abstract-declarator
-			     ($$ `(param-decl ,(tl->list $1)
-					       (param-declr ,$2))))
-     (declaration-specifiers ($$ `(param-decl ,(tl->list $1))))
+     (declaration-specifiers
+      declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
+     (declaration-specifiers
+      abstract-declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
+     (declaration-specifiers
+      ($$ `(param-decl ,(tl->list $1))))
      )
 
     (identifier-list
@@ -614,7 +613,7 @@
      (external-declaration-list
       external-declaration
       ;; A ``kludge'' to deal with @code{extern "C" ...}:
-      ($$ (if (eqv? (sx-tag $2) 'extern-block) (tl-extend $1 (sx-tail $2 2))
+      ($$ (if (eqv? (sx-tag $2) 'extern-block) (tl-extend $1 (sx-tail $2 1))
 	      (tl-append $1 $2))))
      )
 
@@ -645,7 +644,7 @@
      (declaration-list declaration ($$ (tl-append $1 $2)))
      )
 
-    (opt-code-comment () (code-comment))
+    (opt-code-comment ($empty) (code-comment))
 
     ;; non-terminal leaves
     (identifier
@@ -660,7 +659,7 @@
      (string-literal $string ($$ (tl-append $1 $2))))
     (code-comment ($code-comm ($$ `(comment ,$1))))
     (lone-comment ($lone-comm ($$ `(comment ,$1))))
-    (cpp-statement ('cpp-stmt))
+    (cpp-statement ('cpp-stmt ($$ `(cpp-stmt ,$1))))
     (pragma ('cpp-pragma))
     )))