From f831edafe91074c9d873c0595c1a234836010921 Mon Sep 17 00:00:00 2001 From: Matt Wette Date: Thu, 16 Feb 2017 16:12:40 -0800 Subject: [PATCH] nyacc: minor cpp fixes --- module/nyacc/ChangeLog | 5 +++ module/nyacc/lang/c99/BUGS | 5 ++- module/nyacc/lang/c99/body.scm | 18 ++++----- module/nyacc/lang/c99/cpp.scm | 70 +++++++++++++++++++++++++-------- module/nyacc/lang/c99/util1.scm | 2 +- 5 files changed, 73 insertions(+), 27 deletions(-) diff --git a/module/nyacc/ChangeLog b/module/nyacc/ChangeLog index 039954d1..a0eb2909 100644 --- a/module/nyacc/ChangeLog +++ b/module/nyacc/ChangeLog @@ -1,3 +1,8 @@ +2017-02-16 Matt Wette + + * lang/c99/cpp.scm (rtokl->string): now handled symb ## arg ## symb + (scan-cpp-input): skip-il-ws after #\( + 2017-01-18 Matt Wette * lang/c99/parser.scm: check for EOF in end of CPP line diff --git a/module/nyacc/lang/c99/BUGS b/module/nyacc/lang/c99/BUGS index 9c111493..2e693c1d 100644 --- a/module/nyacc/lang/c99/BUGS +++ b/module/nyacc/lang/c99/BUGS @@ -1,4 +1,7 @@ -C99-007 <= next id +C99-008 <= next id + +C99-007 16 Feb 2017, M.Wette + cpp.scm: does __LINE__ get expanded? C99-006 06 Aug 2016, M.Wette code "val = '\0';" gets pprinted to "val = '^@;';" diff --git a/module/nyacc/lang/c99/body.scm b/module/nyacc/lang/c99/body.scm index 511b7d34..35298d01 100644 --- a/module/nyacc/lang/c99/body.scm +++ b/module/nyacc/lang/c99/body.scm @@ -283,6 +283,14 @@ (define (rem-define name) (set-cpi-defs! info (delete name (cpi-defs info)))) + (define (apply-helper file) + (let* ((tyns (assoc-ref (cpi-itynd info) file)) + (defs (assoc-ref (cpi-idefd info) file))) + (when tyns + (for-each add-typename tyns) + (set-cpi-defs! info (append defs (cpi-defs info)))) + tyns)) + ;; Evaluate expression text in #if of #elif statement. (define (eval-cpp-cond-text text) (with-throw-handler @@ -330,14 +338,6 @@ (if (eqv? 'keep (car ppxs)) (eval-cpp-stmt-2/code stmt))))) - (define (apply-helper file) - (let* ((tyns (assoc-ref (cpi-itynd info) file)) - (defs (assoc-ref (cpi-idefd info) file))) - (when tyns - (for-each add-typename tyns) - (set-cpi-defs! info (append defs (cpi-defs info)))) - (pair? tyns))) - (define (eval-cpp-stmt-2/code stmt) ;; eval non-control flow (case (car stmt) @@ -348,7 +348,7 @@ (cond ((apply-helper file)) ; use helper ((not path) (p-err "not found: ~S" file)) ; file not found - (else (push-input (open-input-file path)))))) + (else (set! bol #t) (push-input (open-input-file path)))))) ((define) (add-define stmt)) ((undef) (rem-define (cadr stmt))) ((error) (p-err "error: #error ~A" (cadr stmt))) diff --git a/module/nyacc/lang/c99/cpp.scm b/module/nyacc/lang/c99/cpp.scm index 6d7c3901..bb04dffc 100644 --- a/module/nyacc/lang/c99/cpp.scm +++ b/module/nyacc/lang/c99/cpp.scm @@ -243,8 +243,7 @@ ;; @deffn rtokl->string tokl => string ;; Convert reverse token-list to string. -(define (rtokl->string tokl) - ;; need to cover: comm ident string arg +(define (x-rtokl->string tokl) ;;(let iter ((stl '()) (chl '()) (nxt #f) (tkl tokl)) ;; more efficient (let iter ((stl '()) (tkl tokl)) (match tkl @@ -252,10 +251,10 @@ (apply string-append stl)) ((('arg . arg) 'dhash (key . val) . rest) - (iter (cons (string-append val arg) stl) (list-tail tkl 3))) + (iter stl (acons key (string-append val arg) (list-tail tkl 3)))) (((key . val) 'dhash ('arg . arg) . rest) - (iter (cons (string-append arg val) stl) (list-tail tkl 3))) + (iter stl (acons 'arg (string-append arg val) (list-tail tkl 3)))) ((('arg . arg) 'hash . rest) (iter (cons (string-append "\"" arg "\"") stl) (list-tail tkl 2))) @@ -278,6 +277,51 @@ (otherwise (error "no match" tkl))))) +(define (y-rtokl->string tokl) + + ;; 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 chl) stl))) + + ;; Works like this: Scan through the list of tokens (key-val pairs or lone + ;; characters). Lone characters are collected in a list (@code{chl}); pairs + ;; are converted into strings and combined with list of characters into a + ;; list of strings. When done the list of strings is combined to one string. + (let iter ((stl '()) (chl '()) (nxt #f) (tkl tokl)) + (cond + (nxt (iter (cons nxt (add-chl chl stl)) '() #f tkl)) + ((null? tkl) (apply string-append (add-chl chl stl))) + ((char? (car tkl)) (iter stl (cons (car tkl) chl) nxt (cdr tkl))) + (else + (match tkl + ((('arg . arg) 'dhash (key . val) . rest) + (iter stl chl nxt + (acons key (string-append val arg) (list-tail tkl 3)))) + + (((key . val) 'dhash ('arg . arg) . rest) + (iter stl chl nxt + (acons 'arg (string-append arg val) (list-tail tkl 3)))) + + ((('arg . arg) 'hash . rest) + (iter stl chl (string-append "\"" arg "\"") (list-tail tkl 2))) + + ((('comm . val) . rest) + (iter stl chl (string-append "/*" val " */") (cdr tkl))) + + ((('ident . rval) ('ident . lval) . rest) + (iter stl chl (string-append " " rval) (cdr tkl))) + + (((key . val) . rest) + (iter stl chl val rest)) + + (('space . rest) + (iter stl (cons #\space chl) nxt rest)) + + (otherwise + (error "no match" tkl))))))) + +(define rtokl->string y-rtokl->string) + ;; @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{)}. @@ -290,10 +334,6 @@ ;; 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))) - ;; 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: @@ -301,7 +341,9 @@ (define (scan-defined-arg) (let* ((ch (skip-il-ws (read-char))) (ec (if (char=? ch #\() #\) #\null))) - (let iter ((chl '(#\()) (ec ec) (ch (if (char=? ec #\)) (read-char) ch))) + (let iter ((chl '(#\()) + (ec ec) + (ch (if (char=? ec #\)) (skip-il-ws (read-char)) ch))) (cond ((eof-object? ch) (if (char=? ec #\null) @@ -428,12 +470,6 @@ (let ((used (if (pair? rest) (car rest) '())) (rval (assoc-ref dict ident))) (cond - #;((string=? ident "C99_ANY") #f) ; don't expand: could be anything - #;((string=? ident "__FILE__") - (string-append "\"" (or (port-filename (current-input-port)) - "(unknown)") "\"")) - #;((string=? ident "__LINE__") (1+ (port-line (current-input-port)))) - ;; ((not rval) #f) ((member ident used) ident) ((string? rval) @@ -443,6 +479,8 @@ (let* ((argl (car rval)) (repl (cdr rval)) (argd (collect-args argl '() dict '())) (expd (expand-cpp-repl repl argd dict (cons ident used)))) - expd))))) + expd)) + ((c99-std-val ident)) + (else #f)))) ;;; --- last line --- diff --git a/module/nyacc/lang/c99/util1.scm b/module/nyacc/lang/c99/util1.scm index c38855fa..5e5bb5e3 100644 --- a/module/nyacc/lang/c99/util1.scm +++ b/module/nyacc/lang/c99/util1.scm @@ -45,7 +45,7 @@ "imaxdiv_t") ("limits.h" "INT_MIN=C99_ANY" "INT_MAX=C99_ANY" "LONG_MIN=C99_ANY" "LONG_MAX=C99_ANY") - ("math.h") + ("math.h" "float_t" "double_t") ("regex.h" "regex_t" "regmatch_t") ("setjmp.h" "jmp_buf") ("signal.h" "sig_atomic_t") -- 2.31.1