nyacc: working cpp now, I hope
authorMatt Wette <matt.wette@gmail.com>
Wed, 15 Feb 2017 03:24:59 +0000 (19:24 -0800)
committerJan Nieuwenhuizen <janneke@gnu.org>
Wed, 15 Feb 2017 03:24:59 +0000 (19:24 -0800)
module/nyacc/lang/c99/body.scm
module/nyacc/lang/c99/cpp.scm

index 121f6ecf316e3a8ef70edfe4c69d53a2fa8ca7a0..5c1db34524940b3d34e49026be48ec48dc7dbb64 100644 (file)
               (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)
            (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)
                     (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))))
              ((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
              ((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!
                 ((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)
index 1516c4154ef888ffc14a73c0c145a62bd91c1715..6d7c390134b9ecac109f35ad6aee2aebcc5b9080 100644 (file)
@@ -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)))))
        
 
   (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:
         (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
            (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")
   (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))))