mirror of
https://github.com/fosslinux/live-bootstrap.git
synced 2026-03-17 08:45:23 +01:00
649d7b68dc
mescc-tools-extra contains two important tools: - cp - chmod mes first builds itself from a mes 0.21 seed as used by guix, and then builds a mes 0.22 and then mes 0.22 using that created mes 0.22. It does /not/ use bootstrap.sh as we don't have a proper shell at this point, it has been manually adapted for kaem.
891 lines
36 KiB
Scheme
891 lines
36 KiB
Scheme
;;; lang/c99/mach.scm - C parser grammer
|
|
|
|
;; Copyright (C) 2015-2018 Matthew R. Wette
|
|
;;
|
|
;; This library is free software; you can redistribute it and/or
|
|
;; modify it under the terms of the GNU Lesser General Public
|
|
;; License as published by the Free Software Foundation; either
|
|
;; version 3 of the License, or (at your option) any later version.
|
|
;;
|
|
;; This library is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;; Lesser General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU Lesser General Public License
|
|
;; along with this library; if not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Notes:
|
|
|
|
;; This is a C parser, based on ISO-C99, with comments and CPP statements.
|
|
|
|
;; Currentl K&R function definitions are not supported:
|
|
;; int f(x) int x; { ... } => syntax error
|
|
;; because they lead to an ambiguous grammar, I believe:
|
|
;; int f(x) __attribute__((__static__)) int x; { ... }
|
|
|
|
;; See also:
|
|
;; http://www.quut.com/c/ANSI-C-grammar-y.html - C11 grammar
|
|
;; https://gcc.gnu.org/onlinedocs/gcc/C-Extensions.html#C-Extensions
|
|
|
|
;;; Code:
|
|
|
|
(define-module (nyacc lang c99 mach)
|
|
#:export (c99-spec c99-mach c99x-spec c99x-mach gen-c99-files)
|
|
#:use-module (nyacc lang c99 cpp)
|
|
#:use-module (nyacc lang util)
|
|
#:use-module (nyacc lalr)
|
|
#:use-module (nyacc parse)
|
|
#:use-module (nyacc lex)
|
|
#:use-module (nyacc util)
|
|
#:use-module ((srfi srfi-43) #:select (vector-map)))
|
|
|
|
;; @deffn {Variable} c99-spec
|
|
;; This variable is the specification a-list for the hacked ISO C99 language.
|
|
;; Well, actually, this does not produce pure C99 spec: it has been extended
|
|
;; to be able be used for practical purposes so it now parses forms like
|
|
;; @code{__asm__} and @code{__attribute__}.
|
|
;; Run this through @code{make-lalr-machine} to get an a-list for the
|
|
;; automaton. The grammar is modified to parse CPP statements and comments.
|
|
;; The output of the end parser will be a SXML tree (w/o the @code{*TOP*} node.
|
|
;; @end deffn
|
|
(define c99-spec
|
|
(lalr-spec
|
|
(notice (string-append "Copyright (C) 2016-2018 Matthew R. Wette"
|
|
license-lgpl3+))
|
|
|
|
(prec< 'then "else") ; "then/else" SR-conflict resolution
|
|
(prec< 'imp ; "implied type" SR-conflict resolution
|
|
(nonassoc "char" "short" "int" "long" "_Fract" "_Accum" "_Sat")
|
|
(nonassoc "float" "double" "_Complex"))
|
|
(prec< 'shift-on-attr ; living on the edge ...
|
|
(nonassoc "__attribute__" "__packed__" "__aligned__" "__alignof__")
|
|
'reduce-on-attr
|
|
'reduce-on-semi
|
|
(nonassoc "*" "(" '$ident))
|
|
|
|
(start translation-unit)
|
|
(grammar
|
|
|
|
;; === expressions ========================================================
|
|
|
|
(primary-expression ; S 6.5.1
|
|
(identifier ($$ `(p-expr ,$1)))
|
|
(constant ($$ `(p-expr ,$1)))
|
|
(string-literal ($$ `(p-expr ,$1)))
|
|
("(" expression ")" ($$ $2))
|
|
("(" "{" ($$ (cpi-push)) block-item-list ($$ (cpi-pop)) "}" ")"
|
|
($$ `(stmt-expr (@ (extension "GNUC")) ,$4))))
|
|
|
|
(postfix-expression ; S 6.5.2
|
|
(primary-expression)
|
|
(postfix-expression "[" expression "]" ($$ `(array-ref ,$3 ,$1)))
|
|
(postfix-expression "(" argument-expression-list ")"
|
|
($$ `(fctn-call ,$1 ,(tl->list $3))))
|
|
(postfix-expression "(" ")" ($$ `(fctn-call ,$1 (expr-list))))
|
|
(postfix-expression "." identifier ($$ `(d-sel ,$3 ,$1)))
|
|
(postfix-expression "->" identifier ($$ `(i-sel ,$3 ,$1)))
|
|
(postfix-expression "++" ($$ `(post-inc ,$1)))
|
|
(postfix-expression "--" ($$ `(post-dec ,$1)))
|
|
("(" type-name ")" "{" initializer-list "}"
|
|
($$ `(comp-lit ,$2 ,(tl->list $5))))
|
|
("(" type-name ")" "{" initializer-list "," "}"
|
|
($$ `(comp-lit ,$2 ,(tl->list $5)))))
|
|
|
|
(argument-expression-list
|
|
(assignment-expression ($$ (make-tl 'expr-list $1)))
|
|
(argument-expression-list "," assignment-expression ($$ (tl-append $1 $3)))
|
|
;; The following is a hack to deal with using abstract declarations
|
|
;; as arguments to CPP macros (e.g., see offsetof in <stddef.h>).
|
|
(arg-expr-hack ($$ (make-tl 'expr-list $1)))
|
|
(argument-expression-list "," arg-expr-hack ($$ (tl-append $1 $3))))
|
|
(arg-expr-hack
|
|
(declaration-specifiers
|
|
abstract-declarator ($$ `(param-decl ,(tl->list $1) $2)))
|
|
(declaration-specifiers ($$ `(param-decl ,(tl->list $1)))))
|
|
|
|
(unary-expression
|
|
(postfix-expression) ; S 6.5.3
|
|
("++" unary-expression ($$ `(pre-inc ,$2)))
|
|
("--" unary-expression ($$ `(pre-dec ,$2)))
|
|
(unary-operator cast-expression ($$ (list $1 $2)))
|
|
("sizeof" unary-expression ($$ `(sizeof-expr ,$2)))
|
|
("sizeof" "(" type-name ")" ($$ `(sizeof-type ,$3)))
|
|
)
|
|
(unary-operator ("&" ($$ 'ref-to)) ("*" ($$ 'de-ref))
|
|
("+" ($$ 'pos)) ("-" ($$ 'neg))
|
|
("~" ($$ 'bitwise-not)) ("!" ($$ 'not)))
|
|
|
|
(cast-expression ; S 6.5.4
|
|
(unary-expression)
|
|
("(" type-name ")" cast-expression ($$ `(cast ,$2 ,$4))))
|
|
|
|
(multiplicative-expression ; S 6.5.5
|
|
(cast-expression)
|
|
(multiplicative-expression "*" cast-expression ($$ `(mul ,$1 ,$3)))
|
|
(multiplicative-expression "/" cast-expression ($$ `(div ,$1 ,$3)))
|
|
(multiplicative-expression "%" cast-expression ($$ `(mod ,$1 ,$3))))
|
|
|
|
(additive-expression ; S 6.5.6
|
|
(multiplicative-expression)
|
|
(additive-expression "+" multiplicative-expression ($$ `(add ,$1 ,$3)))
|
|
(additive-expression "-" multiplicative-expression ($$ `(sub ,$1 ,$3))))
|
|
|
|
(shift-expression ; S 6.5.7
|
|
(additive-expression)
|
|
(shift-expression "<<" additive-expression ($$ `(lshift ,$1 ,$3)))
|
|
(shift-expression ">>" additive-expression ($$ `(rshift ,$1 ,$3))))
|
|
|
|
(relational-expression ; S 6.5.8
|
|
(shift-expression)
|
|
(relational-expression "<" shift-expression ($$ `(lt ,$1 ,$3)))
|
|
(relational-expression ">" shift-expression ($$ `(gt ,$1 ,$3)))
|
|
(relational-expression "<=" shift-expression ($$ `(le ,$1 ,$3)))
|
|
(relational-expression ">=" shift-expression ($$ `(ge ,$1 ,$3))))
|
|
|
|
(equality-expression ; S 6.5.9
|
|
(relational-expression)
|
|
(equality-expression "==" relational-expression ($$ `(eq ,$1 ,$3)))
|
|
(equality-expression "!=" relational-expression ($$ `(ne ,$1 ,$3))))
|
|
|
|
;; called AND-expression
|
|
(bitwise-and-expression ; S 6.5.10
|
|
(equality-expression)
|
|
(bitwise-and-expression "&" equality-expression
|
|
($$ `(bitwise-and ,$1 ,$3))))
|
|
|
|
;; called exclusive-OR-expression
|
|
(bitwise-xor-expression ; S 6.5.11
|
|
(bitwise-and-expression)
|
|
(bitwise-xor-expression "^" bitwise-and-expression
|
|
($$ `(bitwise-xor ,$1 ,$3))))
|
|
|
|
;; called inclusive-OR-expression
|
|
(bitwise-or-expression ; S 6.5.12
|
|
(bitwise-xor-expression)
|
|
(bitwise-or-expression "|" bitwise-xor-expression
|
|
($$ `(bitwise-or ,$1 ,$3))))
|
|
|
|
(logical-and-expression ; S 6.5.13
|
|
(bitwise-or-expression)
|
|
(logical-and-expression "&&" bitwise-or-expression
|
|
($$ `(and ,$1 ,$3))))
|
|
|
|
(logical-or-expression ; 6.5.14
|
|
(logical-and-expression)
|
|
(logical-or-expression "||" logical-and-expression
|
|
($$ `(or ,$1 ,$3))))
|
|
|
|
(conditional-expression
|
|
(logical-or-expression)
|
|
(logical-or-expression "?" expression ":" conditional-expression
|
|
($$ `(cond-expr ,$1 ,$3 ,$5))))
|
|
|
|
(assignment-expression ; S 6.5.16
|
|
(conditional-expression)
|
|
(unary-expression assignment-operator assignment-expression
|
|
($$ `(assn-expr ,$1 (op ,$2) ,$3))))
|
|
(assignment-operator
|
|
("=") ("+=") ("-=") ("*=") ("/=") ("%=")
|
|
("<<=") (">>=") ("&=") ("^=") ("|="))
|
|
|
|
(expression ; S 6.5.17
|
|
(assignment-expression)
|
|
(expression "," assignment-expression
|
|
($$ (if (eqv? 'comma-expr (sx-tag $1))
|
|
(append $1 (list $3))
|
|
`(comma-expr ,$1 ,$3)))))
|
|
|
|
(constant-expression ; S 6.6
|
|
(conditional-expression))
|
|
|
|
;; === declarations
|
|
|
|
;; TODO: check if we should move attributes or trap attribute-only spec's
|
|
(declaration ; S 6.7
|
|
(declaration-no-comment ";")
|
|
(declaration-no-comment ";" code-comment ($$ (sx-attr-add $1 $3))))
|
|
|
|
(declaration-no-comment
|
|
(declaration-specifiers
|
|
init-declarator-list
|
|
($$ (save-typenames `(decl ,$1 ,$2))))
|
|
(declaration-specifiers
|
|
($$ `(decl ,$1))))
|
|
|
|
;; --- declaration specifiers
|
|
|
|
(declaration-specifiers ; S 6.7
|
|
(declaration-specifiers-1 ($$ (process-specs (tl->list $1)))))
|
|
(declaration-specifiers-1
|
|
;; storage-class-specifiers
|
|
(storage-class-specifier
|
|
($prec 'shift-on-attr) ($$ (make-tl 'decl-spec-list $1)))
|
|
(storage-class-specifier declaration-specifiers-1 ($$ (tl-insert $2 $1)))
|
|
;; type-specifiers
|
|
(type-specifier
|
|
($prec 'reduce-on-attr) ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-specifier declaration-specifiers-1 ($$ (tl-insert $2 $1)))
|
|
;; type-qualifiers
|
|
(type-qualifier
|
|
($prec 'shift-on-attr) ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-qualifier declaration-specifiers-1 ($$ (tl-insert $2 $1)))
|
|
;; function-specifiers
|
|
(function-specifier
|
|
($prec 'reduce-on-attr) ($$ (make-tl 'decl-spec-list $1)))
|
|
(function-specifier declaration-specifiers-1 ($$ (tl-insert $2 $1)))
|
|
;; attribute-specifiers
|
|
(attribute-specifier
|
|
($prec 'reduce-on-semi) ($$ (make-tl 'decl-spec-list $1)))
|
|
(attribute-specifier declaration-specifiers-1 ($$ (tl-insert $2 $1))))
|
|
|
|
(storage-class-specifier ; S 6.7.1
|
|
("auto" ($$ '(stor-spec (auto))))
|
|
("extern" ($$ '(stor-spec (extern))))
|
|
("register" ($$ '(stor-spec (register))))
|
|
("static" ($$ '(stor-spec (static))))
|
|
("typedef" ($$ '(stor-spec (typedef)))))
|
|
|
|
;; I have created fixed-, float- and complex- type specifiers to capture
|
|
;; combinations like "short int" "long long" etc.
|
|
(type-specifier ; S 6.7.2
|
|
("void" ($$ '(type-spec (void))))
|
|
(fixed-type-specifier ($$ `(type-spec ,$1)))
|
|
(float-type-specifier ($$ `(type-spec ,$1)))
|
|
(fixpt-type-specifier ($$ `(type-spec ,$1)))
|
|
("_Bool" ($$/ref 's5.1.5-01 '(type-spec (fixed-type "_Bool"))))
|
|
(complex-type-specifier ($$ `(type-spec ,$1)))
|
|
(struct-or-union-specifier ($$ `(type-spec ,$1)))
|
|
(enum-specifier ($$ `(type-spec ,$1)))
|
|
(typedef-name ($$ `(type-spec ,$1))))
|
|
|
|
(fixed-type-specifier
|
|
("short" ($prec 'imp) ($$ '(fixed-type "short")))
|
|
("short" "int" ($$ '(fixed-type "short int")))
|
|
("signed" "short" ($prec 'imp) ($$ '(fixed-type "signed short")))
|
|
("signed" "short" "int" ($$ '(fixed-type "signed short int")))
|
|
("int" ($$ '(fixed-type "int")))
|
|
("signed" ($prec 'imp) ($$ '(fixed-type "signed")))
|
|
("signed" "int" ($$ '(fixed-type "signed int")))
|
|
("long" ($prec 'imp) ($$ '(fixed-type "long")))
|
|
("long" "int" ($$ '(fixed-type "long int")))
|
|
("signed" "long" ($prec 'imp) ($$ '(fixed-type "signed long")))
|
|
("signed" "long" "int" ($$ '(fixed-type "signed long int")))
|
|
("long" "long" ($prec 'imp) ($$ '(fixed-type "long long")))
|
|
("long" "long" "int" ($$ '(fixed-type "long long int")))
|
|
("signed" "long" "long" ($prec 'imp)
|
|
($$ '(fixed-type "signed long long")))
|
|
("signed" "long" "long" "int" ($$ '(fixed-type "signed long long int")))
|
|
("unsigned" "short" "int" ($$ '(fixed-type "unsigned short int")))
|
|
("unsigned" "short" ($prec 'imp) ($$ '(fixed-type "unsigned short")))
|
|
("unsigned" "int" ($$ '(fixed-type "unsigned int")))
|
|
("unsigned" ($prec 'imp) ($$ '(fixed-type "unsigned")))
|
|
("unsigned" "long" "int" ($$ '(fixed-type "unsigned long")))
|
|
("unsigned" "long" ($prec 'imp) ($$ '(fixed-type "unsigned long")))
|
|
("unsigned" "long" "long" "int"
|
|
($$ '(fixed-type "unsigned long long int")))
|
|
("unsigned" "long" "long" ($prec 'imp)
|
|
($$ '(fixed-type "unsigned long long")))
|
|
("char" ($$ '(fixed-type "char")))
|
|
("signed" "char" ($$ '(fixed-type "signed char")))
|
|
("unsigned" "char" ($$ '(fixed-type "unsigned char"))))
|
|
|
|
(float-type-specifier
|
|
("float" ($prec 'imp) ($$ '(float-type "float")))
|
|
("double" ($prec 'imp) ($$ '(float-type "double")))
|
|
("long" "double" ($$ '(float-type "long double"))))
|
|
|
|
(complex-type-specifier
|
|
("_Complex" ($$ '(complex-type "_Complex")))
|
|
("float" "_Complex" ($$ '(complex-type "float _Complex")))
|
|
("double" "_Complex" ($$ '(complex-type "double _Complex")))
|
|
("long" "double" "_Complex" ($$ '(complex-type "long double _Complex"))))
|
|
|
|
(fixpt-type-specifier
|
|
;; http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2001/n1290.pdf
|
|
("short" "_Fract" ($$ '(fixpt-type "short _Fract")))
|
|
("_Fract" ($$ '(fixpt-type "_Fract")))
|
|
("long" "_Fract" ($$ '(fixpt-type "long _Fract")))
|
|
("signed" "short" "_Fract" ($$ '(fixpt-type "signd short _Fract")))
|
|
("signed" "_Fract" ($$ '(fixpt-type "signed _Fract")))
|
|
("signed" "long _Fract" ($$ '(fixpt-type "signed long _Fract")))
|
|
("unsigned" "short" "_Fract" ($$ '(fixpt-type "unsigned short _Fract")))
|
|
("unsigned" "_Fract" ($$ '(fixpt-type "unsigned _Fract")))
|
|
("unsigned" "long _Fract" ($$ '(fixpt-type "unsigned long _Fract")))
|
|
("short" "_Accum" ($$ '(fixpt-type "short _Accum")))
|
|
("_Accum" ($$ '(fixpt-type "_Accum")))
|
|
("long _Accum" ($$ '(fixpt-type "long _Accum")))
|
|
("signed" "short" "_Accum" ($$ '(fixpt-type "signd short _Accum")))
|
|
("signed" "_Accum" ($$ '(fixpt-type "signed _Accum")))
|
|
("signed" "long" "_Accum" ($$ '(fixpt-type "signed long _Accum")))
|
|
("unsigned" "short" "_Accum" ($$ '(fixpt-type "unsigned short _Accum")))
|
|
("unsigned" "_Accum" ($$ '(fixpt-type "unsigned _Accum")))
|
|
("unsigned" "long" "_Accum" ($$ '(fixpt-type "unsigned long _Accum")))
|
|
("_Sat" "short" "_Fract" ($$ '(fixpt-type "_Sat short _Fract")))
|
|
("_Sat" "_Fract" ($$ '(fixpt-type "_Sat _Fract")))
|
|
("_Sat" "long" "_Fract" ($$ '(fixpt-type "_Sat long _Fract")))
|
|
("_Sat" "signed" "short" "_Fract"
|
|
($$ '(fixpt-type "_Sat signd short _Fract")))
|
|
("_Sat" "signed" "_Fract" ($$ '(fixpt-type "_Sat signed _Fract")))
|
|
("_Sat" "signed" "long _Fract"
|
|
($$ '(fixpt-type "_Sat signed long _Fract")))
|
|
("_Sat" "unsigned" "short" "_Fract"
|
|
($$ '(fixpt-type "_Sat unsigned short _Fract")))
|
|
("_Sat" "unsigned" "_Fract" ($$ '(fixpt-type "_Sat unsigned _Fract")))
|
|
("_Sat" "unsigned" "long" "_Fract"
|
|
($$ '(fixpt-type "_Sat unsigned long _Fract")))
|
|
("_Sat" "short" "_Accum" ($$ '(fixpt-type "_Sat short _Accum")))
|
|
("_Sat" "_Accum" ($$ '(fixpt-type "_Sat _Accum")))
|
|
("_Sat" "long" "_Accum" ($$ '(fixpt-type "_Sat long _Accum")))
|
|
("_Sat" "signed" "short" "_Accum"
|
|
($$ '(fixpt-type "_Sat signd short _Accum")))
|
|
("_Sat" "signed" "_Accum" ($$ '(fixpt-type "_Sat signed _Accum")))
|
|
("_Sat" "signed" "long" "_Accum"
|
|
($$ '(fixpt-type "_Sat signed long _Accum")))
|
|
("_Sat" "unsigned" "short" "_Accum"
|
|
($$ '(fixpt-type "_Sat unsigned short _Accum")))
|
|
("_Sat" "unsigned" "_Accum" ($$ '(fixpt-type "_Sat unsigned _Accum")))
|
|
("_Sat" "unsigned" "long" "_Accum"
|
|
($$ '(fixpt-type "_Sat unsigned long _Accum"))))
|
|
|
|
;; This one modified: split out struct-or-union = "struct"|"union"
|
|
(struct-or-union-specifier
|
|
("struct" opt-attr-specs ident-like "{" struct-declaration-list "}"
|
|
($$ (sx-join* 'struct-def $2 $3 (tl->list $5))))
|
|
("struct" opt-attr-specs "{" struct-declaration-list "}"
|
|
($$ (sx-join* 'struct-def $2 (tl->list $4))))
|
|
("struct" opt-attr-specs ident-like ($$ (sx-join* 'struct-ref $1 $3)))
|
|
("union" opt-attr-specs ident-like "{" struct-declaration-list "}"
|
|
($$ (sx-join* 'union-def $2 $3 (tl->list $5))))
|
|
("union" opt-attr-specs "{" struct-declaration-list "}"
|
|
($$ (sx-join* 'union-def $2 (tl->list $4))))
|
|
("union" opt-attr-specs ident-like ($$ (sx-join* 'union-ref $2 $3))))
|
|
|
|
;; because name following struct/union can be identifier or typeref:
|
|
(ident-like
|
|
(identifier)
|
|
(typedef-name ($$ `(ident ,(sx-ref $1 1)))))
|
|
|
|
(opt-attr-specs
|
|
($empty)
|
|
(attribute-specifiers ($$ `(@ ,(attrl->attrs $1)))))
|
|
|
|
;; Calling this field-list in the parse tree.
|
|
(struct-declaration-list ; S 6.7.2.1
|
|
(struct-declaration ($$ (make-tl 'field-list $1)))
|
|
(lone-comment ($$ (make-tl 'field-list $1)))
|
|
(struct-declaration-list struct-declaration ($$ (tl-append $1 $2)))
|
|
(struct-declaration-list lone-comment ($$ (tl-append $1 $2)))
|
|
;; Not in C99, but allowed by GNU, I believe:
|
|
(";" ($$ (make-tl 'field-list)))
|
|
(struct-declaration-list ";" ($$ $1)))
|
|
|
|
(struct-declaration ; S 6.7.2.1
|
|
(struct-declaration-no-comment ";")
|
|
(struct-declaration-no-comment ";" code-comment ($$ (sx-attr-add $1 $3))))
|
|
(struct-declaration-no-comment
|
|
(specifier-qualifier-list
|
|
struct-declarator-list ($$ `(comp-decl ,$1 ,(tl->list $2))))
|
|
(specifier-qualifier-list ($$ `(comp-decl ,$1)))) ;; <= anonymous
|
|
|
|
(specifier-qualifier-list ; S 6.7.2.1
|
|
(specifier-qualifier-list-1 ($$ (process-specs (tl->list $1)))))
|
|
(specifier-qualifier-list-1
|
|
(type-specifier ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-specifier specifier-qualifier-list-1 ($$ (tl-insert $2 $1)))
|
|
(type-qualifier ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-qualifier specifier-qualifier-list-1 ($$ (tl-insert $2 $1)))
|
|
(attribute-specifier ($$ (make-tl 'decl-spec-list $1)))
|
|
(attribute-specifier specifier-qualifier-list-1 ($$ (tl-insert $2 $1))))
|
|
|
|
(specifier-qualifier-list/no-attr
|
|
(specifier-qualifier-list/no-attr-1 ($$ (tl->list $1))))
|
|
(specifier-qualifier-list/no-attr-1
|
|
(type-specifier ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-specifier specifier-qualifier-list/no-attr-1 ($$ (tl-insert $2 $1)))
|
|
(type-qualifier ($$ (make-tl 'decl-spec-list $1)))
|
|
(type-qualifier specifier-qualifier-list/no-attr-1 ($$ (tl-insert $2 $1))))
|
|
|
|
(struct-declarator-list ; S 6.7.2.1
|
|
(struct-declarator ($$ (make-tl 'comp-declr-list $1)))
|
|
(struct-declarator-list "," struct-declarator ($$ (tl-append $1 $3)))
|
|
(struct-declarator-list "," attribute-specifiers
|
|
struct-declarator ($$ (tl-append $1 $3 $4))))
|
|
|
|
(struct-declarator ; S 6.7.2.1
|
|
(struct-declarator-1 ($$ (process-declr $1))))
|
|
(struct-declarator-1
|
|
(declarator ($$ `(comp-declr ,$1)))
|
|
(declarator attribute-specifiers ($$ `(comp-declr ,$1 ,$2)))
|
|
(declarator ":" constant-expression
|
|
($$ `(comp-declr (bit-field ,$1 ,$3))))
|
|
(":" constant-expression ($$ `(comp-declr (bit-field ,$2)))))
|
|
|
|
(enum-specifier ; S 6.7.2.2
|
|
("enum" ident-like "{" enumerator-list "}"
|
|
($$ `(enum-def ,$2 ,(tl->list $4))))
|
|
("enum" ident-like "{" enumerator-list "," "}"
|
|
($$ `(enum-def ,$2 ,(tl->list $4))))
|
|
("enum" "{" enumerator-list "}" ($$ `(enum-def ,(tl->list $3))))
|
|
("enum" "{" enumerator-list "," "}" ($$ `(enum-def ,(tl->list $3))))
|
|
("enum" ident-like ($$ `(enum-ref ,$2))))
|
|
|
|
;; keeping old enum-def-list in parse tree
|
|
(enumerator-list ; S 6.7.2.2
|
|
(enumerator ($$ (make-tl 'enum-def-list $1)))
|
|
(enumerator-list "," enumerator ($$ (tl-append $1 $3))))
|
|
|
|
;; had to change enumeration-constant => identifier
|
|
(enumerator ; S 6.7.2.2
|
|
(identifier ($$ `(enum-defn ,$1)))
|
|
(identifier attribute-specifiers ($$ `(enum-defn ,$1 ,$2)))
|
|
(identifier "=" constant-expression ($$ `(enum-defn ,$1 ,$3))))
|
|
|
|
(type-qualifier
|
|
("const" ($$ `(type-qual ,$1)))
|
|
("volatile" ($$ `(type-qual ,$1)))
|
|
("restrict" ($$ `(type-qual ,$1))))
|
|
|
|
(function-specifier
|
|
("inline" ($$ `(fctn-spec ,$1)))
|
|
("_Noreturn" ($$ `(fctn-spec ,$1))))
|
|
|
|
;; Support for __attribute__(( ... )). See the gcc documentation.
|
|
;; The documentation does not seem rigourous about defining where the
|
|
;; attribute specifier can appear. This is my best attempt. MW 2018
|
|
;; https://gcc.gnu.org/onlinedocs/gcc-8.2.0/gcc/Attribute-Syntax.html
|
|
;; https://gcc.gnu.org/onlinedocs/gcc-8.2.0/gcc/Type-Attributes.html
|
|
;; https://gcc.gnu.org/onlinedocs/gcc-8.2.0/gcc/Variable-Attributes.html
|
|
;; https://gcc.gnu.org/onlinedocs/gcc-8.2.0/gcc/Function-Attributes.html
|
|
|
|
(attribute-specifiers
|
|
(attribute-specifier ($prec 'reduce-on-attr))
|
|
(attribute-specifiers attribute-specifier ($$ (append $1 (cdr $2)))))
|
|
|
|
;; (attributes (attribute "__static__") (attribute aligned(8)" ...)
|
|
(attribute-specifier
|
|
("__attribute__" "(" "(" attribute-list ")" ")" ($$ $4))
|
|
(attr-name ($$ `(attribute-list (attribute ,$1)))))
|
|
(attr-name
|
|
("__packed__" ($$ '(ident "__packed__")))
|
|
("__aligned__" ($$ '(ident "__aligned__")))
|
|
("__alignof__" ($$ '(ident "__alignof__"))))
|
|
|
|
(attribute-list (attribute-list-1 ($$ (tl->list $1))))
|
|
(attribute-list-1
|
|
(attribute ($$ (make-tl 'attribute-list $1)))
|
|
(attribute-list-1 "," attribute ($$ (tl-append $1 $3)))
|
|
(attribute-list-1 "," ($$ $1)))
|
|
|
|
(attribute
|
|
(attr-word ($$ `(attribute ,$1)))
|
|
(attr-word "(" attr-expr-list ")" ($$ `(attribute ,$1 ,$3)))
|
|
("const" ($$ `(attribute (ident "const")))))
|
|
|
|
(attr-word
|
|
(attr-name)
|
|
(identifier))
|
|
|
|
(attr-expr-list
|
|
(attr-expr-list-1 ($$ (tl->list $1))))
|
|
|
|
(attr-expr-list-1
|
|
(attribute-expr ($$ (make-tl 'attr-expr-list $1)))
|
|
(attr-expr-list-1 "," attribute-expr ($$ (tl-append $1 $3))))
|
|
|
|
(attribute-expr
|
|
(type-name)
|
|
($fixed ($$ `(fixed ,$1)))
|
|
(string-literal)
|
|
(identifier)
|
|
(attr-word "(" attr-expr-list ")" ($$ `(attribute ,$1 ,$3)))) ;; ???
|
|
|
|
;; --- declarators
|
|
|
|
(init-declarator-list ; S 6.7
|
|
(init-declarator-list-1 ($$ (tl->list $1))))
|
|
(init-declarator-list-1
|
|
(init-declarator ($$ (make-tl 'init-declr-list $1)))
|
|
(init-declarator-list-1 "," init-declarator ($$ (tl-append $1 $3)))
|
|
(init-declarator-list-1 "," attribute-specifiers
|
|
init-declarator ($$ (tl-append $1 $3 $4))))
|
|
|
|
(init-declarator ; S 6.7
|
|
(init-declarator-1 ($$ (process-declr $1))))
|
|
(init-declarator-1
|
|
(declarator ($$ `(init-declr ,$1)))
|
|
(declarator "=" initializer ($$ `(init-declr ,$1 ,$3)))
|
|
(declarator asm-expression ($$ `(init-declr ,$1 ,$2)))
|
|
(declarator asm-expression "=" initializer ($$ `(init-declr ,$1 ,$2 ,$4)))
|
|
(declarator attribute-specifiers ($$ `(init-declr ,$1 ,$2)))
|
|
(declarator attribute-specifiers "=" initializer
|
|
($$ `(init-declr ,$1 ,$2 ,$4)))
|
|
(declarator asm-expression attribute-specifiers
|
|
($$ `(init-declr ,$1 ,$2 ,$3))))
|
|
|
|
(declarator
|
|
(pointer direct-declarator ($$ `(ptr-declr ,$1 ,$2)))
|
|
(direct-declarator))
|
|
|
|
(pointer ; S 6.7.6
|
|
("*" type-qualifier-list pointer ($$ `(pointer ,$2 ,$3)))
|
|
("*" type-qualifier-list ($$ `(pointer ,$2)))
|
|
("*" pointer ($$ `(pointer ,$2)))
|
|
("*" attribute-specifiers pointer ($$ `(pointer ,$3)))
|
|
("*" ($$ '(pointer))))
|
|
|
|
(direct-declarator ; S 6.7.6
|
|
(identifier ($$ $1))
|
|
;;(ident-like ($$ $1))
|
|
("(" declarator ")" ($$ `(scope ,$2)))
|
|
("(" attribute-specifier declarator ")" ($$ `(scope ,$2)))
|
|
(direct-declarator
|
|
"[" type-qualifier-list assignment-expression "]"
|
|
($$ `(array-of ,$1 ,$3 ,$4)))
|
|
(direct-declarator
|
|
"[" type-qualifier-list "]" ($$ `(array-of ,$1 ,$3)))
|
|
(direct-declarator
|
|
"[" assignment-expression "]" ($$ `(array-of ,$1 ,$3)))
|
|
(direct-declarator
|
|
"[" "]" ($$ `(array-of ,$1)))
|
|
(direct-declarator
|
|
"[" "static" type-qualifier-list assignment-expression "]"
|
|
($$ `(array-of ,$1 ,$4 ,$5))) ;; FIXME $4 needs "static" added
|
|
(direct-declarator
|
|
"[" type-qualifier-list "static" assignment-expression "]"
|
|
($$ `(array-of ,$1 ,4 ,$5))) ;; FIXME $4 needs "static" added
|
|
(direct-declarator
|
|
"[" type-qualifier-list "*" "]" ; variable length array
|
|
($$ `(array-of ,$1 ,$3 (var-len))))
|
|
(direct-declarator
|
|
"[" "*" "]" ; variable length array
|
|
($$ `(array-of ,$1 (var-len))))
|
|
(direct-declarator
|
|
"(" parameter-type-list ")" ($$ `(ftn-declr ,$1 ,$3)))
|
|
(direct-declarator
|
|
"(" identifier-list ")" ($$ `(ftn-declr ,$1 ,$3)))
|
|
(direct-declarator
|
|
"(" ")" ($$ `(ftn-declr ,$1 (param-list)))))
|
|
|
|
(type-qualifier-list
|
|
(type-qualifier-list-1 ($$ (tl->list $1))))
|
|
(type-qualifier-list-1
|
|
(type-qualifier ($$ (make-tl 'type-qual-list $1)))
|
|
(type-qualifier-list-1 type-qualifier ($$ (tl-append $1 $2))))
|
|
|
|
(parameter-type-list
|
|
(parameter-list ($$ (tl->list $1)))
|
|
(parameter-list "," "..." ($$ (tl->list (tl-append $1 '(ellipsis))))))
|
|
|
|
(parameter-list
|
|
(parameter-declaration ($$ (make-tl 'param-list $1)))
|
|
(parameter-list "," parameter-declaration ($$ (tl-append $1 $3))))
|
|
|
|
(parameter-declaration
|
|
(declaration-specifiers
|
|
declarator ($$ `(param-decl ,$1 (param-declr ,$2))))
|
|
(declaration-specifiers
|
|
abstract-declarator ($$ `(param-decl ,$1 (param-declr ,$2))))
|
|
(declaration-specifiers
|
|
($$ `(param-decl ,$1))))
|
|
|
|
(identifier-list
|
|
(identifier-list-1 ($$ (tl->list $1))))
|
|
(identifier-list-1
|
|
(identifier ($$ (make-tl 'ident-list $1)))
|
|
(identifier-list-1 "," identifier ($$ (tl-append $1 $3))))
|
|
|
|
(type-name ; S 6.7.6
|
|
;; e.g., (foo_t *)
|
|
(specifier-qualifier-list/no-attr abstract-declarator
|
|
($$ `(type-name ,$1 ,$2)))
|
|
;; e.g., (int)
|
|
(declaration-specifiers ($$ `(type-name ,$1))))
|
|
|
|
(abstract-declarator ; S 6.7.6
|
|
(pointer direct-abstract-declarator ($$ `(abs-declr ,$1 ,$2)))
|
|
(pointer ($$ `(abs-declr ,$1)))
|
|
(direct-abstract-declarator ($$ `(abs-declr ,$1))))
|
|
|
|
(direct-abstract-declarator
|
|
("(" abstract-declarator ")" ($$ `(declr-scope ,$2)))
|
|
(direct-abstract-declarator
|
|
"[" type-qualifier-list assignment-expression "]"
|
|
($$ `(declr-array ,$1 ,$3 ,$4)))
|
|
(direct-abstract-declarator
|
|
"[" type-qualifier-list "]"
|
|
($$ `(declr-array ,$1 ,$3)))
|
|
(direct-abstract-declarator
|
|
"[" assignment-expression "]"
|
|
($$ `(declr-array ,$1 ,$3)))
|
|
(direct-abstract-declarator
|
|
"[" "]" ($$ `(declr-array ,$1)))
|
|
(direct-abstract-declarator
|
|
"[" "static" type-qualifier-list assignment-expression "]"
|
|
($$ `(declr-array
|
|
,$1 ,(tl->list (tl-insert $4 '(stor-spec "static"))) ,$5)))
|
|
(direct-abstract-declarator
|
|
"[" "static" type-qualifier-list "]"
|
|
($$ `(declr-array ,$1 ,(tl->list (tl-insert $4 '(stor-spec "static"))))))
|
|
(direct-abstract-declarator
|
|
"[" type-qualifier-list "static" assignment-expression "]"
|
|
($$ `(declr-array
|
|
,$1 ,(tl->list (tl-insert $3 '(stor-spec "static"))) ,$5)))
|
|
;;
|
|
("[" type-qualifier-list assignment-expression "]"
|
|
($$ `(declr-anon-array ,$2 ,$3)))
|
|
("[" type-qualifier-list "]" ($$ `(declr-anon-array ,$2)))
|
|
("[" assignment-expression "]" ($$ `(declr-anon-array ,$2)))
|
|
("[" "]" ($$ `(declr-anon-array)))
|
|
("[" "static" type-qualifier-list assignment-expression "]"
|
|
($$ `(declr-anon-array
|
|
,(tl->list (tl-insert $3 '(stor-spec "static"))) ,$4)))
|
|
("[" "static" type-qualifier-list "]"
|
|
($$ `(declr-anon-array ,(tl->list (tl-insert $3 '(stor-spec "static"))))))
|
|
("[" type-qualifier-list "static" assignment-expression "]"
|
|
($$ `(declr-anon-array
|
|
,(tl->list (tl-insert $2 '(stor-spec "static"))) ,$4)))
|
|
(direct-abstract-declarator "[" "*" "]" ($$ `(declr-star ,$1)))
|
|
("[" "*" "]" ($$ '(declr-star)))
|
|
(direct-abstract-declarator "(" parameter-type-list ")"
|
|
($$ `(abs-ftn-declr ,$1 ,$3)))
|
|
(direct-abstract-declarator "(" ")" ($$ `(abs-ftn-declr ,$1)))
|
|
("(" parameter-type-list ")" ($$ `(anon-ftn-declr ,$2)))
|
|
("(" ")" ($$ '(anon-ftn-declr))))
|
|
|
|
;; typedef-name is generated by the lexical analyzer
|
|
(typedef-name ('typename ($$ `(typename ,$1))))
|
|
|
|
;; --------------------------------
|
|
|
|
(initializer ; S 6.7.9
|
|
(assignment-expression ($$ `(initzer ,$1)))
|
|
("{" initializer-list "}" ($$ `(initzer ,(tl->list $2))))
|
|
("{" initializer-list "," "}" ($$ `(initzer ,(tl->list $2)))))
|
|
|
|
;; The designation productions are from C99.
|
|
(initializer-list
|
|
(designation initializer ($$ (make-tl 'initzer-list $1 $2)))
|
|
(initializer ($$ (make-tl 'initzer-list $1)))
|
|
(initializer-list "," designation initializer ($$ (tl-append $1 $3 $4)))
|
|
(initializer-list "," initializer ($$ (tl-append $1 $3))))
|
|
|
|
(designation ; S 6.7.8
|
|
(designator-list "=" ($$ `(desig ,$1))))
|
|
|
|
(designator-list
|
|
(designator ($$ (make-tl 'desgr-list $1)))
|
|
(designator-list designator ($$ (tl-append $1 $2))))
|
|
|
|
(designator
|
|
("[" constant-expression "]" ($$ `(array-dsgr ,$2)))
|
|
("." identifier ($$ `(sel-dsgr ,$2))))
|
|
|
|
;; === statements =========================================================
|
|
|
|
(statement
|
|
(labeled-statement)
|
|
(compound-statement)
|
|
(expression-statement)
|
|
(selection-statement)
|
|
(iteration-statement)
|
|
(jump-statement)
|
|
(asm-statement)
|
|
(pragma)
|
|
(cpp-statement))
|
|
|
|
(labeled-statement
|
|
(identifier ":" statement ($$ `(labeled-stmt ,$1 ,$3)))
|
|
(identifier ":" attribute-specifier statement
|
|
($$ `(labeled-stmt ,$1 ,$4)))
|
|
("case" constant-expression ":" statement ($$ `(case ,$2 ,$4)))
|
|
("default" ":" statement ($$ `(default ,$3))))
|
|
|
|
(compound-statement
|
|
("{" ($$ (cpi-push)) block-item-list ($$ (cpi-pop)) "}"
|
|
($$ `(compd-stmt ,(tl->list $3))))
|
|
("{" "}"
|
|
($$ `(compd-stmt (block-item-list)))))
|
|
|
|
(block-item-list
|
|
(block-item ($$ (make-tl 'block-item-list $1)))
|
|
(block-item-list block-item ($$ (tl-append $1 $2))))
|
|
|
|
(block-item
|
|
(declaration)
|
|
(statement))
|
|
|
|
(expression-statement
|
|
(expression ";" ($$ `(expr-stmt ,$1)))
|
|
(";" ($$ '(expr-stmt))))
|
|
|
|
(selection-statement
|
|
("if" "(" expression ")" statement ($prec 'then)
|
|
($$ `(if ,$3 ,$5)))
|
|
("if" "(" expression ")" statement "else" statement
|
|
($$ `(if ,$3 ,$5 ,$7)))
|
|
("switch" "(" expression ")" statement ($$ `(switch ,$3 ,$5))))
|
|
|
|
(iteration-statement
|
|
("while" "(" expression ")" statement ($$ `(while ,$3 ,$5)))
|
|
("do" statement "while" "(" expression ")" ";" ($$ `(do-while ,$2 ,$5)))
|
|
("for" "(" initial-clause opt-expression ";" opt-expression ")" statement
|
|
($$ `(for ,$3 ,$4 ,$6 ,$8))))
|
|
(initial-clause ; <= added for convenience
|
|
(expression ";")
|
|
(";" ($$ '(expr)))
|
|
(declaration))
|
|
(opt-expression ; <= added for convenience
|
|
($empty ($$ '(expr)))
|
|
(expression))
|
|
|
|
(jump-statement ; S 6.8.6
|
|
("goto" identifier ";" ($$ `(goto ,$2)))
|
|
("continue" ";" ($$ '(continue)))
|
|
("break" ";" ($$ '(break)))
|
|
("return" expression ";" ($$ `(return ,$2)))
|
|
("return" ";" ($$ `(return (expr)))))
|
|
|
|
(asm-statement
|
|
(asm-expression ";"))
|
|
(asm-expression
|
|
("__asm__" opt-asm-specifiers "(" string-literal ")"
|
|
($$ `(asm-expr (@ (extension "GNUC")) ,$4)))
|
|
("__asm__" opt-asm-specifiers "(" string-literal asm-outputs ")"
|
|
($$ `(asm-expr (@ (extension "GNUC")) ,$4 ,(tl->list $5))))
|
|
("__asm__" opt-asm-specifiers "(" string-literal asm-outputs asm-inputs ")"
|
|
($$ `(asm-expr (@ (extension "GNUC")) ,$4 ,(tl->list $5) ,(tl->list $6))))
|
|
("__asm__" opt-asm-specifiers "(" string-literal asm-outputs
|
|
asm-inputs asm-clobbers ")"
|
|
($$ `(asm-expr (@ (extension "GNUC"))
|
|
,$4 ,(tl->list $5) ,(tl->list $6) ,(tl->list $7)))))
|
|
(opt-asm-specifiers
|
|
($empty)
|
|
("volatile"))
|
|
(asm-outputs
|
|
(":" ($$ (make-tl 'asm-outputs)))
|
|
(":" asm-output ($$ (make-tl 'asm-outputs $2)))
|
|
(asm-outputs "," asm-output ($$ (tl-append $1 $3))))
|
|
(asm-output
|
|
(string-literal "(" identifier ")" ($$ `(asm-operand ,$1 ,$3)))
|
|
("[" identifier "]" string-literal "(" identifier ")"
|
|
($$ `(asm-operand ,$2 ,$4 ,$6))))
|
|
(asm-inputs
|
|
(":" ($$ (make-tl 'asm-inputs)))
|
|
(":" asm-input ($$ (make-tl 'asm-inputs $2)))
|
|
(asm-inputs "," asm-input ($$ (tl-append $1 $3))))
|
|
(asm-input
|
|
(string-literal "(" expression ")" ($$ `(asm-operand ,$1 ,$3)))
|
|
("[" identifier "]" string-literal "(" expression ")"
|
|
($$ `(asm-operand ,$2 ,$4 ,$6))))
|
|
(asm-clobbers
|
|
(":" ($$ (make-tl 'asm-clobbers)))
|
|
(":" string-literal ($$ (tl-extend (make-tl 'asm-clobbers) $2)))
|
|
(asm-clobbers "," string-literal ($$ (tl-extend $1 (cdr $3)))))
|
|
|
|
;; === top-level forms ====================================================
|
|
|
|
(translation-unit ; S 6.9
|
|
(external-declaration-list ($$ (tl->list $1))))
|
|
|
|
(external-declaration-list
|
|
($empty ($$ (make-tl 'trans-unit)))
|
|
(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 1))
|
|
(tl-append $1 $2)))))
|
|
|
|
(external-declaration ; S 6.9
|
|
(function-definition)
|
|
(declaration)
|
|
(lone-comment)
|
|
(cpp-statement)
|
|
(pragma)
|
|
("extern" $string "{"
|
|
($$ (cpi-dec-blev!)) external-declaration-list ($$ (cpi-inc-blev!)) "}"
|
|
($$ `(extern-block
|
|
(extern-begin ,$2) ,@(sx-tail (tl->list $5) 1) (extern-end))))
|
|
(";" ($$ `(decl (@ (extension "GNUC"))))))
|
|
|
|
(function-definition
|
|
(declaration-specifiers
|
|
declarator compound-statement
|
|
($$ `(fctn-defn ,$1 ,$2 ,$3)))
|
|
;; K&R function definitions are not compatible with attribute-specifiers.
|
|
;;(declaration-specifiers
|
|
;; declarator declaration-list compound-statement
|
|
;; ($$ `(knr-fctn-defn ,$1 ,$2 ,$3 ,$4)))
|
|
)
|
|
|
|
;; K&R function-definition parameter list
|
|
;;(declaration-list (declaration-list-1 ($$ (tl->list $1))))
|
|
;;(declaration-list-1
|
|
;; (declaration ($$ (make-tl 'decl-list $1)))
|
|
;; (declaration-list-1 declaration ($$ (tl-append $1 $2))))
|
|
|
|
;; non-terminal leaves
|
|
(identifier ($ident ($$ `(ident ,$1))))
|
|
(constant
|
|
($fixed ($$ `(fixed ,$1))) ; integer literal
|
|
($float ($$ `(float ,$1))) ; floating literal
|
|
($chlit ($$ `(char ,$1))) ; char literal
|
|
($chlit/L ($$ `(char (@ (type "wchar_t")) ,$1)))
|
|
($chlit/u ($$ `(char (@ (type "char16_t")) ,$1)))
|
|
($chlit/U ($$ `(char (@ (type "char32_t")) ,$1))))
|
|
(string-literal (string-literal-1 ($$ (tl->list $1))))
|
|
(string-literal-1
|
|
($string ($$ (make-tl 'string $1))) ; string-constant
|
|
(string-literal-1 $string ($$ (tl-append $1 $2))))
|
|
(code-comment ($code-comm ($$ `(comment ,$1))))
|
|
(lone-comment ($lone-comm ($$ `(comment ,$1))))
|
|
(cpp-statement ('cpp-stmt ($$ `(cpp-stmt ,$1))))
|
|
(pragma
|
|
($pragma ($$ `(pragma ,$1)))
|
|
("_Pragma" "(" string-literal ")" ($$ `(pragma ,$3))))
|
|
|
|
)))
|
|
|
|
;;; === parsers =========================
|
|
|
|
;; We setup dev parser because circular dependence between lexer and parser
|
|
;; due to parsing include files as units for code and decl mode.
|
|
;; update: This is doable now (see parser.scm) but wait until it's needed.
|
|
|
|
(define c99-mach
|
|
(compact-machine
|
|
(hashify-machine
|
|
(make-lalr-machine c99-spec))
|
|
#:keep 2
|
|
#:keepers '($code-comm $lone-comm $pragma)))
|
|
|
|
(define c99x-spec (restart-spec c99-spec 'expression))
|
|
|
|
(define c99x-mach
|
|
(compact-machine
|
|
(hashify-machine
|
|
(make-lalr-machine c99x-spec))
|
|
#:keep 2
|
|
#:keepers '($code-comm $lone-comm $pragma)))
|
|
|
|
;;; =====================================
|
|
|
|
;; @deffn {Procedure} gen-c99-files [dir] => #t
|
|
;; Update or generate the files @quot{c99act.scm} and @quot{c99tab.scm}.
|
|
;; These are the tables and actions for the C99 parser.
|
|
;; If there are no changes to existing files, no update occurs.
|
|
;; @end deffn
|
|
(define* (gen-c99-files #:optional (path "."))
|
|
(define (mdir file) (mach-dir path file))
|
|
(write-lalr-actions c99-mach (mdir "c99-act.scm.new") #:prefix "c99-")
|
|
(write-lalr-tables c99-mach (mdir "c99-tab.scm.new") #:prefix "c99-")
|
|
(write-lalr-actions c99x-mach (mdir "c99x-act.scm.new") #:prefix "c99x-")
|
|
(write-lalr-tables c99x-mach (mdir "c99x-tab.scm.new") #:prefix "c99x-")
|
|
(let ((a (move-if-changed (mdir "c99-act.scm.new") (mdir "c99-act.scm")))
|
|
(b (move-if-changed (mdir "c99-tab.scm.new") (mdir "c99-tab.scm")))
|
|
(c (move-if-changed (mdir "c99x-act.scm.new") (mdir "c99x-act.scm")))
|
|
(d (move-if-changed (mdir "c99x-tab.scm.new") (mdir "c99x-tab.scm"))))
|
|
(or a b c d)))
|
|
|
|
;; --- last line ---
|