nyacc: updates for cpp-ok/not-ok
This commit is contained in:
Matt Wette
Jan Nieuwenhuizen
parent
2df0f57a30
commit
baea80d962
|
|
@ -1,5 +1,9 @@
|
|||
2017-01-02 Matt Wette <mwette@alumni.caltech.edu>
|
||||
|
||||
* lang/c99/mach.scm (c99-spec): added hooks (cpp-ok!, no-cpp!) to
|
||||
provide handshaking between parser and lexer wrt when the lexer
|
||||
can pass CPP statements to the parser
|
||||
|
||||
* lang/c99/cppbody.scm (expand-cpp-mref): skip ws between ident
|
||||
and left paren
|
||||
|
||||
|
|
|
|||
|
|
@ -17,17 +17,7 @@
|
|||
|
||||
;; C parser body, with cpp and tables makes a parser
|
||||
|
||||
(define-record-type cpi
|
||||
(make-cpi-1)
|
||||
cpi?
|
||||
(debug cpi-debug set-cpi-debug!) ; debug #t #f
|
||||
(defines cpi-defs set-cpi-defs!) ; #defines
|
||||
(incdirs cpi-incs set-cpi-incs!) ; #includes
|
||||
(tn-dict cpi-tynd set-cpi-tynd!) ; typename dict (("<x>" foo_t ..
|
||||
(ptl cpi-ptl set-cpi-ptl!) ; parent typename list
|
||||
(ctl cpi-ctl set-cpi-ctl!) ; current typename list
|
||||
(top cpi-top set-cpi-top!) ; top level?
|
||||
)
|
||||
;;(use-modules (ice-9 pretty-print))
|
||||
|
||||
(define std-dict
|
||||
'(
|
||||
|
|
@ -63,15 +53,27 @@
|
|||
("wctype.h" "wctrans_t" "wctype_t" "wint_t")
|
||||
))
|
||||
|
||||
(define-record-type cpi
|
||||
(make-cpi-1)
|
||||
cpi?
|
||||
(debug cpi-debug set-cpi-debug!) ; debug #t #f
|
||||
(defines cpi-defs set-cpi-defs!) ; #defines
|
||||
(incdirs cpi-incs set-cpi-incs!) ; #includes
|
||||
(tn-dict cpi-tynd set-cpi-tynd!) ; typename dict (("<x>" foo_t ..
|
||||
(ptl cpi-ptl set-cpi-ptl!) ; parent typename list
|
||||
(ctl cpi-ctl set-cpi-ctl!) ; current typename list
|
||||
(cppok cpi-cppok set-cpi-cppok!) ; OK to pass CPP stmts to parser
|
||||
)
|
||||
|
||||
(define (make-cpi debug defines incdirs tn-dict)
|
||||
(let* ((cpi (make-cpi-1)))
|
||||
(set-cpi-debug! cpi debug)
|
||||
(set-cpi-defs! cpi defines)
|
||||
(set-cpi-incs! cpi incdirs)
|
||||
(set-cpi-tynd! cpi (append tn-dict std-dict))
|
||||
(set-cpi-ptl! cpi '()) ; list of lists of strings
|
||||
(set-cpi-ctl! cpi '()) ; list of strings ?
|
||||
(set-cpi-top! cpi #f) ; at top level
|
||||
(set-cpi-ptl! cpi '()) ; list of lists of typedef strings
|
||||
(set-cpi-ctl! cpi '()) ; list of typedef strings
|
||||
(set-cpi-cppok! cpi #f) ; don't assume OK to pass CPP stmts
|
||||
cpi))
|
||||
|
||||
;; Need to have a "CPI" stack to deal with types (re)defined in multiple
|
||||
|
|
@ -112,38 +114,42 @@
|
|||
(let ((cpi (fluid-ref *info*)))
|
||||
(set-cpi-ptl! cpi (cons (cpi-ctl cpi) (cpi-ptl cpi)))
|
||||
(set-cpi-ctl! cpi '())
|
||||
;;(simple-format #t "pu: ~S\n" (cpi-ctl cpi))
|
||||
(simple-format #t "pu: ~S\n" (cpi-ctl cpi))
|
||||
))
|
||||
|
||||
(define (cpi-shift) ;; on #elif #else
|
||||
(simple-format #t "sh\n")
|
||||
(set-cpi-ctl! (fluid-ref *info*) '()))
|
||||
|
||||
(define (cpi-pop) ;; on #endif
|
||||
(let ((cpi (fluid-ref *info*)))
|
||||
;;(simple-format #t "po<: ~S ~S\n" (cpi-ctl cpi) (cpi-ptl cpi))
|
||||
(simple-format #t "po<: ~S ~S\n" (cpi-ctl cpi) (cpi-ptl cpi))
|
||||
(set-cpi-ctl! cpi (append (cpi-ctl cpi) (car (cpi-ptl cpi))))
|
||||
(set-cpi-ptl! cpi (cdr (cpi-ptl cpi)))
|
||||
;;(simple-format #t "po>: ~S ~S\n" (cpi-ctl cpi) (cpi-ptl cpi))
|
||||
(simple-format #t "po>: ~S ~S\n" (cpi-ctl cpi) (cpi-ptl cpi))
|
||||
))
|
||||
|
||||
(use-modules (ice-9 pretty-print))
|
||||
;; The following three routines are used to allow pass cpp-statements to the
|
||||
;; parser. See how include is handled in the lexer.
|
||||
|
||||
;; The following three routines are used in an attempt to track the state
|
||||
;; of the parse with respect to top-level declarations, in order to know
|
||||
;; when includes can be parsed recursively. See how include is handled in
|
||||
;; the lexer.
|
||||
|
||||
(define (at-top!) ;; declare parse at top-level; called by the parser
|
||||
(define (cpp-ok!) ;; declare OK to pass cpp-stmt to parser
|
||||
(simple-format #t "cpp-ok! ~S\n" (port-line (current-input-port)))
|
||||
(let ((info (fluid-ref *info*)))
|
||||
(set-cpi-top! info #t)))
|
||||
(set-cpi-cppok! info #t)))
|
||||
|
||||
(define (at-top?) ;; predicate to determine if at top level; called by lexer
|
||||
(cpi-top (fluid-ref *info*)))
|
||||
|
||||
(define (not-top!) ;; declare parser not at top-level; called by the lexer
|
||||
(define (no-cpp!) ;; declare not OK to pass cpp-stmt to parser
|
||||
(simple-format #t "no-cpp! ~S\n" (port-line (current-input-port)))
|
||||
(let ((info (fluid-ref *info*)))
|
||||
(set-cpi-top! info #f)))
|
||||
(set-cpi-cppok! info #f)))
|
||||
|
||||
(define (cpp-ok?) ;; predicate called by lexer
|
||||
;;(simple-format #t "cpp-ok? ~S\n" (port-line (current-input-port)))
|
||||
(cpi-cppok (fluid-ref *info*)))
|
||||
|
||||
(define (no-cpp?) ;; predicate called by lexer
|
||||
;;(simple-format #t "no-cpp? ~S\n" (port-line (current-input-port)))
|
||||
(not (cpi-cppok (fluid-ref *info*))))
|
||||
|
||||
;; @deffn find-new-typenames decl
|
||||
;; Helper for @code{save-typenames}.
|
||||
;; Given declaration return a list of new typenames (via @code{typedef}).
|
||||
|
|
@ -179,7 +185,6 @@
|
|||
(for-each add-typename (find-new-typenames decl))
|
||||
decl)
|
||||
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
|
||||
;; @deffn read-cpp-line ch => #f | (cpp-xxxx)??
|
||||
|
|
@ -221,20 +226,46 @@
|
|||
(if (access? p R_OK) p (iter (cdr dirl)))))))
|
||||
|
||||
|
||||
;; @subsubsection CPP If-Else Processing
|
||||
;; @subsubsection CPP if-then-else Logic Block (ITLB) Processing
|
||||
;; The state is contained in a stack @code{ppxs}
|
||||
;; States are
|
||||
;; @table code
|
||||
;; @item skip
|
||||
;; @item skip-done
|
||||
;; skip code
|
||||
;; @item skip-look
|
||||
;; skipping code, but still looking for true at this level
|
||||
;; @item keep
|
||||
;; keep code
|
||||
;; @item keep1
|
||||
;; NOT USED keep one token and pop skip-stack
|
||||
;; @item skip-one
|
||||
;; @item skip1-pop
|
||||
;; skip one token and pop skip-stack
|
||||
;; @end table
|
||||
;; Also, if we want to pass on all the sections of an ITLB to the parser
|
||||
;; we need to remove typedef names because a typedef may appear multiple
|
||||
;; times, as in
|
||||
;; @example
|
||||
;; #ifdef SIXTYFOURBIT
|
||||
;; typedef short int32_t;
|
||||
;; #else
|
||||
;; typedef long int32_t;
|
||||
;; #endif
|
||||
;; @end example
|
||||
;; @noindent
|
||||
;; To achieve this we keep a stack of valid typedefs. On @code{#if} we push,
|
||||
;; on @code{#elif} we shift (i.e., pop, then push) and on @code{#endif} we pop.
|
||||
|
||||
;; @example
|
||||
;; (code
|
||||
;; ("if" cond code "endif")
|
||||
;; ("if" cond code "else" code "endif")
|
||||
;; ("if" cond code elif-list "endif")
|
||||
;; ("if" cond code elif-list "else" code "endif")
|
||||
;; (other))
|
||||
;; (elif-list
|
||||
;; ("elif" cond code)
|
||||
;; (elif-list "elif" cond code))
|
||||
;; @end example
|
||||
;; @noindent
|
||||
;; For each level of "if" we track the state.
|
||||
|
||||
;; NOTE: if file mode we usually keep #ifdefs. The lone exception is
|
||||
;; @code{#if 0}
|
||||
|
|
@ -252,6 +283,7 @@
|
|||
(eqv? mode 'code))
|
||||
|
||||
;; @deffn gen-c-lexer [#:mode mode] [#:xdef? proc] => thunk
|
||||
|
||||
(define gen-c-lexer
|
||||
;; This gets ugly in order to handle cpp.
|
||||
;;.need to add support for num's w/ letters like @code{14L} and @code{1.3f}.
|
||||
|
|
@ -284,7 +316,7 @@
|
|||
;; ppev?: (proc ???) => #t|#f : do we eval-and-honor #if/#else ?
|
||||
(lambda* (#:key (mode 'code) (xdef? #f))
|
||||
(let ((bol #t) ; begin-of-line condition
|
||||
(skip (list 'keep)) ; CPP skip-input stack
|
||||
(ppxs (list 'keep)) ; CPP execution state stack
|
||||
(info (fluid-ref *info*)) ; assume make and run in same thread
|
||||
(pstk '()) ; port stack
|
||||
(x-def? (or xdef? def-xdef?)))
|
||||
|
|
@ -292,7 +324,7 @@
|
|||
(lambda ()
|
||||
|
||||
(define (eval-flow?)
|
||||
(eqv? mode 'code))
|
||||
(or (no-cpp?) (eqv? mode 'code)))
|
||||
|
||||
(define (add-define tree)
|
||||
(let* ((tail (cdr tree))
|
||||
|
|
@ -306,6 +338,7 @@
|
|||
(set-cpi-defs! info (delete name (cpi-defs info))))
|
||||
|
||||
(define (exec-cpp line)
|
||||
(simple-format #t "exec-cpp: (cpp-ok=~S) ~S\n" (cpp-ok?) line)
|
||||
;; Parse the line into a CPP stmt, execute it, and return it.
|
||||
(let* ((stmt (read-cpp-stmt line)))
|
||||
(case (car stmt)
|
||||
|
|
@ -316,7 +349,7 @@
|
|||
(tynd (assoc-ref (cpi-tynd info) file)))
|
||||
(cond
|
||||
(tynd (for-each add-typename tynd)) ; in dot-h dict
|
||||
((and #t (eqv? mode 'code)) ; include flat
|
||||
((or (no-cpp?) (eqv? mode 'code)) ; include flat
|
||||
(if (not path) (throw 'parse-error "not found: ~S" file))
|
||||
(push-input (open-input-file path))
|
||||
(set! stmt #f))
|
||||
|
|
@ -324,7 +357,6 @@
|
|||
(if (not path) (throw 'parse-error "not found: ~A" path))
|
||||
(let* ((tree (with-input-from-file path run-parse)))
|
||||
(if (not tree) (throw 'parse-error "~A" path))
|
||||
;;(simple-format #t "INCLUDE top?=~S\n" (at-top?))
|
||||
(for-each add-define (xp1 tree)) ; add def's
|
||||
;; Attach tree onto "include" statement.
|
||||
(if (pair? tree)
|
||||
|
|
@ -339,16 +371,15 @@
|
|||
(if (eval-flow?)
|
||||
(let* ((defs (cpi-defs info))
|
||||
(rhs (cpp-expand-text (cadr stmt) defs))
|
||||
;; rhs = "defined(1)" :(
|
||||
(exp (parse-cpp-expr rhs))
|
||||
(val (eval-cpp-expr exp defs)))
|
||||
(cond
|
||||
((not val)
|
||||
(throw 'parse-error "unresolved: ~S" (cadr stmt)))
|
||||
((zero? val)
|
||||
(set! skip (cons* 'skip-one 'skip-look skip)))
|
||||
(set! ppxs (cons* 'skip1-pop 'skip-look ppxs)))
|
||||
(else
|
||||
(set! skip (cons* 'skip-one (car skip) skip)))))))
|
||||
(set! ppxs (cons* 'skip1-pop (car ppxs) ppxs)))))))
|
||||
((elif)
|
||||
(if (eval-flow?)
|
||||
(let* ((defs (cpi-defs info))
|
||||
|
|
@ -358,30 +389,30 @@
|
|||
(cond
|
||||
((not val)
|
||||
(throw 'parse-error "unresolved: ~S" (cadr stmt)))
|
||||
((eq? 'keep (car skip))
|
||||
(set! skip (cons* 'skip-one 'skip (cdr skip))))
|
||||
((eq? 'keep (car ppxs))
|
||||
(set! ppxs (cons* 'skip1-pop 'skip-done (cdr ppxs))))
|
||||
((zero? val)
|
||||
(set! skip (cons* 'skip-one skip)))
|
||||
((eq? 'skip-look (car skip))
|
||||
(set! ppxs (cons* 'skip1-pop ppxs)))
|
||||
((eq? 'skip-look (car ppxs))
|
||||
(cpi-shift)
|
||||
(set! skip (cons* 'skip-one 'keep (cdr skip))))
|
||||
(set! ppxs (cons* 'skip1-pop 'keep (cdr ppxs))))
|
||||
(else
|
||||
(cpi-shift)
|
||||
(set! skip (cons* 'skip-one 'skip (cdr skip))))))
|
||||
(set! ppxs (cons* 'skip1-pop 'skip-done (cdr ppxs))))))
|
||||
(cpi-shift)))
|
||||
((else)
|
||||
(if (eval-flow?)
|
||||
(cond
|
||||
((eq? 'skip-look (car skip))
|
||||
((eq? 'skip-look (car ppxs))
|
||||
(cpi-shift)
|
||||
(set! skip (cons* 'skip-one 'keep (cdr skip))))
|
||||
(set! ppxs (cons* 'skip1-pop 'keep (cdr ppxs))))
|
||||
(else
|
||||
(set! skip (cons* 'skip-one 'skip (cdr skip)))))
|
||||
(set! ppxs (cons* 'skip1-pop 'skip-done (cdr ppxs)))))
|
||||
(cpi-shift)))
|
||||
((endif)
|
||||
(cpi-pop)
|
||||
(if (eval-flow?)
|
||||
(set! skip (cons 'skip-one (cdr skip)))))
|
||||
(set! ppxs (cons 'skip1-pop (cdr ppxs)))))
|
||||
((error)
|
||||
stmt)
|
||||
(else
|
||||
|
|
@ -434,14 +465,19 @@
|
|||
(else (unread-char ch) (cons #\\ "\\"))))) ;; parse err
|
||||
(else (cons ch (string ch))))))
|
||||
|
||||
;; Loop between reading tokens and skipping tokens.
|
||||
;; The use of "delayed pop" is not clean IMO. Cleaner way?
|
||||
;; Loop between reading tokens and skipping tokens via CPP logic.
|
||||
(let loop ((pair (read-token)))
|
||||
(case (car skip)
|
||||
((keep) pair)
|
||||
((skip skip-look) (loop (read-token)))
|
||||
((skip-one)
|
||||
(set! skip (cdr skip))
|
||||
(simple-format #t "ppxs=~S ~S\n" ppxs
|
||||
(port-line (current-input-port)))
|
||||
(case (car ppxs)
|
||||
((keep)
|
||||
(no-cpp!)
|
||||
(simple-format #t "token=~S\n" pair)
|
||||
pair)
|
||||
((skip-done skip-look)
|
||||
(loop (read-token)))
|
||||
((skip1-pop)
|
||||
(set! ppxs (cdr ppxs))
|
||||
(loop (read-token)))))
|
||||
)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -622,19 +622,23 @@
|
|||
(lambda ($3 $2 $1 . $rest) (list 'array-dsgr $2))
|
||||
;; designator => "." identifier
|
||||
(lambda ($2 $1 . $rest) (list 'sel-dsgr $2))
|
||||
;; statement => labeled-statement
|
||||
;; statement => $P2 statement-1
|
||||
(lambda ($2 $1 . $rest) $2)
|
||||
;; $P2 =>
|
||||
(lambda $rest (cpp-ok!))
|
||||
;; statement-1 => labeled-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => compound-statement
|
||||
;; statement-1 => compound-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => expression-statement
|
||||
;; statement-1 => expression-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => selection-statement
|
||||
;; statement-1 => selection-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => iteration-statement
|
||||
;; statement-1 => iteration-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => jump-statement
|
||||
;; statement-1 => jump-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => cpp-statement
|
||||
;; statement-1 => cpp-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; labeled-statement => identifier ":" statement
|
||||
(lambda ($3 $2 $1 . $rest)
|
||||
|
|
@ -699,30 +703,32 @@
|
|||
(lambda ($3 $2 $1 . $rest) `(return ,$2))
|
||||
;; jump-statement => "return" ";"
|
||||
(lambda ($2 $1 . $rest) `(return (expr)))
|
||||
;; translation-unit => external-declaration-proxy
|
||||
;; translation-unit => external-declaration
|
||||
(lambda ($1 . $rest) (make-tl 'trans-unit $1))
|
||||
;; translation-unit => translation-unit external-declaration-proxy
|
||||
;; translation-unit => translation-unit external-declaration
|
||||
(lambda ($2 $1 . $rest)
|
||||
(cond ((eqv? 'trans-unit (car $2))
|
||||
(let* ((t1 (tl-append $1 '(extern-C-begin)))
|
||||
(t2 (tl-extend t1 (cdr $2)))
|
||||
(t3 (tl-append t2 '(extern-C-end))))
|
||||
t3))
|
||||
(else (tl-append $1 $2))))
|
||||
;; external-declaration-proxy => $P2 external-declaration
|
||||
(if (eqv? (sx-tag $2) 'extern-block)
|
||||
(tl-extend $1 (sx-tail $2))
|
||||
(tl-append $1 $2)))
|
||||
;; external-declaration => $P3 external-declaration-1
|
||||
(lambda ($2 $1 . $rest) $2)
|
||||
;; $P2 =>
|
||||
(lambda $rest (at-top!))
|
||||
;; external-declaration => function-definition
|
||||
;; $P3 =>
|
||||
(lambda $rest (cpp-ok!))
|
||||
;; external-declaration-1 => function-definition
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => declaration
|
||||
;; external-declaration-1 => declaration
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => lone-comment
|
||||
;; external-declaration-1 => lone-comment
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => cpp-statement
|
||||
;; external-declaration-1 => cpp-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => "extern" '$string "{" translation-unit "}"
|
||||
(lambda ($5 $4 $3 $2 $1 . $rest) (tl->list $4))
|
||||
;; external-declaration-1 => "extern" '$string "{" translation-unit "}"
|
||||
(lambda ($5 $4 $3 $2 $1 . $rest)
|
||||
`(extern-block
|
||||
$2
|
||||
(extern-C-begin)
|
||||
$4
|
||||
(extern-C-end)))
|
||||
;; function-definition => declaration-specifiers declarator declaration-...
|
||||
(lambda ($4 $3 $2 $1 . $rest)
|
||||
`(knr-fctn-defn
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -622,19 +622,23 @@
|
|||
(lambda ($3 $2 $1 . $rest) (list 'array-dsgr $2))
|
||||
;; designator => "." identifier
|
||||
(lambda ($2 $1 . $rest) (list 'sel-dsgr $2))
|
||||
;; statement => labeled-statement
|
||||
;; statement => $P2 statement-1
|
||||
(lambda ($2 $1 . $rest) $2)
|
||||
;; $P2 =>
|
||||
(lambda $rest (cpp-ok!))
|
||||
;; statement-1 => labeled-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => compound-statement
|
||||
;; statement-1 => compound-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => expression-statement
|
||||
;; statement-1 => expression-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => selection-statement
|
||||
;; statement-1 => selection-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => iteration-statement
|
||||
;; statement-1 => iteration-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => jump-statement
|
||||
;; statement-1 => jump-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; statement => cpp-statement
|
||||
;; statement-1 => cpp-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; labeled-statement => identifier ":" statement
|
||||
(lambda ($3 $2 $1 . $rest)
|
||||
|
|
@ -699,30 +703,32 @@
|
|||
(lambda ($3 $2 $1 . $rest) `(return ,$2))
|
||||
;; jump-statement => "return" ";"
|
||||
(lambda ($2 $1 . $rest) `(return (expr)))
|
||||
;; translation-unit => external-declaration-proxy
|
||||
;; translation-unit => external-declaration
|
||||
(lambda ($1 . $rest) (make-tl 'trans-unit $1))
|
||||
;; translation-unit => translation-unit external-declaration-proxy
|
||||
;; translation-unit => translation-unit external-declaration
|
||||
(lambda ($2 $1 . $rest)
|
||||
(cond ((eqv? 'trans-unit (car $2))
|
||||
(let* ((t1 (tl-append $1 '(extern-C-begin)))
|
||||
(t2 (tl-extend t1 (cdr $2)))
|
||||
(t3 (tl-append t2 '(extern-C-end))))
|
||||
t3))
|
||||
(else (tl-append $1 $2))))
|
||||
;; external-declaration-proxy => $P2 external-declaration
|
||||
(if (eqv? (sx-tag $2) 'extern-block)
|
||||
(tl-extend $1 (sx-tail $2))
|
||||
(tl-append $1 $2)))
|
||||
;; external-declaration => $P3 external-declaration-1
|
||||
(lambda ($2 $1 . $rest) $2)
|
||||
;; $P2 =>
|
||||
(lambda $rest (at-top!))
|
||||
;; external-declaration => function-definition
|
||||
;; $P3 =>
|
||||
(lambda $rest (cpp-ok!))
|
||||
;; external-declaration-1 => function-definition
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => declaration
|
||||
;; external-declaration-1 => declaration
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => lone-comment
|
||||
;; external-declaration-1 => lone-comment
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => cpp-statement
|
||||
;; external-declaration-1 => cpp-statement
|
||||
(lambda ($1 . $rest) $1)
|
||||
;; external-declaration => "extern" '$string "{" translation-unit "}"
|
||||
(lambda ($5 $4 $3 $2 $1 . $rest) (tl->list $4))
|
||||
;; external-declaration-1 => "extern" '$string "{" translation-unit "}"
|
||||
(lambda ($5 $4 $3 $2 $1 . $rest)
|
||||
`(extern-block
|
||||
$2
|
||||
(extern-C-begin)
|
||||
$4
|
||||
(extern-C-end)))
|
||||
;; function-definition => declaration-specifiers declarator declaration-...
|
||||
(lambda ($4 $3 $2 $1 . $rest)
|
||||
`(knr-fctn-defn
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -540,6 +540,8 @@
|
|||
|
||||
;; statements
|
||||
(statement
|
||||
(($$ (cpp-ok!)) statement-1 ($$ $2)))
|
||||
(statement-1
|
||||
(labeled-statement)
|
||||
(compound-statement)
|
||||
(expression-statement)
|
||||
|
|
@ -609,26 +611,23 @@
|
|||
|
||||
;; external definitions
|
||||
(translation-unit
|
||||
(external-declaration-proxy ($$ (make-tl 'trans-unit $1)))
|
||||
(external-declaration ($$ (make-tl 'trans-unit $1)))
|
||||
(translation-unit
|
||||
external-declaration-proxy
|
||||
($$ (cond ((eqv? 'trans-unit (car $2))
|
||||
(let* ((t1 (tl-append $1 '(extern-C-begin)))
|
||||
(t2 (tl-extend t1 (cdr $2)))
|
||||
(t3 (tl-append t2 '(extern-C-end))))
|
||||
t3))
|
||||
(else (tl-append $1 $2)))))
|
||||
external-declaration
|
||||
($$ (if (eqv? (sx-tag $2) 'extern-block) (tl-extend $1 (sx-tail $2))
|
||||
(tl-append $1 $2))))
|
||||
)
|
||||
|
||||
(external-declaration-proxy (($$ (at-top!)) external-declaration ($$ $2)))
|
||||
|
||||
(external-declaration
|
||||
(($$ (cpp-ok!)) external-declaration-1 ($$ $2)))
|
||||
(external-declaration-1
|
||||
(function-definition)
|
||||
(declaration)
|
||||
(lone-comment)
|
||||
(cpp-statement)
|
||||
;; The following is a kludge to deal with @code{extern "C" @{ ...}.
|
||||
("extern" $string "{" translation-unit "}" ($$ (tl->list $4)))
|
||||
("extern" $string "{" translation-unit "}"
|
||||
($$ `(extern-block $2 (extern-C-begin) $4 (extern-C-end))))
|
||||
)
|
||||
|
||||
(function-definition
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@
|
|||
#:use-module (nyacc lang c99 cpp)
|
||||
#:use-module ((srfi srfi-9) #:select (define-record-type))
|
||||
#:use-module ((sxml xpath) #:select (sxpath))
|
||||
;;#:use-module (nyacc lang c99 my-parse)
|
||||
)
|
||||
|
||||
(cond-expand
|
||||
|
|
@ -40,6 +41,7 @@
|
|||
|
||||
;; Parse given a token generator. Uses fluid @code{*info*}.
|
||||
(define raw-parser
|
||||
;;(make-c99-ia-parser
|
||||
(make-lalr-parser
|
||||
(list
|
||||
(cons 'len-v len-v)
|
||||
|
|
@ -57,8 +59,8 @@
|
|||
|
||||
(define (run-parse)
|
||||
(let ((info (fluid-ref *info*)))
|
||||
;;(raw-parser (gen-c-lexer) #:debug (cpi-debug info))))
|
||||
(raw-parser (my-c-lexer) #:debug (cpi-debug info))))
|
||||
;;(raw-parser (my-c-lexer) #:debug (cpi-debug info))))
|
||||
(raw-parser (gen-c-lexer) #:debug (cpi-debug info))))
|
||||
|
||||
;; @item parse-c [#:cpp-defs def-a-list] [#:inc-dirs dir-list] [#:debug bool] \
|
||||
;; [#:mode ('code|'file)]
|
||||
|
|
@ -78,6 +80,7 @@
|
|||
(with-fluid*
|
||||
*info* info
|
||||
(lambda ()
|
||||
(if (eqv? mode 'file) (cpp-ok!) (no-cpp!))
|
||||
(raw-parser (my-c-lexer #:mode mode #:xdef? xdef?)
|
||||
#:debug debug)))))
|
||||
(lambda (key fmt . rest)
|
||||
|
|
|
|||
Loading…
Reference in a new issue