diff options
Diffstat (limited to 'module/c/parse2.scm')
| -rw-r--r-- | module/c/parse2.scm | 614 |
1 files changed, 338 insertions, 276 deletions
diff --git a/module/c/parse2.scm b/module/c/parse2.scm index fad2ffd8..34c1730f 100644 --- a/module/c/parse2.scm +++ b/module/c/parse2.scm @@ -1,12 +1,16 @@ (define-module (c parse2) :use-module (hnh util) - :use-module (system base lalr)) + :use-module (system base lalr) + :export (make-parser + build-lexical-analyzer + error-procedure)) + (define (make-parser) (lalr-parser (#{out-table:}# "/tmp/c-parser.txt") (#{output:}# c-parser "/tmp/c-parser.scm") - ;; (#{driver:}# glr) + (#{driver:}# glr) ( @@ -47,23 +51,27 @@ ;; punctuator - already translated ) - ;; Primitives + (top-level + (translation-unit) : $1 + (statement) : $1 + (constant-expression) : $1) - ;; (identifier) : $1 - ;; (constant) : $1 - ;; (string-literal) : $1 + ;; compounds + ;; 6.9 + (translation-unit + (external-declaration) : (list 'translation-unit $1) + (translation-unit external-declaration) : (append $1 (list $2))) - ;; compounds (primary-expression - ;; 6.5.1 - (identifier) - (constant) - (string-literal) - (lparen expression rparen) - (generic-selection)) + (identifier) : $1 + (constant) : `(constant ,$1) + (string-literal) : `(string-constant ,$1) + ;; output parenthesis skipped, since all forms come with their own + (lparen expression rparen) : $2 + (generic-selection) : $1) (enumeration-constant (identifier)) @@ -71,470 +79,524 @@ ;; 6.5.1.1 (generic-selection - (_Generic lparen assignment-expression comma generic-assoc-list)) + (_Generic lparen assignment-expression comma generic-assoc-list rparen) : `(generic ,$3 ,@$5)) (generic-assoc-list - (generic-association) - (generic-assoc-list comma generic-association)) + (generic-assoc-list comma generic-association) : (append $1 (list $3)) + (generic-association) : (list $1)) (generic-association - (type-name : assignment-expression) - (default : assignment-expression)) + (type-name : assignment-expression) : (cons $1 $3) + (default : assignment-expression) : (cons $1 $3)) ;; 6.5.2 (postfix-expression - (primary-expression) - (postfix-expression lbrack expression rbrack) - (postfix-expression lparen rparen) - (postfix-expression lparen argument-expression-list rparen) - (postfix-expression dot identifier) - (postfix-expression -> identifier) - (postfix-expression ++) - (postfix-expression --) + (postfix-expression lbrack expression rbrack) : `(idx ,$1 ,$3) + (postfix-expression lparen rparen) : `(,$1) + (postfix-expression lparen argument-expression-list rparen) : `(,$1 ,@$3) + (postfix-expression dot identifier) : `(dot-access ,$1 ,$3) + (postfix-expression -> identifier) : `(ptr-access ,$1 ,$3) + (postfix-expression ++) : `(postfix++ ,$1) + (postfix-expression --) : `(postfix-- ,$1) (lparen type-name rparen lbrace initializer-list rbrace) - (lparen type-name rparen lbrace initializer-list comma rbrace)) + (lparen type-name rparen lbrace initializer-list comma rbrace) + (primary-expression) : $1 + ) (argument-expression-list - (assignment-expression) - (argument-expression-list comma assignment-expression)) + (argument-expression-list comma assignment-expression) : (append $1 (list $3)) + (assignment-expression) : (list $1)) ;; 6.5.3 (unary-expression - (postfix-expression) - (++ unary-expression) - (-- unary-expression) - (unary-operator cast-expression) - (sizeof unary-expression) - (sizeof lparen type-name rparen) - (_Alignof lparen type-name rparen)) + (++ unary-expression) : `(prefix++ ,$2) + (-- unary-expression) : `(prefix-- ,$2) + (unary-operator cast-expression) : `(,$1 ,$2) + (sizeof unary-expression) : `(sizeof (typeof ,$2)) + (sizeof lparen type-name rparen) : `(sizeof ,$3) + (_Alignof lparen type-name rparen) : `(alignof ,$3) + (postfix-expression) : $1) (unary-operator - (&) - (*) - (+) - (-) - (~) - (!)) + (&) : 'pointer-to + (*) : 'dereference + (+) : 'unary+ ; separate from + and - for + (-) : 'unary- ; easier eval procedure later + (~) : 'bitwise-not + (!) : 'not) ;; 6.5.4 (cast-expression - (unary-expression) - (lparen type-name rparen cast-expression)) + (lparen type-name rparen cast-expression) : `(as-type ,$2 ,$4) + (unary-expression) : $1) ;; 6.5.5 (multiplicative-expression - (cast-expression) - (multiplicative-expression * cast-expression) - (multiplicative-expression / cast-expression) - (multiplicative-expression % cast-expression)) + (multiplicative-expression * cast-expression) : `(* ,$1 ,$3) + (multiplicative-expression / cast-expression) : `(/ ,$1 ,$3) + (multiplicative-expression % cast-expression) : `(% ,$1 ,$3) + (cast-expression) : $1) ;; 6.5.6 (additive-expression - (multiplicative-expression) - (additive-expression + multiplicative-expression) - (additive-expression - multiplicative-expression)) + (additive-expression + multiplicative-expression) : `(+ ,$1 ,$3) + (additive-expression - multiplicative-expression) : `(- ,$1 ,$3) + (multiplicative-expression) : $1) ;; 6.5.7 (shift-expression - (additive-expression) - (shift-expression << additive-expression) - (shift-expression >> additive-expression)) + (shift-expression << additive-expression) : `(<< ,$1 ,$3) + (shift-expression >> additive-expression) : `(>> ,$1 ,$3) + (additive-expression) : $1) ;; 6.5.8 (relational-expression - (shift-expression) - (relational-expression < shift-expression) - (relational-expression > shift-expression) - (relational-expression <= shift-expression) - (relational-expression >= shift-expression)) + (relational-expression < shift-expression) : `(< ,$1 ,$3) +(relational-expression > shift-expression) : `(> ,$1 ,$3) + (relational-expression <= shift-expression) : `(<= ,$1 ,$3) + (relational-expression >= shift-expression) : `(>= ,$1 ,$3) + (shift-expression) : $1) ;; 6.5.9 (equality-expression - (relational-expression) - (equality-expression == relational-expression) - (equality-expression != relational-expression)) + (equality-expression == relational-expression) : `(== ,$1 ,$3) + (equality-expression != relational-expression) : `(!= ,$1 ,$3) + (relational-expression) : $1) ;; 6.5.10 (AND-expression - (equality-expression) - (AND-expression & equality-expression)) + (AND-expression & equality-expression) : `(bitwise-and ,$1 ,$3) + (equality-expression) : $1) ;; 6.5.11 (exclusive-OR-expression - (AND-expression) - (exclusive-OR-expression ^ AND-expression)) + (exclusive-OR-expression ^ AND-expression) : `(bitwise-xor ,$1 ,$3) + (AND-expression) : $1) ;; 6.5.12 (inclusive-OR-expression - (exclusive-OR-expression) - (inclusive-OR-expression pipe exclusive-OR-expression)) + (inclusive-OR-expression pipe exclusive-OR-expression) : `(bitwise-ior ,$1 ,$3) + (exclusive-OR-expression) : $1) ;; 6.5.13 (logical-AND-expression - (inclusive-OR-expression) - (logical-AND-expression && inclusive-OR-expression)) + (logical-AND-expression && inclusive-OR-expression) : `(and ,$1 ,$3) + (inclusive-OR-expression) : $1) ;; 6.5.14 (logical-OR-expression - (logical-AND-expression) - (logical-OR-expression pipe2 logical-AND-expression)) + (logical-OR-expression pipe2 logical-AND-expression) : `(or ,$1 ,$3) + (logical-AND-expression) : $1) ;; 6.5.15 (conditional-expression - (logical-OR-expression) - (logical-OR-expression ? expression : conditional-expression)) + (logical-OR-expression ? expression : conditional-expression) : `(ternary ,$1 ,$3 ,$5) + (logical-OR-expression) : $1) ;; 6.5.16 (assignment-expression - (conditional-expression) - (unary-expression assignment-operator assignment-expression)) + (unary-expression assignment-operator assignment-expression) : `(,$2 ,$1 ,$3) + (conditional-expression) : $1) (assignment-operator - (=) - (*=) - (/=) - (%=) - (+=) - (-=) - (<<=) - (>>=) - (&=) - (^=) - (pipe=)) + (=) : $1 + (*=) : $1 + (/=) : $1 + (%=) : $1 + (+=) : $1 + (-=) : $1 + (<<=) : $1 + (>>=) : $1 + (&=) : $1 + (^=) : $1 + (pipe=) : $1) ;; 6.5.17 (expression - (assignment-expression) - (expression comma assignment-expression)) + (assignment-expression) : `(begin ,$1) + ;; (This is the comma operator) + (expression comma assignment-expression) : (append $1 (list $3))) ;; 6.6 constant expression (constant-expression - (expression)) + (expression) : `(constexpr ,$1)) ;; 6.7 (declaration - (declaration-specifiers semicolon) - (declaration-specifiers init-declarator-list semicolon) + (declaration-specifiers init-declarator-list semicolon) : ($2 $1) + ;; TODO when is declare-specifiers without init-declarator-list case relevant? + ;; It when enabled, it thinks just about everything is this: + ;; (compile-string* "int x;") + ;; ⇒ (translation-unit (define (named x ((type int))) <undefined-value>)) + ;; ⇒ (translation-unit (declare1 ((type int) (type (typedef x))))) + ;; NOTE this case is for structs + ;; "struct s;" + (declaration-specifiers semicolon) : `(struct-like-declaration ,$1) + (static_assert-declaration)) (declaration-specifiers - (storage-class-specifier) - (storage-class-specifier declaration-specifiers) + (storage-class-specifier declaration-specifiers) : (cons $1 $2) + (storage-class-specifier) : (list $1) + + (type-specifier declaration-specifiers) : (cons $1 $2) + (type-specifier) : (list $1) + + (type-qualifier declaration-specifiers) : (cons $1 $2) + (type-qualifier) : (list $1) - (type-specifier) - (type-specifier declaration-specifiers) + (function-specifier declaration-specifiers) : (cons $1 $2) + (function-specifier) : (list $1) - (type-qualifier) - (type-qualifier declaration-specifiers) + (alignment-specifier declaration-specifiers) : (cons $1 $2) + (alignment-specifier) : (list $1)) - (function-specifier) - (function-specifier declaration-specifiers) - (alignment-specifier) - (alignment-specifier declaration-specifiers)) (init-declarator-list - (init-declarator) - (init-declarator-list comma init-declarator)) + (init-declarator-list comma init-declarator) : (lambda (type) (append ($1 type) (list ($3 type)))) + (init-declarator) : (lambda (type) `(begin ,($1 type)))) (init-declarator - (declarator) - (declarator = initializer)) + (declarator = initializer) : (lambda (type) `(define ,($1 type) ,$3)) + (declarator) : (lambda (type) `(define ,($1 type) <undefined-value>))) ;; 6.7.1 (storage-class-specifier - (typedef) - (extern) - (static) - (_Thread_local) - (auto) - (register)) + (typedef) : '(storage typedef) + (extern) : '(storage extern) + (static) : '(storage static) + (_Thread_local) : '(storage thread-local) + (auto) : '(storage auto) + (register) : '(storage register)) - ;; 6.7.2 - (type-specifier - (void) - (char) - (short) - (int) - (long) - (float) - (double) - (signed) - (unsigned) - (_Bool) - (_Complex) - (atomic-type-specifier) - (struct-or-union-specifier) - (enum-specifier) - (typedef-name)) ;; 6.7.2.1 (struct-or-union-specifier - (struct-or-union lbrace struct-declaration-list rbrace) - (struct-or-union identifier lbrace struct-declaration-list rbrace) - (struct-or-union identifier)) + (struct-or-union lbrace struct-declaration-list rbrace) : `(,$1 ,$3) + (struct-or-union identifier lbrace struct-declaration-list rbrace) : `(,$1 (named ,$2) ,$4) + (struct-or-union identifier) : `(,$1 (named ,$2))) (struct-or-union - (struct) - (union)) + (struct) : 'struct + (union) : 'union) (struct-declaration-list - (struct-declaration) - (struct-declaration-list struct-declaration)) + (struct-declaration-list struct-declaration) : (append $1 (list $2)) + (struct-declaration) : (list 'struct-declaration-list $1) + ) (struct-declaration - (specifier-qualifier-list semicolon) - (specifier-qualifier-list struct-declarator-list semicolon) + (specifier-qualifier-list semicolon) : $1 + (specifier-qualifier-list struct-declarator-list semicolon) : ($2 $1) (static_assert-declaration)) (specifier-qualifier-list - (type-specifier) - (type-specifier specifier-qualifier-list) + (type-specifier specifier-qualifier-list) : `(specifier-qualifier-list ,$1 ,@(cdr $2)) + (type-specifier) : `(specifier-qualifier-list ,$1) - (type-qualifier) - (type-qualifier specifier-qualifier-list)) + (type-qualifier specifier-qualifier-list) : `(specifier-qualifier-list ,$1 ,@(cdr $2)) + (type-qualifier) : `(specifier-qualifier-list ,$1)) (struct-declarator-list - (struct-declarator) - (struct-declarator-list comma struct-declarator)) + (struct-declarator-list comma struct-declarator) : (lambda (type) (append ($1 type) (list ($3 type)))) + (struct-declarator) : (lambda (type) (list 'struct-declarator-list ($1 type))) + ) (struct-declarator - (declarator) - (: constant-expression) - (declarator : constant-expression)) + (: constant-expression) : (lambda (type) `(of-width *nothing* ,$2)) + (declarator : constant-expression) : (lambda (type) `(of-width ,($1 type) ,$3)) + (declarator) : $1) ;; 6.7.2.2 (enum-specifier - (enum identifier lbrace enumerator-list rbrace) - (enum lbrace enumerator-list rbrace) + (enum identifier lbrace enumerator-list rbrace) : `(enum (named ,$2) ,$4) + (enum lbrace enumerator-list rbrace) : `(enum ,$3) - (enum identifier lbrace enumerator-list comma rbrace) - (enum lbrace enumerator-list comma rbrace) + (enum identifier lbrace enumerator-list comma rbrace) : `(enum (named ,$2) ,$4) + (enum lbrace enumerator-list comma rbrace) : `(enum ,$3) - (enum identifier)) + (enum identifier) : `(enum (named ,$2))) (enumerator-list - (enumerator) - (enumerator-list comma enumerator)) + (enumerator-list comma enumerator) : (append $1 (list $3)) + (enumerator) : (list $1) + ) (enumerator - (enumeration-constant) - (enumeration-constant = constant-expression)) + (enumeration-constant = constant-expression) : (list $1 $3) + (enumeration-constant) : $1 + ) ;; 6.7.2.4 (atomic-type-specifier - (_Atomic lparen type-name rparen)) + (_Atomic lparen type-name rparen) : `(atomic ,$3)) ;; 6.7.3 (type-qualifier - (const) - (restrict) - (volatile) - (_Atomic)) + (const) : `(qualifier const) + (restrict) : `(qualifier restrict) + (volatile) : `(qualifier volatile) + (_Atomic) : `(qualifier atomic) + ) ;; 6.7.4 (function-specifier - (inline) - (_Noreturn)) + (inline) : 'inline + (_Noreturn) : 'noterun) ;; 6.7.5 (alignment-specifier - (_Alignas lparen type-name rparen) - (_Alignas lparen constant-expression rparen)) + (_Alignas lparen type-name rparen) : `(aligned-as ,$3) + (_Alignas lparen constant-expression rparen) : `(aligned-as ,$3)) ;; 6.7.6 (declarator - (pointer direct-declarator) - (direct-declarator)) + (pointer direct-declarator) : (lambda (type) ($2 ($1 type))) + (direct-declarator) : (lambda (type) ($1 type))) (direct-declarator - (identifier) - ( lparen declarator rparen ) - - (direct-declarator lbrack type-qualifier-list assignment-expression rbrack ) - (direct-declarator lbrack assignment-expression rbrack ) - (direct-declarator lbrack type-qualifier-list rbrack ) - (direct-declarator lbrack rbrack ) - (direct-declarator lbrack static type-qualifier-list assignment-expression rbrack) - (direct-declarator lbrack static assignment-expression rbrack) - - (direct-declarator lbrack type-qualifier-list static assignment-expression rbrack) - - (direct-declarator lbrack type-qualifier-list * rbrack) - (direct-declarator lbrack * rbrack) - - (direct-declarator lparen parameter-type-list rparen ) - (direct-declarator lparen identifier-list rparen ) - (direct-declarator lparen rparen )) + (direct-declarator lbrack type-qualifier-list assignment-expression rbrack ) : (lambda (type) ($1 `(array (of-length (,$3 ,$4)) + (containing ,type)))) + (direct-declarator lbrack assignment-expression rbrack ) : (lambda (type) ($1 `(array (of-length ,$3) + (containing ,type)))) + (direct-declarator lbrack type-qualifier-list rbrack ) : (lambda (type) ($1 `(array (of-length (,$3)) + (containing ,type)))) + (direct-declarator lbrack rbrack ) : (lambda (type) ($1 `(array (of-indeterminate-length) + (containing ,type)))) + + (direct-declarator lbrack static type-qualifier-list assignment-expression rbrack) : (lambda (type) `(array (static) + (containing ,type) + (of-length (,$3 ,$4)))) + (direct-declarator lbrack static assignment-expression rbrack) : (lambda (type) `(array (static) + (containing ,type) + (of-length ,$4))) + + ;; TODO static position + (direct-declarator lbrack type-qualifier-list static assignment-expression rbrack) : (lambda (type) `(array (static) + (containing ,type) + (of-length (,$3 ,$4)))) + + (direct-declarator lbrack type-qualifier-list * rbrack) : (lambda (type) ($1 '(array (containing ,type) (of-variable-length ,$3)))) + (direct-declarator lbrack * rbrack) : (lambda (type) ($1 '(array (containing ,type) (of-variable-length)))) + + (direct-declarator lparen parameter-type-list rparen ) : (lambda (returning) ($1 `(procedure (returning ,returning) (taking ,@(cdr $3))))) + (direct-declarator lparen identifier-list rparen ) : (lambda (returning) ($1 `(procedure (returning ,returning) (taking ,@(cdr $3))))) + (direct-declarator lparen rparen ) : (lambda (returning) ($1 `(procedure (returning ,returning) (taking *any*)))) + + ( lparen declarator rparen ) : (lambda (type) (list ($2 type))) + (identifier) : (lambda (type) `(named ,$1 ,type)) + ) (pointer - (* type-qualifier-list) - (*) - (* type-qualifier-list pointer) - (* pointer)) + (* type-qualifier-list) : (lambda (to) `(,$2 (pointer-to ,to))) + (* type-qualifier-list pointer) : (lambda (to) `(,$2 (pointer-to ,($3 to)))) + (* pointer) : (lambda (to) `(pointer-to ,($2 to))) + (*) : (lambda (to) `(pointer-to ,to))) (type-qualifier-list - (type-qualifier) - (type-qualifier-list type-qualifier)) + (type-qualifier-list type-qualifier) : (append $1 (list $2)) + (type-qualifier) : (list 'type-qualifier-list $1) + ) (parameter-type-list - (parameter-list) - (parameter-list comma ...)) + (parameter-list comma ...) : `(parameter-list ,$1 ...) + (parameter-list) : `(parameter-list ,$1) + ) (parameter-list - (parameter-declaration) - (parameter-list comma parameter-declaration)) + (parameter-list comma parameter-declaration) : (append $1 (list $3)) + (parameter-declaration) : (list $1) + ) (parameter-declaration - (declaration-specifiers declarator) - (declaration-specifiers abstract-declarator) - (declaration-specifiers)) + (declaration-specifiers declarator) : ($2 $1) + (declaration-specifiers abstract-declarator) : ($2 $1) + (declaration-specifiers) : $1) (identifier-list - (identifier) - (identifier-list comma identifier)) + (identifier-list comma identifier) : (append $1 (list $3)) + (identifier) : (list 'identifier-list $1)) ;; 6.7.7 (type-name - (specifier-qualifier-list) - (specifier-qualifier-list abstract-declarator)) + (specifier-qualifier-list abstract-declarator) : ($2 $1) + (specifier-qualifier-list) : $1 + ) (abstract-declarator - (pointer) - (pointer direct-abstract-declarator) - ( direct-abstract-declarator)) + (pointer direct-abstract-declarator) : (compose $1 $2) + (pointer) : $1 + ( direct-abstract-declarator) : $1 + ) (direct-abstract-declarator - ( lparen abstract-declarator rparen ) - (direct-abstract-declarator lbrack type-qualifier-list assignment-expression rbrack ) - (direct-abstract-declarator lbrack type-qualifier-list rbrack ) - (direct-abstract-declarator lbrack assignment-expression rbrack ) - ( lbrack rbrack ) - ( lbrack type-qualifier-list assignment-expression rbrack ) - ( lbrack type-qualifier-list rbrack ) - (direct-abstract-declarator lbrack * rbrack) - ( lbrack * rbrack) - (direct-abstract-declarator lparen parameter-type-list rparen ) - (direct-abstract-declarator lparen rparen ) - ( lparen parameter-type-list rparen ) - ( lparen rparen )) + ( lparen abstract-declarator rparen ) : (lambda (type) (list ($2 type))) + (direct-abstract-declarator lbrack type-qualifier-list assignment-expression rbrack ) : (lambda (type) ($1 `(array (of-length (,$3 ,$4)) + (containing ,type)))) + (direct-abstract-declarator lbrack type-qualifier-list rbrack ) : (lambda (type) ($1 `(array (of-length (,$3)) + (containing ,type)))) + (direct-abstract-declarator lbrack assignment-expression rbrack ) : (lambda (type) ($1 `(array (of-length ,$3) + (containing ,type)))) + ( lbrack rbrack ) : (lambda (type) `(array (of-indeterminate-length) + (containing ,type))) + ( lbrack type-qualifier-list assignment-expression rbrack ) : (lambda (type) `(array (containing ,type) + (of-length (,$3 ,$4)))) + ( lbrack type-qualifier-list rbrack ) : (lambda (type) `(array (containing ,type) + (of-length (,$3)))) + + (direct-abstract-declarator lbrack static type-qualifier-list assignment-expression rbrack ) : (lambda (type) ($1 `(array (static) + (of-length (,$4 ,$5)) + (containing ,type)))) + (direct-abstract-declarator lbrack static assignment-expression rbrack ) : (lambda (type) ($1 `(array (static) (of-length ,$4) (containing ,type)))) + ( lbrack static type-qualifier-list assignment-expression rbrack ) : (lambda (type) `(array (static) (of-length ,($4 $5)) (containing ,type))) + ( lbrack static assignment-expression rbrack ) : (lambda (type) `(array (static) (of-length ,$3) (containing ,type))) + + ;; TODO static position + (direct-abstract-declarator lbrack type-qualifier-list static assignment-expression rbrack ) : (lambda (type) `(array (static) (of-length (,$3 ,$4)) (containing ,type))) + ( lbrack type-qualifier-list static assignment-expression rbrack ) : (lambda (type) `(array (static) (of-length (,$2 ,$3)) (containing ,type))) + + (direct-abstract-declarator lbrack * rbrack) : (lambda (type) ($1 `(array (of-variable-length) (containing ,type)))) + ( lbrack * rbrack) : (lambda (type) `(array (of-variable-length) (containing ,type))) + (direct-abstract-declarator lparen parameter-type-list rparen ) : (lambda (returning) ($1 `(procedure (returning ,returning) (taking ,$3)))) + (direct-abstract-declarator lparen rparen ) : (lambda (returning) ($1 `(procedure (returning ,returning) (taking *any*)))) + ( lparen parameter-type-list rparen ) : (lambda (returning) `(procedure (returning ,returning) (taking ,$2))) + ( lparen rparen ) : (lambda (returning) `(procedure (returning ,returning) (taking *any*)))) ;; 6.7.8 (typedef-name - (identifier)) + (identifier) : `(typedef ,$1)) ;; 6.7.9 (initializer - (assignment-expression) - (lbrace initializer-list rbrace) - (lbrace initializer-list comma rbrace)) + (lbrace initializer-list rbrace) : $2 + (lbrace initializer-list comma rbrace) : $2 + (assignment-expression) : $1) (initializer-list - (designation initializer) - (initializer) - (initializer-list comma designation initializer) - (initializer-list comma initializer)) + (initializer-list comma designation initializer) : (append $1 (list `(designate ,$3 ,$4))) + (initializer-list comma initializer) : (append $1 (list $3)) + (designation initializer) : `(initializer-list (designate ,$1 ,$2)) + (initializer) : `(initializer-list ,$1)) (designation - (designator-list =)) + (designator-list =) : $1) (designator-list - (designator) - (designator-list designator)) + (designator-list designator) : (append $1 (list $2)) + (designator) : (list 'designators $1)) (designator - (lbrack constant-expression rbrack) - (dot identifier)) + (lbrack constant-expression rbrack) : `(idx ,$2) + (dot identifier) : `(slot ,$2)) ;; 6.7.10 (static_assert-declaration - (_Static_assert lparen constant-expression comma string-literal rparen semicolon)) + (_Static_assert lparen constant-expression comma string-literal rparen semicolon) + : `(static-assert ,$3 ,$5)) ;; 6.8 (statement - (labeled-statement) - (compound-statement) - (expression-statement) - (selection-statement) - (iteration-statement) - (jump-statement)) + (labeled-statement) : $1 + (compound-statement) : $1 + (expression-statement) : $1 + (selection-statement) : $1 + (iteration-statement) : $1 + (jump-statement) : $1) ;; 6.8.1 (labeled-statement - (identifier : statement) - (case constant-expression : statement) - (default : statement)) + (identifier : statement) : `(labeled ,$1 ,$3) + (case constant-expression : statement) : `(case ,$2 ,$4) + (default : statement) : `(case-default ,$3)) ;; 6.8.2 (compound-statement - (lbrace block-item-list rbrace) - (lbrace rbrace)) + (lbrace block-item-list rbrace) : `(begin ,$2) + (lbrace rbrace) : '(begin)) (block-item-list - (block-item) - (block-item-list block-item)) + (block-item-list block-item) : (append $1 (list $2)) + (block-item) : `(let () ,$1) + ) (block-item - (declaration) - (statement)) + (declaration) : $1 + (statement) : $1) ;; 6.8.3 (expression-statement - (expression semicolon) - (semicolon)) + (expression semicolon) : $1 + (semicolon) : '(noop)) (selection-statement - (if lparen expression rparen statement) - (if lparen expression rparen statement else statement) - (switch lparen expression rparen statement)) + (if lparen expression rparen statement else statement) : `(if ,$3 ,$5 ,$7) + (if lparen expression rparen statement) : `(when ,$3 ,$5) + (switch lparen expression rparen statement) : `(switch ,$3 ,$5)) ;; 6.8.5 (iteration-statement - (while lparen expression rparen statement) - (do statement while lparen expression rparen semicolon) - (for lparen expression semicolon expression semicolon expression rparen statement) - (for lparen expression semicolon expression semicolon rparen statement) - (for lparen expression semicolon semicolon expression rparen statement) - (for lparen semicolon semicolon rparen statement) - (for lparen semicolon expression semicolon expression rparen statement) - (for lparen semicolon expression semicolon rparen statement) - (for lparen declaration expression semicolon expression rparen statement) + (while lparen expression rparen statement) : `(while ,$3 ,$5) + (do statement while lparen expression rparen semicolon) : `(do-while ,$5 ,$2) + (for lparen expression semicolon expression semicolon expression rparen statement) : `(for (init ,$3) (cond ,$5) (step ,$7) ,$9) + (for lparen expression semicolon expression semicolon rparen statement) : `(for (init ,$3) (cond ,$5) (step ) ,$8) + (for lparen expression semicolon semicolon expression rparen statement) : `(for (init ,$3) (cond ) (step ,$6) ,$8) + (for lparen semicolon semicolon rparen statement) : `(for (init ) (cond ) (step ) ,$6) + (for lparen semicolon expression semicolon expression rparen statement) : `(for (init ) (cond ,$4) (step ,$6) ,$8) + (for lparen semicolon expression semicolon rparen statement) : `(for (init ) (cond ,$4) (step ) ,$7) + (for lparen declaration expression semicolon expression rparen statement) ; TODO (for lparen declaration expression semicolon rparen statement) (for lparen declaration semicolon expression rparen statement) (for lparen declaration semicolon rparen statement)) ;; 6.8.6 (jump-statement - (goto identifier semicolon) - (continue semicolon) - (break semicolon) - (return expression semicolon) - (return semicolon)) - + (goto identifier semicolon) : `(goto ,$2) + (continue semicolon) : `(continue) + (break semicolon) : `(break) + (return expression semicolon) : `(return ,$2) + (return semicolon) : `(return)) ;; 6.9 - (translation-unit - (external-declaration) - (translation-unit external-declaration)) - (external-declaration - (function-definition) - (declaration)) + (function-definition) : $1 + (declaration) : $1) ;; 6.9.1 (function-definition (declaration-specifiers declarator declaration-list compound-statement) - (declaration-specifiers declarator compound-statement)) + (declaration-specifiers declarator compound-statement) : `(define ,($2 $1) ,$3)) (declaration-list - (declaration) - (declaration-list declaration)))) + (declaration-list declaration) : (append $1 (list $2)) + (declaration) : `(declaration-list ,$1)) + + + ;; 6.7.2 + ;; Placed AFTER init-declarator to handle "int x = 5;" case. Otherwise it's + ;; only treated as a (really badly formed) typedef + (type-specifier + (void) : `(type ,$1) + (char) : `(type ,$1) + (short) : `(type ,$1) + (int) : `(type ,$1) + (long) : `(type ,$1) + (float) : `(type ,$1) + (double) : `(type ,$1) + (signed) : `(type ,$1) + (unsigned) : `(type ,$1) + (_Bool) : `(type bool) + (_Complex) : `(type complex) + (atomic-type-specifier) : `(type ,$1) + (struct-or-union-specifier) : `(type ,$1) + (enum-specifier) : `(type ,$1) + (typedef-name) : `(type ,$1)))) (define (build-lexical-analyzer tokens) |