nyacc: CPP working better now

module/nyacc/lang/c99/body.scm

@@ -320,7 +320,6 @@
 		      (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"))))
 	    
@@ -386,7 +385,8 @@
 		 (set! ppxs (cons 'skip1-pop (cdr ppxs))))
 		(else (cpi-pop))))
 	      ((error)
-	       (if (exec-cpp-stmts?) (report-error "CPP error: ~S" (cdr stmt))))
+	       (if (exec-cpp-stmts?)
+		   (report-error "error: #error ~A" (cdr stmt))))
 	      ((pragma)
 	       ;; standard says implementation-defined if line is expanded
 	       #t)
@@ -397,7 +397,6 @@
 	      (else (cons 'cpp-stmt stmt))))
 	  
 	  (define (eval-cpp-line line)
-	    (simple-format #t "line=~S\n" line)
 	    (with-throw-handler
 	     'cpp-error
 	     (lambda () (eval-cpp-stmt (read-cpp-stmt line)))
@@ -431,7 +430,6 @@
 		     ((and (x-def? name mode)
 			   (expand-cpp-mref name (cpi-defs info)))
 		      => (lambda (st)
-			   (simple-format #t "st=~S\n" st)
 			   (push-input (open-input-string st))
 			   (iter (read-char))))
 		     ((assq-ref keytab symb)
@@ -455,9 +453,7 @@
 	  ;; Loop between reading tokens and skipping tokens via CPP logic.
 	  (let iter ((pair (read-token)))
 	    (case (car ppxs)
-	      ((keep)
-	       ;;(simple-format #t "lx=>~S\n" pair)
-	       pair)
+	      ((keep) pair)
 	      ((skip-done skip-look)
 	       (iter (read-token)))
 	      ((skip1-pop)

module/nyacc/lang/c99/cpp.scm

@@ -61,26 +61,27 @@ todo:
   (letrec
       ((p-cppd ;; parse all
 	(lambda ()
-	  (let* ((iden (read-c-ident (skip-ws (read-char))))
-		 ;;(args (or (p-args (skip-ws (read-char))) '()))
+	  (let* ((iden (read-c-ident (skip-il-ws (read-char))))
 		 ;; "define ABC(ARG)" not the same as "define ABC (ARG)"
 		 (args (or (p-args (read-char)) '()))
-		 (rest (or (p-rest (skip-ws (read-char))) " ")))
+		 (rest (or (p-rest (skip-il-ws (read-char))) " ")))
 	    (if (pair? args)
 		`(define (name ,iden) ,(cons 'args args) (repl ,rest))
 		`(define (name ,iden) (repl ,rest))))))
        (p-args ;; parse args
 	(lambda (la) ;; unread la if no match :(
 	  (if (eq? la #\()
-	      (let iter ((args '()) (la (skip-ws (read-char))))
+	      (let iter ((args '()) (la (skip-il-ws (read-char))))
 		(cond
 		 ((eq? la #\)) (reverse args))
 		 ((read-c-ident la) =>
-		  (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
+		  (lambda (arg)
+		    (iter (cons arg args) (skip-il-ws (read-char)))))
 		 ((read-ellipsis la) =>
-		  (lambda (arg) (iter (cons arg args) (skip-ws (read-char)))))
+		  (lambda (arg)
+		    (iter (cons arg args) (skip-il-ws (read-char)))))
 		 ((eq? la #\,)
-		  (iter args (skip-ws (read-char))))))
+		  (iter args (skip-il-ws (read-char))))))
 	      (begin (if (char? la) (unread-char la)) #f)))) ;; CLEANUP
        (p-rest ;; parse rest
 	(lambda (la)
@@ -91,7 +92,7 @@ todo:
 ;; @deffn cpp-include
 ;; Parse CPP include statement.
 (define (cpp-include)
-  (let* ((beg-ch (skip-ws (read-char)))
+  (let* ((beg-ch (skip-il-ws (read-char)))
 	 (end-ch (if (eq? beg-ch #\<) #\> #\"))
 	 (path (let iter ((cl (list beg-ch)) (ch (read-char)))
 		 (if (eq? ch end-ch) (list->string (reverse (cons ch cl)))
@@ -108,14 +109,14 @@ todo:
 ;; To evaluate the @code{if} statements use @code{parse-cpp-expr} and
 ;; @code{eval-cpp-expr}.
 (define (read-cpp-stmt line)
-  (define (rd-ident) (read-c-ident (skip-ws (read-char))))
-  (define (rd-num) (and=> (read-c-num (skip-ws (read-char))) cdr))
-  (define (rd-rest) (let ((ch (skip-ws (read-char))))
+  (define (rd-ident) (read-c-ident (skip-il-ws (read-char))))
+  (define (rd-num) (and=> (read-c-num (skip-il-ws (read-char))) cdr))
+  (define (rd-rest) (let ((ch (skip-il-ws (read-char))))
 		      (if (not (eof-object? ch)) (unread-char ch))
 		      (drain-input (current-input-port))))
   (with-input-from-string line
     (lambda ()
-      (let ((cmd (string->symbol (read-c-ident (skip-ws (read-char))))))
+      (let ((cmd (string->symbol (read-c-ident (skip-il-ws (read-char))))))
 	 (case cmd
 	   ((include) (cpp-include))
 	   ((define) (cpp-define))

module/nyacc/lang/c99/cppbody.scm

@@ -18,12 +18,15 @@
 (define (cpp-err fmt . args)
   (apply throw 'cpp-error fmt args))
 
-;;.@deffn skip-ws ch
-(define (skip-ws ch)
-  (if (eof-object? ch) ch
-      (if (char-set-contains? c:ws ch)
-	  (skip-ws (read-char))
-	  ch)))
+;;.@deffn skip-il-ws ch
+;; Skip in-line whitespace
+(define skip-il-ws
+  (let ((il-ws (list->char-set '(#\space #\tab))))
+    (lambda (ch)
+      (cond
+       ((eof-object? ch) ch)
+       ((char-set-contains? il-ws ch) (skip-il-ws (read-char)))
+       (else ch)))))
 
 ;; Since we want to be able to get CPP statements with comment in tact
 ;; (e.g., for passing to @code{pretty-print-c99}) we need to remove
@@ -116,10 +119,6 @@
 ;; value) pairs which will be expanded as needed.  This routine is called
 ;; by collect-args, expand-cpp-repl and cpp-expand-text.
 (define (scan-cpp-input argd dict used end-tok)
-  (let ((res (x-scan-cpp-input argd dict used end-tok)))
-    (simple-format #t "scan=>~S\n" res)
-    res))
-(define (x-scan-cpp-input argd dict used end-tok)
   ;; Works like this: scan tokens (comments, parens, strings, char's, etc).
   ;; Tokens (i.e., strings) are collected in a (reverse ordered) list (stl)
   ;; and merged together on return.  Lone characters are collected in the
@@ -139,28 +138,33 @@
 
   ;; We just scanned "defined", now need to scan the arg to inhibit expansion.
   ;; For example, we have scanned "defined"; we now scan "(FOO)" or "FOO", and
-  ;; return "defined(FOO)".  We use ec (end-char) as state indicator: nul at
-  ;; start, #\) on seeing #\( or #\nul if other.
+  ;; return "defined(FOO)".  We use ec (end-char) as terminal char:
+  ;; #\) if starts with #( or #\nul if other.
   (define (scan-defined-arg)
-    (let* ((ch (skip-ws ch)) (ec (if (char=? ch #\() #\) #\nul)))
-      (let iter ((chl '(#\()) (ec ec) (ch ch))
+    (let* ((ch (skip-il-ws (read-char)))
+	   (ec (if (char=? ch #\() #\) #\null)))
+      (let iter ((chl '(#\()) (ec ec) (ch (if (char=? ec #\)) (read-char) ch)))
 	(cond
-	 ((and (eof-object? ch) (char=? #\nul ec))
-	  (string-append "defined" (list->string (reverse (cons #\) chl)))))
-	 ((eof-object? ch) (cpp-err "illegal argument to `defined'"))
-	 ((and (char=? ch #\)) (char=? ec #\)))
-	  (string-append "defined" (list->string (reverse (cons ch chl)))))
+	 ((eof-object? ch)
+	  (if (char=? ec #\null)
+	      (string-append "defined" (list->string (reverse (cons #\) chl))))
+	      (cpp-err "illegal argument to `defined'")))
 	 ((char-set-contains? c:ir ch)
 	  (iter (cons ch chl) ec (read-char)))
-	 (else (cpp-err "illegal identifier"))))))
+	 ((char=? ec #\))
+	  (if (char=? #\) (skip-il-ws ch))
+	      (string-append "defined" (list->string (reverse (cons #\) chl))))
+	      (cpp-err "garbage in argument to `defined'")))
+	 ((char=? ec #\null) ;; past identifier
+	  (string-append "defined" (list->string (reverse (cons #\) chl)))))
+	 (else
+	  (cpp-err "illegal argument to  `defined'"))))))
 
   (let iter ((stl '())		; string list (i.e., tokens)
 	     (chl '())		; char-list (current list of input chars)
 	     (nxt #f)		; next string 
 	     (lvl 0)		; level
 	     (ch (read-char)))	; next character
-    (simple-format #t "iter ch=~S stl=~S chl=~S nxt=~S lvl=~S ch=~S\n"
-		   ch stl chl nxt lvl ch)
     (cond
      ;; have item to add, but first add in char's
      (nxt (iter (cons nxt (add-chl chl stl)) '() #f lvl ch))
@@ -189,20 +193,17 @@
       (lambda (st) (iter stl chl st lvl (read-char))))
      ((read-c-ident ch) =>
       (lambda (iden)
-	;;(simple-format #t "  read-c-ident => ~S\n" iden)
 	(if (equal? iden "defined")
 	    ;; "defined" is a special case
-	    (iter stl chl (scan-defined-arg) lvl (read-char))
+	    (let ((arg (scan-defined-arg)))
+	      (iter stl chl arg lvl (read-char)))
 	    ;; otherwise ...
 	    (let* ((aval (assoc-ref argd iden))  ; lookup argument
 		   (rval (assoc-ref dict iden))) ; lookup macro def
-	      ;;(simple-format #t "    aval=~S rval=~S\n" aval rval)
 	      (cond
 	       ((and (pair? stl) (string=? "#" (car stl)))
-		;;(simple-format #t "TEST iden=~S aval=~S\n" iden aval)
 		(iter (cdr stl) chl (stringify aval) lvl (read-char)))
 	       ((and (pair? stl) (string=? "##" (car stl)))
-		;;(simple-format #t "TEST iden=~S aval=~S\n" iden aval)
 		(iter (cddr stl) chl (conjoin (cadr stl) aval) lvl (read-char)))
 	       ((member iden used)	; name used
 		(iter stl chl iden lvl (read-char)))
@@ -216,7 +217,6 @@
 		       (newl (expand-cpp-repl text argd dict (cons iden used))))
 		  (iter stl chl newl lvl (read-char))))
 	       (else			; normal identifier
-		;;(simple-format #t "normal id stl=~S\n" stl)
 		(iter stl chl iden lvl (read-char))))))))
      (else
       (iter stl (cons ch chl) #f lvl (read-char))))))
@@ -231,23 +231,17 @@
 ;; TODO clean this up
 ;; should be looking at #\( and eat up to matching #\)
 (define (collect-args argl argd dict used)
-  (simple-format #t "collect-args: argl=~S argd=~S dict=~S\n" argl argd dict)
-  (let iter ((argl argl) (argv '()) (ch (skip-ws (read-char))))
+  (let iter ((argl argl) (argv '()) (ch (skip-il-ws (read-char))))
     ;; ch should always be #\(, #\, or #\)
-    (simple-format #t "  ch=~S\n" ch)
     (cond
      ((eqv? ch #\)) (reverse argv))
      ((null? argl) (cpp-err "arg count"))
      ((and (null? (cdr argl)) (string=? (car argl) "..."))
-      ;; depending on scan-cpp-input being called before read-char
-      (iter (cdr argl)
-	    (acons "__VA_ARGS__" (scan-cpp-input argd dict used #\)) argv)
-	    (read-char)))
+      (let ((val (scan-cpp-input argd dict used #\))))
+	(iter (cdr argl) (acons "__VA_ARGS__" val argv) (read-char))))
      ((or (eqv? ch #\() (eqv? ch #\,))
-      ;; depending on scan-cpp-input being called before read-char
-      (iter (cdr argl)
-	    (acons (car argl) (scan-cpp-input argd dict used #\,) argv)
-	    (read-char)))
+      (let ((val (scan-cpp-input argd dict used #\,)))
+	(iter (cdr argl) (acons (car argl) val argv) (read-char))))
      (else (error "coding error, ch=" ch)))))
 
 ;; @deffn expand-cpp-repl
@@ -277,9 +271,6 @@
       (let ((expd (expand-cpp-repl rval '() dict (cons ident used))))
 	expd))
      ((pair? rval)
-      (let ((ch (read-char)))
-	(simple-format #t "expand-cpp-mref: ch=~S\n" ch)
-	(unread-char ch))
       (let* ((argl (car rval)) (repl (cdr rval))
 	     (argd (collect-args argl '() dict '()))
 	     (expd (expand-cpp-repl repl argd dict (cons ident used))))