nyacc: working cpp now, I hope

module/nyacc/lang/c99/body.scm

@@ -291,7 +291,6 @@
 	       (let* ((defs (cpi-defs info))
 		      (rhs (cpp-expand-text text defs))
 		      (exp (parse-cpp-expr rhs)))
-		 ;;(simple-format #t "defs: ~S\n" defs)
 		 (eval-cpp-expr exp defs)))
 	     (lambda (key fmt . args)
 	       (report-error fmt args)
@@ -309,7 +308,6 @@
 	    (case (car stmt)
 	      ((if)
 	       (let ((val (eval-cpp-cond-text (cadr stmt))))
-		 ;;(simple-format #t "if ~S=> ~S\n" (cadr stmt) val)
 		 (if (not val) (p-err "unresolved: ~S" (cadr stmt)))
 		 (if (eq? 'keep (car ppxs))
 		     (if (zero? val)
@@ -318,13 +316,11 @@
 		     (set! ppxs (cons 'skip-done ppxs)))))
 	      ((elif)
 	       (let ((val (eval-cpp-cond-text (cadr stmt))))
-		 ;;(simple-format #t "elif ~S=> ~S\n" (cadr stmt) val)
 		 (if (not val) (p-err "unresolved: ~S" (cadr stmt)))
 		 (case (car ppxs)
 		   ((skip-look) (if (not (zero? val)) (set-car! ppxs 'keep)))
 		   ((keep) (set-car! ppxs 'skip-done)))))
 	      ((else)
-	       ;;(simple-format #t "else (was ~S)\n" (car ppxs))
 	       (case (car ppxs)
 		 ((skip-look) (set-car! ppxs 'keep))
 		 ((keep) (set-car! ppxs 'skip-done))))
@@ -357,8 +353,7 @@
 	      ((undef) (rem-define (cadr stmt)))
 	      ((error) (p-err "error: #error ~A" (cadr stmt)))
 	      ((pragma) #t) ;; ignore for now
-	      (else
-	       (error "bad cpp flow stmt"))))
+	      (else (error "bad cpp flow stmt"))))
 
 	  (define (eval-cpp-stmt/code stmt)
 	    (with-throw-handler
@@ -391,12 +386,17 @@
 	      ((define) (add-define stmt))
 	      ((undef) (rem-define (cadr stmt)))
 	      ((error) #f)
-	      ;;((pragma) #t) need to work
-	      (else
-	       (error "bad cpp flow stmt"))))
+	      ((pragma) #t) ;; need to work this
+	      (else (error "bad cpp flow stmt"))))
 	    
 	  (define (eval-cpp-stmt/file stmt)
-	    (throw 'c99-error "not implemented"))
+	    (with-throw-handler
+	     'cpp-error
+	     (lambda () (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!
@@ -416,24 +416,21 @@
  		 ((read-comm ch #t) => assc-$)
 		 ((read-cpp-stmt ch) =>
 		  (lambda (stmt)
-		    ;;(simple-format #t "read-cpp-stmt => ~S\n" stmt)
 		    (case mode
-		      ((code) ;; but what about #pragma - ignore for now
+		      ((code)
 		       (eval-cpp-stmt/code stmt)
 		       (iter (read-char)))
 		      ((file)
 		       (eval-cpp-stmt/file stmt)
-		       (assc-$ stmt)))))
+		       (assc-$ `(cpp-stmt ,stmt))))))
 		 (else (iter ch))))
 	       ((read-ident ch) =>
 		(lambda (name)
-		  ;;(simple-format #t "read-ident=>~S\n" name)
 		  (let ((symb (string->symbol name)))
 		    (cond
 		     ((and (x-def? name mode)
 			   (expand-cpp-macro-ref name (cpi-defs info)))
 		      => (lambda (st)
-			   ;;(simple-format #t "body: st=~S\n" st)
 			   (push-input (open-input-string st))
 			   (iter (read-char))))
 		     ((assq-ref keytab symb)

module/nyacc/lang/c99/cpp.scm

@@ -94,7 +94,7 @@
 	 (args (or (p-args (read-char)) '()))
 	 (repl (p-rest (skip-il-ws (read-char)))))
     (if (pair? args)
-	`(define (name ,name) (args ,args) (repl ,repl))
+	`(define (name ,name) (args . ,args) (repl ,repl))
 	`(define (name ,name) (repl ,repl)))))
 	
 
@@ -294,8 +294,6 @@
   (define (add-chl chl stl)
     (if (null? chl) stl (cons (list->string (reverse chl)) stl)))
 
-  (define conjoin string-append)
-
   ;; 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 terminal char:
@@ -320,7 +318,12 @@
 	 (else
 	  (cpp-err "illegal argument to  `defined'"))))))
 
-  (let iter ((tkl '())		; token list (as list of strings)
+  ;; token list is list of
+  ;; 1) characters as char
+  ;; 2) identifiers as string
+  ;; 3) strings as '(string . <string>)
+  ;; 4) 'hash 'dhash
+  (let iter ((tkl '())		; token list of 
 	     (lvl 0)		; level
 	     (ch (read-char)))	; next character
     (cond
@@ -350,7 +353,7 @@
 	    (iter (cons 'dhash tkl) lvl (read-char))
 	    (iter (cons 'hash tkl) lvl ch))))
      ((read-c-string ch) =>
-      (lambda (st) (iter (acons 'string st tkl) lvl (read-char))))
+      (lambda (st) (iter (acons 'string (cdr st) tkl) lvl (read-char))))
      ((read-c-ident ch) =>
       (lambda (iden)
 	(if (equal? iden "defined")
@@ -425,14 +428,13 @@
   (let ((used (if (pair? rest) (car rest) '()))
 	(rval (assoc-ref dict ident)))
     (cond
-     ((not rval) #f)
-     ((string=? rval "C99_ANY") #f)	; don't expand: could be anything
-     ;; move FILE LINE to expand-cpp-repl?
-     ((string=? rval "__FILE__")
+     #;((string=? ident "C99_ANY") #f)	; don't expand: could be anything
+     #;((string=? ident "__FILE__")
       (string-append "\"" (or (port-filename (current-input-port))
 			      "(unknown)") "\""))
-     ((string=? rval "__LINE__") (1+ (port-line (current-input-port))))
+     #;((string=? ident "__LINE__") (1+ (port-line (current-input-port))))
      ;;
+     ((not rval) #f)
      ((member ident used) ident)
      ((string? rval)
       (let ((expd (expand-cpp-repl rval '() dict (cons ident used))))