nyacc: I think cpp is working now
This commit is contained in:
parent
5baa7f33b1
commit
1ae749b25f
|
@ -355,14 +355,6 @@
|
||||||
((pragma) #t) ;; ignore for now
|
((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
|
|
||||||
'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)
|
(define (eval-cpp-stmt-1/file stmt)
|
||||||
(case (car stmt)
|
(case (car stmt)
|
||||||
((if) (cpi-push))
|
((if) (cpi-push))
|
||||||
|
@ -389,15 +381,17 @@
|
||||||
((pragma) #t) ;; need to work this
|
((pragma) #t) ;; need to work this
|
||||||
(else (error "bad cpp flow stmt"))))
|
(else (error "bad cpp flow stmt"))))
|
||||||
|
|
||||||
(define (eval-cpp-stmt/file stmt)
|
(define (eval-cpp-stmt stmt)
|
||||||
(with-throw-handler
|
(with-throw-handler
|
||||||
'cpp-error
|
'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)
|
(lambda (key fmt . rest)
|
||||||
(report-error fmt rest)
|
(report-error fmt rest)
|
||||||
(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!
|
;; We should not be doing this!
|
||||||
(define (read-cpp-stmt ch)
|
(define (read-cpp-stmt ch)
|
||||||
|
@ -416,13 +410,10 @@
|
||||||
((read-comm ch #t) => assc-$)
|
((read-comm ch #t) => assc-$)
|
||||||
((read-cpp-stmt ch) =>
|
((read-cpp-stmt ch) =>
|
||||||
(lambda (stmt)
|
(lambda (stmt)
|
||||||
|
(eval-cpp-stmt stmt)
|
||||||
(case mode
|
(case mode
|
||||||
((code)
|
((code) (iter (read-char)))
|
||||||
(eval-cpp-stmt/code stmt)
|
((file) (assc-$ `(cpp-stmt . ,stmt))))))
|
||||||
(iter (read-char)))
|
|
||||||
((file)
|
|
||||||
(eval-cpp-stmt/file stmt)
|
|
||||||
(assc-$ `(cpp-stmt ,stmt))))))
|
|
||||||
(else (iter ch))))
|
(else (iter ch))))
|
||||||
((read-ident ch) =>
|
((read-ident ch) =>
|
||||||
(lambda (name)
|
(lambda (name)
|
||||||
|
@ -453,10 +444,8 @@
|
||||||
|
|
||||||
;; Loop between reading tokens and skipping tokens via CPP logic.
|
;; Loop between reading tokens and skipping tokens via CPP logic.
|
||||||
(let iter ((pair (read-token)))
|
(let iter ((pair (read-token)))
|
||||||
;;(simple-format #t "iter ~S\n" (car ppxs)) (sleep 1)
|
|
||||||
(case (car ppxs)
|
(case (car ppxs)
|
||||||
((keep)
|
((keep)
|
||||||
;;(simple-format #t "lx=>~S\n" pair)
|
|
||||||
pair)
|
pair)
|
||||||
((skip-done skip-look)
|
((skip-done skip-look)
|
||||||
(iter (read-token)))
|
(iter (read-token)))
|
||||||
|
|
|
@ -704,7 +704,7 @@
|
||||||
;; external-declaration-list => external-declaration-list external-decla...
|
;; external-declaration-list => external-declaration-list external-decla...
|
||||||
(lambda ($2 $1 . $rest)
|
(lambda ($2 $1 . $rest)
|
||||||
(if (eqv? (sx-tag $2) 'extern-block)
|
(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)))
|
(tl-append $1 $2)))
|
||||||
;; external-declaration => function-definition
|
;; external-declaration => function-definition
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) $1)
|
||||||
|
@ -762,7 +762,7 @@
|
||||||
;; lone-comment => '$lone-comm
|
;; lone-comment => '$lone-comm
|
||||||
(lambda ($1 . $rest) `(comment ,$1))
|
(lambda ($1 . $rest) `(comment ,$1))
|
||||||
;; cpp-statement => 'cpp-stmt
|
;; cpp-statement => 'cpp-stmt
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) `(cpp-stmt ,$1))
|
||||||
;; pragma => 'cpp-pragma
|
;; pragma => 'cpp-pragma
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) $1)
|
||||||
))
|
))
|
||||||
|
|
|
@ -704,7 +704,7 @@
|
||||||
;; external-declaration-list => external-declaration-list external-decla...
|
;; external-declaration-list => external-declaration-list external-decla...
|
||||||
(lambda ($2 $1 . $rest)
|
(lambda ($2 $1 . $rest)
|
||||||
(if (eqv? (sx-tag $2) 'extern-block)
|
(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)))
|
(tl-append $1 $2)))
|
||||||
;; external-declaration => function-definition
|
;; external-declaration => function-definition
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) $1)
|
||||||
|
@ -762,7 +762,7 @@
|
||||||
;; lone-comment => '$lone-comm
|
;; lone-comment => '$lone-comm
|
||||||
(lambda ($1 . $rest) `(comment ,$1))
|
(lambda ($1 . $rest) `(comment ,$1))
|
||||||
;; cpp-statement => 'cpp-stmt
|
;; cpp-statement => 'cpp-stmt
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) `(cpp-stmt ,$1))
|
||||||
;; pragma => 'cpp-pragma
|
;; pragma => 'cpp-pragma
|
||||||
(lambda ($1 . $rest) $1)
|
(lambda ($1 . $rest) $1)
|
||||||
))
|
))
|
||||||
|
|
|
@ -429,13 +429,12 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(parameter-declaration
|
(parameter-declaration
|
||||||
(declaration-specifiers declarator
|
(declaration-specifiers
|
||||||
($$ `(param-decl ,(tl->list $1)
|
declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
|
||||||
(param-declr ,$2))))
|
(declaration-specifiers
|
||||||
(declaration-specifiers abstract-declarator
|
abstract-declarator ($$ `(param-decl ,(tl->list $1) (param-declr ,$2))))
|
||||||
($$ `(param-decl ,(tl->list $1)
|
(declaration-specifiers
|
||||||
(param-declr ,$2))))
|
($$ `(param-decl ,(tl->list $1))))
|
||||||
(declaration-specifiers ($$ `(param-decl ,(tl->list $1))))
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(identifier-list
|
(identifier-list
|
||||||
|
@ -614,7 +613,7 @@
|
||||||
(external-declaration-list
|
(external-declaration-list
|
||||||
external-declaration
|
external-declaration
|
||||||
;; A ``kludge'' to deal with @code{extern "C" ...}:
|
;; 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))))
|
(tl-append $1 $2))))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -645,7 +644,7 @@
|
||||||
(declaration-list declaration ($$ (tl-append $1 $2)))
|
(declaration-list declaration ($$ (tl-append $1 $2)))
|
||||||
)
|
)
|
||||||
|
|
||||||
(opt-code-comment () (code-comment))
|
(opt-code-comment ($empty) (code-comment))
|
||||||
|
|
||||||
;; non-terminal leaves
|
;; non-terminal leaves
|
||||||
(identifier
|
(identifier
|
||||||
|
@ -660,7 +659,7 @@
|
||||||
(string-literal $string ($$ (tl-append $1 $2))))
|
(string-literal $string ($$ (tl-append $1 $2))))
|
||||||
(code-comment ($code-comm ($$ `(comment ,$1))))
|
(code-comment ($code-comm ($$ `(comment ,$1))))
|
||||||
(lone-comment ($lone-comm ($$ `(comment ,$1))))
|
(lone-comment ($lone-comm ($$ `(comment ,$1))))
|
||||||
(cpp-statement ('cpp-stmt))
|
(cpp-statement ('cpp-stmt ($$ `(cpp-stmt ,$1))))
|
||||||
(pragma ('cpp-pragma))
|
(pragma ('cpp-pragma))
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue