nyacc: redesign lang/c99/cppbocy.scm:scan-cpp-input
authorMatt Wette <matt.wette@gmail.com>
Tue, 17 Jan 2017 13:50:45 +0000 (05:50 -0800)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 17 Jan 2017 13:50:45 +0000 (05:50 -0800)
module/nyacc/README.nyacc
module/nyacc/lalr.scm
module/nyacc/lang/c99/body.scm
module/nyacc/lang/c99/cpp.scm
module/nyacc/lang/c99/cppbody.scm

index a34efa616309e60e671a4ff7b0ba2ab2b0663e15..62570781b8af949e5af43eee2c82bcd45bcb55fa 100644 (file)
@@ -1,4 +1,4 @@
-This is a version 0.74.3 of NYACC (Not Yet Another Compiler Compiler!).
+This is a version 0.74.3+fixes of NYACC (Not Yet Another Compiler Compiler!).
 
 Copyright (C) 2015-2017 Matthew R. Wette
 
@@ -8,7 +8,7 @@ notice and this notice are preserved.  This file is offered as-is,
 without any warranty.
 
 Full source distribution for NYACC is available at 
-  https://savannah.nongnu.org/projects/nyacc
+  https://download.savannah.gnu.org/projects/nyacc
 
 This software package is covered by the following licenses:
 * GNU PUBLIC GENERAL LICENCE, version 3 (See COPYING.)
index 48b08e04dcb485923c87da9c3d77ab4e1b9a20a3..83b7356df2d6420c9d7c56597dd75d4db6520cda 100644 (file)
@@ -42,8 +42,6 @@
            looking-at first-item
            terminal? non-terminal?
            range-next
-            process-spec
-            reserved?
            )
   #:use-module ((srfi srfi-1) #:select (fold fold-right remove lset-union
                                             lset-intersection lset-difference))
@@ -52,7 +50,7 @@
   #:use-module (nyacc util)
   )
 
-(define *nyacc-version* "0.74.3")
+(define *nyacc-version* "0.74.3+fixes")
 
 
 ;; @deffn proxy-? sym rhs
index 462fb82fae707887df9bf19e8e7b9f1775b78928..1fd664ccbb5a32716c1b92b96143aa37aeba3f0c 100644 (file)
                     ((and (x-def? name mode)
                           (expand-cpp-mref 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)
          ;; Loop between reading tokens and skipping tokens via CPP logic.
          (let iter ((pair (read-token)))
            (case (car ppxs)
-             ((keep) pair)
+             ((keep)
+              ;;(simple-format #t "lx=>~S\n" pair)
+              pair)
              ((skip-done skip-look)
               (iter (read-token)))
              ((skip1-pop)
index 33fcd5082ad124ac5a7f6083a62423ef9ee73092..c2be32270c3778bab830d28cf1ab33e8a726f557 100644 (file)
@@ -117,16 +117,16 @@ todo:
   (with-input-from-string line
     (lambda ()
       (let ((cmd (string->symbol (read-c-ident (skip-il-ws (read-char))))))
-        (case cmd
-          ((include) (cpp-include))
-          ((define) (cpp-define))
-          ((undef) `(undef ,(rd-ident)))
-          ((ifdef)
-           `(if ,(string-append "defined(" (rd-ident) ")" (rd-rest))))
-          ((ifndef)
-           `(if ,(string-append "!defined(" (rd-ident) ")" (rd-rest))))
-          ((if elif else endif line error pragma) (list cmd (rd-rest)))
-          (else '(unknown "")))))))
+       (case cmd
+         ((include) (cpp-include))
+         ((define) (cpp-define))
+         ((undef) `(undef ,(rd-ident)))
+         ((ifdef)
+          `(if ,(string-append "defined(" (rd-ident) ")" (rd-rest))))
+         ((ifndef)
+          `(if ,(string-append "!defined(" (rd-ident) ")" (rd-rest))))
+         ((if elif else endif line error pragma) (list cmd (rd-rest)))
+         (else '(unknown "")))))))
 
 (include-from-path "nyacc/lang/c99/mach.d/cpptab.scm")
 (include-from-path "nyacc/lang/c99/mach.d/cppact.scm")
index 1b8def58f2b5ceacd213cd9674f625e6e3830395..eb717142a733e44a02ac2b9364c49ec791ee0e0a 100644 (file)
 ;;; 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))
 
 ;; first character of new replacement text.
 ;; @end enumerate
 
+;; @deffn rtokl->string tokl => string
+;; Convert reverse token-list to string.
+(define (rtokl->string tokl)
+  ;; need to cover: comm ident string arg
+  ;;(let iter ((stl '()) (chl '()) (nxt #f) (tkl tokl)) ;; more efficient
+  (let iter ((stl '()) (tkl tokl))
+    (match tkl
+      ('()
+       (apply string-append stl))
+
+      ((('arg . arg) 'dhash (key . val) . rest)
+       (iter (cons (string-append val arg) stl) (list-tail tkl 3)))
+
+      (((key . val) 'dhash ('arg . arg) . rest)
+       (iter (cons (string-append arg val) stl) (list-tail tkl 3)))
+
+      ((('arg . arg) 'hash . rest)
+       (iter (cons (string-append "\"" arg "\"") stl) (list-tail tkl 2)))
+
+      ((('comm . val) . rest)
+       (iter (cons (string-append "/*" val " */") stl) (cdr tkl)))
+
+      ((('ident . rval) ('ident . lval) . rest)
+       (iter (cons* " " rval stl) (cdr tkl)))
+
+      (((key . val) . rest)
+       (iter (cons val stl) (cdr tkl)))
+
+      (((? char? ch) . rest)
+       (iter (cons (string ch) stl) rest))
+
+      (otherwise
+       (error "no match" tkl)))))
+
 ;; @deffn scan-cpp-input argd used dict end-tok => string
 ;; Process replacement text from the input port and generate a (reversed)
 ;; token-list.  If end-tok, stop at, and push back, @code{,} or @code{)}.
 ;; 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)
-  ;; 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
-  ;; list @code{chl}.  Once a token border is seen the character list is
-  ;; converted to a string and added to the string list first, followed by
-  ;; the new token.
+  ;; Works like this: scan for tokens (comments, parens, strings, char's, etc).
+  ;; Tokens are collected in a (reverse ordered) list (tkl) and merged together
+  ;; to a string on return using @code{rtokl->string}.
 
   ;; Turn reverse chl into a string and insert it into the string list stl.
   (define (add-chl chl stl)
     (if (null? chl) stl (cons (list->string (reverse chl)) stl)))
 
-  ;; used when we see `#foo'; converts foo to "foo"
-  (define (stringify str)
-    (string-append "\"" str "\""))
-
   (define conjoin string-append)
 
   ;; We just scanned "defined", now need to scan the arg to inhibit expansion.
         (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 
+  (let iter ((tkl '())         ; token list (as list of strings)
             (lvl 0)            ; level
             (ch (read-char)))  ; next character
     (cond
      ;; have item to add, but first add in char's
-     (nxt (iter (cons nxt (add-chl chl stl)) '() #f lvl ch))
+     ;;(nxt (iter (cons nxt (add-chl chl tkl)) '() #f lvl ch))
      ;; If end of string or see end-ch at level 0, then return.
-     ((eof-object? ch)  ;; CHECK (ab++)
-      (apply string-append (reverse (add-chl chl stl))))
+     ((eof-object? ch) (rtokl->string tkl))
      
      ((and (eqv? end-tok ch) (zero? lvl))
-      (unread-char ch) (apply string-append (reverse (add-chl chl stl))))
+      (unread-char ch) (rtokl->string tkl))
      ((and end-tok (char=? #\) ch) (zero? lvl))
-      (unread-char ch) (apply string-append (reverse (add-chl chl stl))))
+      (unread-char ch) (rtokl->string tkl))
      
      ((read-c-comm ch #f) =>
-      (lambda (cp) (iter stl chl (string-append "/*" (cdr cp) "*/")
-                        lvl (read-char))))
-     ;; not sure about this:
-     ((char-set-contains? c:ws ch) (iter stl chl nxt lvl (read-char)))
-     ((char=? #\( ch) (iter stl (cons ch chl) nxt (1+ lvl) (read-char)))
-     ((char=? #\) ch) (iter stl (cons ch chl) nxt (1- lvl) (read-char)))
+      (lambda (cp) (iter (acons `comm cp tkl) lvl (read-char))))
+     
+     ((char-set-contains? c:ws ch) (iter tkl lvl (read-char)))
+     ((char=? #\( ch) (iter (cons ch tkl) (1+ lvl) (read-char)))
+     ((char=? #\) ch) (iter (cons ch tkl) (1- lvl) (read-char)))
      ((char=? #\# ch)
       (let ((ch (read-char)))
        (if (eqv? ch #\#)
-           (iter stl chl "##" lvl (read-char))
-           (iter stl chl "#" lvl ch))))
+           (iter (cons 'dhash tkl) lvl (read-char))
+           (iter (cons 'hash tkl) lvl ch))))
      ((read-c-string ch) =>
-      (lambda (st) (iter stl chl st lvl (read-char))))
+      (lambda (st) (iter (acons 'string st tkl) lvl (read-char))))
      ((read-c-ident ch) =>
       (lambda (iden)
        (if (equal? iden "defined")
            ;; "defined" is a special case
            (let ((arg (scan-defined-arg)))
-             (iter stl chl arg lvl (read-char)))
+             (iter (acons 'defined arg tkl) lvl (read-char)))
            ;; otherwise ...
            (let* ((aval (assoc-ref argd iden))  ; lookup argument
                   (rval (assoc-ref dict iden))) ; lookup macro def
              (cond
-              ((and (pair? stl) (string=? "#" (car stl)))
-               (iter (cdr stl) chl (stringify aval) lvl (read-char)))
-              ((and (pair? stl) (string=? "##" (car stl)))
-               (iter (cddr stl) chl (conjoin (cadr stl) aval) lvl (read-char)))
               ((member iden used)      ; name used
-               (iter stl chl iden lvl (read-char)))
+               (iter (cons iden tkl) lvl (read-char)))
               (aval                    ; arg ref
-               (iter stl chl aval lvl (read-char)))
+               (iter (acons 'arg aval tkl) lvl (read-char)))
               ((string? rval)          ; cpp repl
-               (iter stl chl rval lvl (read-char)))
+               (iter (acons 'string rval tkl) lvl (read-char)))
               ((pair? rval)            ; cpp macro
                (let* ((argl (car rval)) (text (cdr rval))
                       (argd (collect-args argl argd dict used))
                       (newl (expand-cpp-repl text argd dict (cons iden used))))
-                 (iter stl chl newl lvl (read-char))))
+                 (iter (acons 'string newl tkl) lvl (read-char))))
               (else                    ; normal identifier
-               (iter stl chl iden lvl (read-char))))))))
+               (iter (acons 'ident iden tkl) lvl (read-char))))))))
      (else
-      (iter stl (cons ch chl) #f lvl (read-char))))))
+      (iter (cons ch tkl) lvl (read-char))))))
 
 ;; @deffn collect-args argl argd dict used => argd
 ;; to be documented