nyacc: I think cpp is working now

diff --git a/module/nyacc/lang/c99/body.scm b/module/nyacc/lang/c99/body.scm
index 5c1db34524940b3d34e49026be48ec48dc7dbb64..511b7d34bb619af3a9b77895fb9f3dcc804f1f16 100644 (file)
--- 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 859c3e789afdb5a6018d05ecf2af8b994714108e..b63980851fbb222e17364856868cb163f24806a3 100644 (file)
--- 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 666fc5f280d0f12ed5cda6589ebaa1dac0c064a0..f9c6e12f7a0c3ce8be53c0b9d6a204f2530204b0 100644 (file)
--- 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 4c776f0544d8dfaf7fdd047b11ece9767c8bac23..a58e1c762b7baf09c0f70502f390bda271dca7e5 100644 (file)
--- 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))
     )))