nyacc: working on cpp issues
authorMatt Wette <matt.wette@gmail.com>
Sat, 11 Feb 2017 21:04:38 +0000 (13:04 -0800)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 11 Feb 2017 21:04:38 +0000 (13:04 -0800)
module/nyacc/lang/c99/body.scm
module/nyacc/lang/c99/cpp.scm

index d270a895464aefb6431600cdbf47e28f89df68f0..762a690726a2668b8704ccd8519d5a0269c0c8de 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)
              ((pragma) (cons 'cpp-pragma (cdr stmt)))
              (else (cons 'cpp-stmt stmt))))
-         
+
          (define (eval-cpp-stmt-1/code stmt)
+           ;; eval control flow: states are {skip-look, keep, skip-done}
            (case (car stmt)
-             ;; actions
-             ((include)
-              (let* ((file (inc-stmt->file stmt))
-                     (path (inc-file->path file)))
-                (if (not path) (p-err "not found: ~S" file))
-                (push-input (open-input-file path))))
-             ((define) (add-define stmt))
-             ((undef) (rem-define (cadr stmt)))
-             ((error) (report-error "error: #error ~A" (cdr stmt)))
-             ((pragma) #t) ;; ignore for now
-             ;; control flow: states are {skip-look, keep, skip-done}
-             ((if) ;; and ifdef ifndef
+             ((if)
               (let ((val (eval-cpp-cond-text (cadr stmt))))
-                ;;(simple-format #t "if ~S=> ~S\n" (cadr stmt) val)
+                (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-look ppxs))
-                        ;; keep if keeping, skip if skipping, ??? if skip-look
-                        (set! ppxs (cons (car ppxs) ppxs)))
+                        (set! ppxs (cons 'keep ppxs)))
                     (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)
+                (simple-format #t "elif ~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-look ppxs))
-                        ;; keep if keeping, skip if skipping, ??? if skip-look
-                        (set! ppxs (cons* (car ppxs) ppxs)))
-                    (set! ppxs (cons 'skip-done ppxs)))))
+                (case (car ppxs)
+                  ((skip-look) (if (not (zero? val)) (set-car! ppxs 'keep)))
+                  ((keep) (set-car! ppxs 'skip-done)))))
              ((else)
-              ;;(simple-format #t "else\n")
-              (if (eqv? 'skip-look (car ppxs))
-                  (set! ppxs (cons 'keep (cdr ppxs)))))
+              (simple-format #t "else (was ~S)\n" (car ppxs))
+              (case (car ppxs)
+                ((skip-look) (set-car! ppxs 'keep))
+                ((keep) (set-car! ppxs 'skip-done))))
              ((endif)
               (set! ppxs (cdr ppxs)))
              (else
-              (error "bad cpp flow stmt"))))
+              (if (eqv? 'keep (car ppxs))
+                  (eval-cpp-stmt-2/code stmt)))))
          
+         (define (eval-cpp-stmt-2/code stmt)
+           ;; eval non-control flow
+           (case (car stmt)
+             ;; actions
+             ((include)
+              (let* ((file (inc-stmt->file stmt))
+                     (path (inc-file->path file)))
+                (if (not path) (p-err "not found: ~S" file))
+                (push-input (open-input-file path))))
+             ((define) (add-define stmt))
+             ((undef) (rem-define (cadr stmt)))
+             ((error) (p-err "error: #error ~A" (cadr stmt)))
+             ((pragma) #t) ;; ignore for now
+             (else
+              (error "bad cpp flow stmt"))))
+
          (define (eval-cpp-stmt/code stmt)
            ;;(simple-format #t "eval-cpp-stmt: ~S\n" stmt)
            (with-throw-handler
 
          ;; Loop between reading tokens and skipping tokens via CPP logic.
          (let iter ((pair (read-token)))
-           ;;(simple-format #t "iter ~S\n" (car ppxs)) (sleep 1)
+           (simple-format #t "iter ~S\n" (car ppxs)) (sleep 1)
            (case (car ppxs)
              ((keep)
-              ;;(simple-format #t "lx=>~S\n" pair)
+              (simple-format #t "lx=>~S\n" pair)
               pair)
              ((skip-done skip-look)
               (iter (read-token)))
index b4d8b3ca05828fcd7b78a779d29170a2c11ddf40..b3f657dee3755a9479aac07c405ffcac1cf28ca6 100644 (file)
@@ -29,6 +29,7 @@
   #:use-module (nyacc lex)
   #:use-module (nyacc lang util)
   #:use-module (rnrs arithmetic bitwise)
+  #:use-module (ice-9 match)
   )
 
 (cond-expand
   (use-modules (ice-9 syncase)))
  (mes))
 
+(define c99-std-defs
+  '("__DATE__" "__FILE__" "__LINE__" "__STDC__" "__STDC_HOSTED__"
+    "__STDC_VERSION__" "__TIME__"))
+
+(define (c99-std-def? str)
+  (let iter ((defs c99-std-defs))
+    (cond
+     ((null? defs) #f)
+     ((string=? (car defs) str) #t)
+     (else (iter (cdr defs))))))
+
+(define (c99-std-val str)
+  (cond
+   ((string=? str "__DATE__") "M01 01 2001")
+   ((string=? str "__FILE__") "(unknown)")
+   ((string=? str "__LINE__") 0)
+   ((string=? str "__STDC__") 1)
+   ((string=? str "__STDC_HOSTED__") 0)
+   ((string=? "__STDC_VERSION__") 201701)
+   ((string=? "__TIME__") "00:00:00")
+   (else #f)))
+
 ;; @deffn read-ellipsis ch
 ;; read ellipsis
 (define (read-ellipsis ch)
@@ -46,6 +69,9 @@
    (else #f)))
 
 ;; @deffn cpp-define => (define (name "ADD") (args "X" "Y") (repl "X+Y"))
+;; output is like
+;; @code{(name "ABC") (repl "123")} or
+;; @code{(name "ABC") (args "X" "Y") (repl "X+Y")}
 (define (cpp-define)
 
   (define (p-args la) ;; parse args
@@ -66,7 +92,7 @@
   (define (p-rest la) ;; parse rest
     (cond ((eof-object? la) "")
          (else
-          (if (not (char=? #\=)) (unread-char ch)) ; handle ABC=DEF
+          (if (not (char=? #\=)) (unread-char la)) ; handle ABC=DEF
           (drain-input (current-input-port)))))
 
   (let* ((name (read-c-ident (skip-il-ws (read-char))))
        `(define (name ,name) (repl ,repl)))))
        
 
-;; where @code{...} is
-;; @code{(name "ABC") (repl "123")} or
-;; @code{(name "ABC") (args "X" "Y") (repl "X+Y")}
-(define (x-cpp-define)
-  ;; The (weak?) parse architecture is "unread la argument if no match"
-  (letrec
-      ((p-cppd ;; parse all
-       (lambda ()
-         (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 (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-il-ws (read-char))))
-               (cond
-                ((eq? la #\)) (reverse args))
-                ((read-c-ident la) =>
-                 (lambda (arg)
-                   (iter (cons arg args) (skip-il-ws (read-char)))))
-                ((read-ellipsis la) =>
-                 (lambda (arg)
-                   (iter (cons arg args) (skip-il-ws (read-char)))))
-                ((eq? la #\,)
-                 (iter args (skip-il-ws (read-char))))))
-             (begin (if (char? la) (unread-char la)) #f)))) ;; CLEANUP
-       (p-rest ;; parse rest
-       (lambda (la)
-         (cond ((eof-object? la) "")
-               (else
-                (if (not (char=? #\=)) (unread-char ch)) ; handle ABC=DEF
-                (drain-input (current-input-port)))))))
-    (p-cppd)))
-
 ;; @deffn cpp-include
 ;; Parse CPP include statement.
 (define (cpp-include)
    (list (cons 'len-v len-v) (cons 'pat-v pat-v) (cons 'rto-v rto-v)
         (cons 'mtab mtab) (cons 'act-v act-v))))
 
-;; Provide gen-cpp-lexer parse-cpp-expr eval-cpp-expr:
-;;(include-from-path "nyacc/lang/c99/cppbody.scm")
-;; --- last line ---
-;;; nyacc/lang/c99/cppbody.scm
-;;;
-;;; Copyright (C) 2016-2017 Matthew R. Wette
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-(use-modules (ice-9 match))
-
-(define c99-std-defs
-  '("__DATE__" "__FILE__" "__LINE__" "__STDC__" "__STDC_HOSTED__"
-    "__STDC_VERSION__" "__TIME__"))
-
-(define (c99-std-def? str)
-  (let iter ((defs c99-std-defs))
-    (cond
-     ((null? defs) #f)
-     ((string=? (car defs) str) #t)
-     (else (iter (cdr defs))))))
-
-(define (c99-std-val str)
-  (cond
-   ((string=? str "__DATE__") "M01 01 2001")
-   ((string=? str "__FILE__") "(unknown)")
-   ((string=? str "__LINE__") 0)
-   ((string=? str "__STDC__") 1)
-   ((string=? str "__STDC_HOSTED__") 0)
-   ((string=? "__STDC_VERSION__") 201701)
-   ((string=? "__TIME__") "00:00:00")
-   (else #f)))
-
 (define (cpp-err fmt . args)
   (apply throw 'cpp-error fmt args))
 
     (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-append "\"" (or (port-filename (current-input-port))
+                             "(unknown)") "\""))
+     ((string=? rval "__LINE__") (1+ (port-line (current-input-port))))
+     ;;
      ((member ident used) ident)
      ((string? rval)
       (let ((expd (expand-cpp-repl rval '() dict (cons ident used))))