((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))
((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)
((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)
;; 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)))
;; 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)
;; 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)
))
;; 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)
;; 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)
))
)
(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
(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))))
)
(declaration-list declaration ($$ (tl-append $1 $2)))
)
- (opt-code-comment () (code-comment))
+ (opt-code-comment ($empty) (code-comment))
;; non-terminal leaves
(identifier
(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))
)))