nyacc: exceptions worked on.. still need to fix #

module/nyacc/README.nyacc

@@ -1,4 +1,4 @@
-This is a version 0.74.2 of NYACC (Not Yet Another Compiler Compiler!).
+This is a version 0.74.2+fixes of NYACC (Not Yet Another Compiler Compiler!).
 
 Copyright (C) 2015-2017 Matthew R. Wette
 

module/nyacc/lalr.scm

@@ -52,7 +52,7 @@
   #:use-module (nyacc util)
   )
 
-(define *nyacc-version* "0.74.2")
+(define *nyacc-version* "0.74.2+fixes")
 
 
 ;; @deffn proxy-? sym rhs

module/nyacc/lang/c99/body.scm

@@ -206,8 +206,9 @@
   (apply throw 'c99-error args))
 
 ;; @deffn read-cpp-line ch => #f | (cpp-xxxx)??
-;; Given if ch is #\# read a cpp-statement
-;; includes BUG: #define ABC 123 /* \n
+;; Given if ch is #\# read a cpp-statement.
+;; The standard implies that comments are tossed here but we keep them
+;; so that they can end up in the pretty-print output.
 (define (read-cpp-line ch)
   (if (not (eq? ch #\#)) #f
       (let iter ((cl '()) (ch (read-char)))
@@ -228,7 +229,6 @@
 		  (let ((c2 (read-char)))
 		    (if (eqv? c2 #\/)
 			(iter (cons* #\/ #\* cl2) (read-char)) ;; keep comment
-			;;(iter cl (read-char)) ;; toss comment
 			(iter2 (cons #\* cl2) c2))))
 		 (else
 		  (iter2 (cons ch cl2) (read-char))))))
@@ -320,6 +320,7 @@
 		      (exp (parse-cpp-expr rhs)))
 		 (eval-cpp-expr exp defs)))
 	     (lambda (key fmt . args)
+	       (display "body.323\n")
 	       (report-error fmt args)
 	       (throw 'c99-error "CPP error"))))
 	    
@@ -385,16 +386,22 @@
 		 (set! ppxs (cons 'skip1-pop (cdr ppxs))))
 		(else (cpi-pop))))
 	      ((error)
-	       stmt)
+	       (if (exec-cpp-stmts?) (report-error "CPP error: ~S" (cdr stmt))))
+	      ((pragma)
+	       ;; standard says implementation-defined if line is expanded
+	       #t)
 	      (else
 	       (error "unhandled cpp stmt")))
-	    (cons 'cpp-stmt stmt))
+	    (case (car stmt)
+	      ((pragma) (cons 'cpp-pragma (cdr stmt)))
+	      (else (cons 'cpp-stmt stmt))))
 	  
 	  (define (eval-cpp-line line)
 	    (with-throw-handler
 	     'cpp-error
 	     (lambda () (eval-cpp-stmt (read-cpp-stmt line)))
 	     (lambda (key fmt . rest)
+	       (display "body.399\n")
 	       (report-error fmt rest)
 	       (throw 'c99-error "CPP error"))))
 

module/nyacc/lang/c99/mach.d/c99act.scm

@@ -714,6 +714,8 @@
    (lambda ($1 . $rest) $1)
    ;; external-declaration => cpp-statement
    (lambda ($1 . $rest) $1)
+   ;; external-declaration => pragma
+   (lambda ($1 . $rest) $1)
    ;; external-declaration => "extern" '$string "{" external-declaration-li...
    (lambda ($5 $4 $3 $2 $1 . $rest)
      `(extern-block
@@ -721,6 +723,9 @@
         (extern-begin ,$2)
         ,@(sx-tail (tl->list $4) 1)
         (extern-end)))
+   ;; external-declaration => ";"
+   (lambda ($1 . $rest)
+     `(decl (@ (not-C99 . "GNU C"))))
    ;; function-definition => declaration-specifiers declarator declaration-...
    (lambda ($4 $3 $2 $1 . $rest)
      `(knr-fctn-defn
@@ -758,7 +763,9 @@
    ;; lone-comment => '$lone-comm
    (lambda ($1 . $rest) `(comment ,$1))
    ;; cpp-statement => 'cpp-stmt
-   (lambda ($1 . $rest) `(cpp-stmt ,$1))
+   (lambda ($1 . $rest) $1)
+   ;; pragma => 'cpp-pragma
+   (lambda ($1 . $rest) $1)
    ))
 
 ;;; end tables

module/nyacc/lang/c99/mach.d/c99xact.scm

@@ -714,6 +714,8 @@
    (lambda ($1 . $rest) $1)
    ;; external-declaration => cpp-statement
    (lambda ($1 . $rest) $1)
+   ;; external-declaration => pragma
+   (lambda ($1 . $rest) $1)
    ;; external-declaration => "extern" '$string "{" external-declaration-li...
    (lambda ($5 $4 $3 $2 $1 . $rest)
      `(extern-block
@@ -721,6 +723,9 @@
         (extern-begin ,$2)
         ,@(sx-tail (tl->list $4) 1)
         (extern-end)))
+   ;; external-declaration => ";"
+   (lambda ($1 . $rest)
+     `(decl (@ (not-C99 . "GNU C"))))
    ;; function-definition => declaration-specifiers declarator declaration-...
    (lambda ($4 $3 $2 $1 . $rest)
      `(knr-fctn-defn
@@ -758,7 +763,9 @@
    ;; lone-comment => '$lone-comm
    (lambda ($1 . $rest) `(comment ,$1))
    ;; cpp-statement => 'cpp-stmt
-   (lambda ($1 . $rest) `(cpp-stmt ,$1))
+   (lambda ($1 . $rest) $1)
+   ;; pragma => 'cpp-pragma
+   (lambda ($1 . $rest) $1)
    ))
 
 ;;; end tables

module/nyacc/lang/c99/mach.scm

@@ -622,9 +622,11 @@
      (declaration)
      (lone-comment)
      (cpp-statement)
+     (pragma)
      ("extern" $string "{" external-declaration-list "}"
       ($$ `(extern-block ,$2 (extern-begin ,$2)
 			 ,@(sx-tail (tl->list $4) 1) (extern-end))))
+     (";" ($$ `(decl (@ (not-C99 . "GNU C")))))
      )
     
     (function-definition
@@ -656,8 +658,8 @@
      (string-literal $string ($$ (tl-append $1 $2))))
     (code-comment ($code-comm ($$ `(comment ,$1))))
     (lone-comment ($lone-comm ($$ `(comment ,$1))))
-    (cpp-statement ('cpp-stmt ($$ `(cpp-stmt ,$1))))
-
+    (cpp-statement ('cpp-stmt))
+    (pragma ('cpp-pragma))
     )))
 
 

module/nyacc/lang/c99/parser.scm

@@ -48,11 +48,13 @@
 			   (cons 'rto-v rto-v) (cons 'mtab mtab)
 			   (cons 'act-v act-v)))))
     (lambda* (lexer #:key (debug #f))
-
-      (with-throw-handler
+      (catch
        'nyacc-error
        (lambda () (c99-parser lexer #:debug debug))
-       (lambda (key fmt . args) (apply throw 'c99-error fmt args)))
+       (lambda (key fmt . args)
+	 (report-error fmt args)
+	 (pop-input)			; not sure this is the right way
+	 (throw 'c99-error "C99 parse error")))
       )))
 
 ;; This is used to parse included files at top level.