andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

nyacc: I think cpp is working now

This commit is contained in:
Matt Wette 2017-02-15 19:58:29 -08:00 committed by Jan Nieuwenhuizen
parent 5baa7f33b1
commit 1ae749b25f
4 changed files with 21 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
module/nyacc/lang/c99/body.scm
View File

@ -355,14 +355,6 @@
((pragma) #t) ;; ignore for now
(else (error "bad cpp flow stmt"))))
(define (eval-cpp-stmt/code stmt)
(with-throw-handler
'cpp-error
(lambda () (eval-cpp-stmt-1/code stmt))
(lambda (key fmt . rest)
(report-error fmt rest)
(throw 'c99-error "CPP error"))))
(define (eval-cpp-stmt-1/file stmt)
(case (car stmt)
((if) (cpi-push))
@ -389,15 +381,17 @@
((pragma) #t) ;; need to work this
(else (error "bad cpp flow stmt"))))
(define (eval-cpp-stmt/file stmt)
(define (eval-cpp-stmt stmt)
(with-throw-handler
'cpp-error
(lambda () (eval-cpp-stmt-1/file stmt))
(lambda ()
(case mode
((code) (eval-cpp-stmt-1/code stmt))
((file) (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!
(define (read-cpp-stmt ch)
@ -416,13 +410,10 @@
((read-comm ch #t) => assc-$)
((read-cpp-stmt ch) =>
(lambda (stmt)
(eval-cpp-stmt stmt)
(case mode
((code)
(eval-cpp-stmt/code stmt)
(iter (read-char)))
((file)
(eval-cpp-stmt/file stmt)
(assc-$ `(cpp-stmt ,stmt))))))
((code) (iter (read-char)))
((file) (assc-$ `(cpp-stmt . ,stmt))))))
(else (iter ch))))
((read-ident ch) =>
(lambda (name)
@ -453,10 +444,8 @@
;; 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)
(case (car ppxs)
((keep)
;;(simple-format #t "lx=>~S\n" pair)
pair)
((skip-done skip-look)
(iter (read-token)))

4
module/nyacc/lang/c99/mach.d/c99act.scm
View File

@ -704,7 +704,7 @@
;; external-declaration-list => external-declaration-list external-decla...
(lambda ($2 $1 . $rest)
(if (eqv? (sx-tag $2) 'extern-block)
(tl-extend $1 (sx-tail $2 2))
(tl-extend $1 (sx-tail $2 1))
(tl-append $1 $2)))
;; external-declaration => function-definition
(lambda ($1 . $rest) $1)
@ -762,7 +762,7 @@
;; lone-comment => '$lone-comm
(lambda ($1 . $rest) `(comment ,$1))
;; cpp-statement => 'cpp-stmt
(lambda ($1 . $rest) $1)
(lambda ($1 . $rest) `(cpp-stmt ,$1))
;; pragma => 'cpp-pragma
(lambda ($1 . $rest) $1)
))

4
module/nyacc/lang/c99/mach.d/c99xact.scm
View File

@ -704,7 +704,7 @@
;; external-declaration-list => external-declaration-list external-decla...
(lambda ($2 $1 . $rest)
(if (eqv? (sx-tag $2) 'extern-block)
(tl-extend $1 (sx-tail $2 2))
(tl-extend $1 (sx-tail $2 1))
(tl-append $1 $2)))
;; external-declaration => function-definition
(lambda ($1 . $rest) $1)
@ -762,7 +762,7 @@
;; lone-comment => '$lone-comm
(lambda ($1 . $rest) `(comment ,$1))
;; cpp-statement => 'cpp-stmt
(lambda ($1 . $rest) $1)
(lambda ($1 . $rest) `(cpp-stmt ,$1))
;; pragma => 'cpp-pragma
(lambda ($1 . $rest) $1)
))

19
module/nyacc/lang/c99/mach.scm
View File

@ -429,13 +429,12 @@
)
(parameter-declaration
(declaration-specifiers declarator
($$ `(param-decl ,(tl->list $1)
(param-declr ,$2))))
(declaration-specifiers abstract-declarator
($$ `(param-decl ,(tl->list $1)
(param-declr ,$2))))
(declaration-specifiers ($$ `(param-decl ,(tl->list $1))))
(declaration-specifiers
declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
(declaration-specifiers
abstract-declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
(declaration-specifiers
($$ `(param-decl ,(tl->list $1))))
)
(identifier-list
@ -614,7 +613,7 @@
(external-declaration-list
external-declaration
;; A ``kludge'' to deal with @code{extern "C" ...}:
($$ (if (eqv? (sx-tag $2) 'extern-block) (tl-extend $1 (sx-tail $2 2))
($$ (if (eqv? (sx-tag $2) 'extern-block) (tl-extend $1 (sx-tail $2 1))
(tl-append $1 $2))))
)
@ -645,7 +644,7 @@
(declaration-list declaration ($$ (tl-append $1 $2)))
)
(opt-code-comment () (code-comment))
(opt-code-comment ($empty) (code-comment))
;; non-terminal leaves
(identifier
@ -660,7 +659,7 @@
(string-literal $string ($$ (tl-append $1 $2))))
(code-comment ($code-comm ($$ `(comment ,$1))))
(lone-comment ($lone-comm ($$ `(comment ,$1))))
(cpp-statement ('cpp-stmt))
(cpp-statement ('cpp-stmt ($$ `(cpp-stmt ,$1))))
(pragma ('cpp-pragma))
)))