nyacc: lex fixes for char-lit

module/nyacc/lang/c99/BUGS

@@ -1,11 +1,13 @@
-C99-008	<= next id
+BUGs and TODOs
+
+C99-009	<= next id
+
+C99-008	02 Mar 2017, M.Wette
+	clean up error traps among raw-parser run-parse and parse-c99[x]
 
 C99-007	16 Feb 2017, M.Wette
 	cpp.scm: does __LINE__ get expanded?
 
-C99-006	06 Aug 2016, M.Wette
-        code "val = '\0';" gets pprinted to "val = '^@;';"
-
 C99-005	26 Jun 2016, M.Wette
 	in util2.scm, tree->udecl needs to return "struct" and "union"
 	entries for stuff like
@@ -38,5 +40,8 @@ C99-002 CPP redesign is not working for ifdef and defined:
 	      (lambda (iden)
 25Jun16 fixed
 
+C99-006	06 Aug 2016, M.Wette
+        code "val = '\0';" gets pprinted to "val = '^@;';"
+02Mar17	fixed, V0.76.5+c99dev
 
 --- last line ---

module/nyacc/lang/c99/parser.scm

@@ -39,19 +39,18 @@
 ;; Parse given a token generator.  Uses fluid @code{*info*}.
 ;; A little ugly wrt re-throw but
 (define raw-parser
-  (let ((c99-parser (make-lalr-parser
+  (let ((parser (make-lalr-parser
 		     (list (cons 'len-v len-v) (cons 'pat-v pat-v)
 			   (cons 'rto-v rto-v) (cons 'mtab mtab)
 			   (cons 'act-v act-v)))))
     (lambda* (lexer #:key (debug #f))
       (catch
        'nyacc-error
-       (lambda () (c99-parser lexer #:debug debug))
+       (lambda () (parser lexer #:debug debug))
        (lambda (key fmt . args)
 	 (report-error fmt args)
 	 (pop-input)			; not sure this is the right way
-	 (throw 'c99-error "C99 parse error")))
+	 (throw 'c99-error "C99 parse error"))))))
-      )))
 
 ;; This is used to parse included files at top level.
 (define (run-parse)

module/nyacc/lang/c99/pprint.scm

@@ -57,6 +57,26 @@
 	   cond assn-expr)
     (nonassoc)))
 
+;; @deffn {Procedure} scmchs->c scm-chr-str => c-chr-str
+;; Convert 1-char scheme string into 1-char C string constant as typed by user.
+;; That is, exscaped.
+;; @example
+;; (scmchstr->c "#x00") => "\\0"
+;; @end example
+;; @end deffn
+(define (scmchs->c scm-chr-str)
+  (let ((ch (string-ref scm-chr-str 0)))
+    (case ch
+      ((#\nul) "\\0")
+      ((#\alarm) "\\a")
+      ((#\backspace) "\\b")
+      ((#\tab) "\\t")
+      ((#\newline) "\\n")
+      ((#\vtab) "\\v")
+      ((#\page) "\\f")
+      ((#\\) "\\")
+      (else scm-chr-str))))
+
 (define protect-expr? (make-protect-expr op-prec op-assc))
 
 ;; @deffn pretty-print-c99 tree [#:indent-level 2]
@@ -150,7 +170,7 @@
 
       ((p-expr ,expr) (ppx expr))
       ((ident ,name) (sf "~A" name))
-      ((char ,value) (sf "'~A'" (sx-ref tree 1)))
+      ((char ,value) (sf "'~A'" (scmchs->c (sx-ref tree 1))))
       ((fixed ,value) (sf "~A" value))
       ((float ,value) (sf "~A" value))
 

module/nyacc/lang/c99/xparser.scm

@@ -33,13 +33,18 @@
 
 ;; Parse given a token generator.  Uses fluid @code{*info*}.
 (define raw-parser
-  (make-lalr-parser 
+  (let ((parser (make-lalr-parser 
-   (list
+		 (list (cons 'len-v len-v) (cons 'pat-v pat-v)
-    (cons 'len-v len-v)
+		       (cons 'rto-v rto-v) (cons 'mtab mtab)
-    (cons 'pat-v pat-v)
+		       (cons 'act-v act-v)))))
-    (cons 'rto-v rto-v)
+    (lambda* (lexer #:key (debug #f))
-    (cons 'mtab mtab)
+      (catch
-    (cons 'act-v act-v))))
+       'nyacc-error
+       (lambda () (parser lexer #:debug debug))
+       (lambda (key fmt . args)
+	 (report-error fmt args)
+	 (pop-input)			; not sure this is right
+	 (throw 'c99-error "C99 parse error"))))))
 
 (define (run-parse)
   (let ((info (fluid-ref *info*)))

module/nyacc/lex.scm

@@ -237,15 +237,17 @@
 	      ((eq? ch #\") (cons '$string (lsr cl)))
 	      (else (iter (cons ch cl) (read-char)))))))
 
-;; @deffn make-chlit-reader
+;; @deffn {Procedure} make-chlit-reader
 ;; Generate a reader for character literals. NOT DONE.
 ;; For C, this reads @code{'c'} or @code{'\n'}.
+;; @end deffn
 (define (make-chlit-reader . rest) (error "NOT IMPLEMENTED"))
 
-;; @deffn read-c-chlit ch
+;; @deffn {Procedure} read-c-chlit ch
 ;; @example
 ;; ... 'c' ... => (read-c-chlit #\') => '($ch-lit . #\c)
 ;; @end example
+;; @end deffn
 (define (read-c-chlit ch)
   (if (not (eqv? ch #\')) #f
       (let ((c1 (read-char)) (c2 (read-char)))
@@ -253,7 +255,7 @@
 	    (let ((c3 (read-char)))
 	      (cons '$chlit
 		    (case c2
-		      ((#\0) "\0;")	   ; nul U+0000 (#\U+...)
+		      ((#\0) "\0")	   ; nul U+0000 (#\U+...)
 		      ((#\a) "\a")	   ; alert U+0007
 		      ((#\b) "\b")	   ; backspace U+0008
 		      ((#\t) "\t")	   ; horizontal tab U+0009