nyacc: working cpp now, I hope
This commit is contained in:
parent
8a821d03d6
commit
5baa7f33b1
|
@ -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)
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Reference in a new issue