artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

nyacc: starting to work on reframing

Browse source
This commit is contained in:
Matt Wette 2017-01-20 14:51:55 -08:00 committed by Jan Nieuwenhuizen
parent 85cb3731cc
commit e534225328
1 changed files with 13 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
module/nyacc/lang/c99/body.scm
View file

@ -297,7 +297,7 @@
;; Return the first (tval . lval) pair not excluded by the CPP. ;; Return the first (tval . lval) pair not excluded by the CPP.
(lambda () (lambda ()
(define (exec-cpp-stmts?) ; exec (vs pass to parser) CPP stmts? (define (exec-cpp-stmts?) ; exec (vs pass to parser) CPP stmts?
(eqv? mode 'code)) (eqv? mode 'code))
(define (add-define tree) (define (add-define tree)
@ -326,6 +326,7 @@
(define (eval-cpp-stmt stmt) (define (eval-cpp-stmt stmt)
(case (car stmt) (case (car stmt)
;; includes
((include) ((include)
(let* ((parg (cadr stmt)) (leng (string-length parg)) (let* ((parg (cadr stmt)) (leng (string-length parg))
(file (substring parg 1 (1- leng))) (file (substring parg 1 (1- leng)))
@ -347,11 +348,18 @@
((undef) ((undef)
(rem-define (cadr stmt)) (rem-define (cadr stmt))
(if (exec-cpp-stmts?) (set! ppxs (cons 'skip1-pop ppxs)))) (if (exec-cpp-stmts?) (set! ppxs (cons 'skip1-pop ppxs))))
((error)
(if (exec-cpp-stmts?)
(report-error "error: #error ~A" (cdr stmt))))
((pragma) ;; std: implementation-defined if expanded
#t)
;; control flow
((if) ;; covers (if ifdef ifndef) ((if) ;; covers (if ifdef ifndef)
(cond (cond
((exec-cpp-stmts?) ((exec-cpp-stmts?)
(let ((val (eval-cpp-cond-text (cadr stmt)))) (let ((val (eval-cpp-cond-text (cadr stmt))))
;;(simple-format #t "if val=~S\n" val) (simple-format #t "if ~S=> ~S\n" (cadr stmt) val)
(cond (cond
((not val) (p-err "unresolved: ~S" (cadr stmt))) ((not val) (p-err "unresolved: ~S" (cadr stmt)))
((zero? val) (set! ppxs (cons* 'skip1-pop 'skip-look ppxs))) ((zero? val) (set! ppxs (cons* 'skip1-pop 'skip-look ppxs)))
@ -386,12 +394,7 @@
((exec-cpp-stmts?) ((exec-cpp-stmts?)
(set! ppxs (cons 'skip1-pop (cdr ppxs)))) (set! ppxs (cons 'skip1-pop (cdr ppxs))))
(else (cpi-pop)))) (else (cpi-pop))))
((error)
(if (exec-cpp-stmts?)
(report-error "error: #error ~A" (cdr stmt))))
((pragma)
;; standard says implementation-defined if line is expanded
#t)
(else (else
(error "unhandled cpp stmt"))) (error "unhandled cpp stmt")))
(case (car stmt) (case (car stmt)
@ -409,6 +412,7 @@
(throw 'c99-error "CPP error")))) (throw 'c99-error "CPP error"))))
;; Composition of @code{read-cpp-line} and @code{eval-cpp-line}. ;; Composition of @code{read-cpp-line} and @code{eval-cpp-line}.
;; We should not be doing this!
(define (read-cpp ch) (define (read-cpp ch)
(and=> (read-cpp-line ch) eval-cpp-line)) (and=> (read-cpp-line ch) eval-cpp-line))
@ -424,7 +428,7 @@
((read-comm ch bol) => assc-$) ((read-comm ch bol) => assc-$)
((read-cpp ch) => ((read-cpp ch) =>
(lambda (res) ;; if '() stmt expanded so re-read (lambda (res) ;; if '() stmt expanded so re-read
;;(simple-format #t "res=~S\n" res) ;;(simple-format #t "read-cpp => ~S\n" res)
(if (pair? res) (assc-$ res) (iter (read-char))))) (if (pair? res) (assc-$ res) (iter (read-char)))))
(else (set! bol #f) (iter ch)))) (else (set! bol #f) (iter ch))))
((read-ident ch) => ((read-ident ch) =>