2 The C Language
This library provides data types representing C abstract syntax, a C parser, and macros for constructing C abstract syntax with a convenient parenthesized syntax. It can be required via:
2.1 C Language Grammar
typedef int T; |
void proc(char T) { } |
The following is a more detailed (and slightly reorganized) grammar than the one in the C99 standard which explicitly specifies when tokens bound as typedef names can be used as identifiers.
| ‹List›X | ::= | X {"," ‹List›X}* |
| ‹AnyIdentifier› | ::= | ‹Identifier› |
|
| | | ‹TypedefName› |
2.1.1 Expressions
| ‹PrimaryExpression› | ::= | ‹Identifier› |
|
| | | ‹Constant› |
|
| | | ‹StringLiteral› |
|
| | | "(" ‹Expression› ")" |
| ‹PostfixExpression› | ::= | ‹PrimaryExpression› |
|
| | | ‹PostfixExpression› "[" ‹Expression› "]" |
|
| | | ‹PostfixExpression› "(" [‹List›‹AssignmentExpression›] ")" |
|
| | | ‹PostfixExpression› "." ‹AnyIdentifier› |
|
| | | ‹PostfixExpression› "->" ‹AnyIdentifier› |
|
| | | ‹PostfixExpression› "++" |
|
| | | ‹PostfixExpression› "–" |
|
| | | "(" ‹TypeName› ")" "{" ‹List›‹Initializer› [","] "}" |
| ‹UnaryExpression› | ::= | "++" ‹UnaryExpression› |
|
| | | "–" ‹UnaryExpression› |
|
| | | {"&" | "*" | "+" | "-" | "~" | "!"} ‹CastExpression› |
|
| | | "sizeof" ‹UnaryExpression› |
|
| | | "sizeof" "(" ‹TypeName› ")" |
| ‹CastExpression› | ::= | ‹UnaryExpression› |
|
| | | "(" ‹TypeName› ")" ‹CastExpression› |
| ‹BinaryExpression›(E,Op) | ::= | E |
|
| | | ‹BinaryExpression›(E,Op) Op E |
| ‹MultiplicativeExpression› | ::= | ‹BinaryExpression›(‹CastExpression›,{"*" | "/" | "%"}) |
| ‹AdditiveExpression› | ::= | ‹BinaryExpression›(‹MultiplicativeExpression›,{"+" | "-"}) |
| ‹ShiftExpression› | ::= | ‹BinaryExpression›(‹AdditiveExpression›,{"<<" | ">>"}) |
| ‹RelationalExpression› | ::= | ‹BinaryExpression›(‹ShiftExpression›,{"<" | ">" | "<=" | ">="}) |
| ‹EqualityExpression› | ::= | ‹BinaryExpression›(‹RelationalExpression›,{"==" | "!="}) |
| ‹ANDExpression› | ::= | ‹BinaryExpression›(‹EqualityExpression›,"&") |
| ‹ExclusiveORExpression› | ::= | ‹BinaryExpression›(‹ANDExpression›,"^") |
| ‹InclusiveORExpression› | ::= | ‹BinaryExpression›(‹ExclusiveORExpression›,"|") |
| ‹LogicalANDExpression› | ::= | ‹BinaryExpression›(‹LogicalORExpression›,"||") |
| ‹ConditionalExpression› | ::= | ‹LogicalORExpression› |
|
| | | ‹LogicalORExpression› "?" ‹Expression› ":" ‹ConditionalExpression› |
| ‹AssignmentExpression› | ::= | ‹ConditionalExpression› |
|
| | | ‹UnaryExpression› ‹AssignmentOperator› ‹AssignmentExpression› |
| ‹AssignmentOperator› | ::= | "=" | "*=" | "/=" | "%=" | "+=" | "-=" |
|
| | | "<<=" | ">>=" | "&=" | "^=" | "|=" |
| ‹Expression› | ::= | ‹List›‹AssignmentExpression› |
| ‹ConstantExpression› | ::= | ‹ConditionalExpression› |
2.1.2 Declarations
| ‹Declaration› | ::= | ‹DeclarationModifier›+ [‹List›‹InitDeclarator›‹Identifier›] ";" |
|
| | | ‹DeclarationSpecifiers› [‹List›‹InitDeclarator›‹AnyIdentifier›] ";" |
| ‹DeclarationSpecifiers› | ::= | ‹DeclarationModifier›* ‹TaggedTypeSpecifier› ‹DeclarationModifier›* |
|
| | | ‹DeclarationModifier›* ‹TypedefName› ‹DeclarationModifier›* |
|
| | | ‹DeclarationModifier›* {‹PrimTypeSpecifier› ‹DeclarationModifier›*}+ |
| ‹DeclarationModifier› | ::= | ‹StorageClassSpecifier› |
|
| | | ‹TypeQualifier› |
|
| | | ‹FunctionSpecifier› |
| ‹InitDeclarator›X | ::= | ‹Declarator›X ["=" ‹Initializer›] |
| ‹StorageClassSpecifier› | ::= | "typedef" | "extern" | "static" | "auto" | "register" |
| ‹TypeSpecifier› | ::= | ‹PrimTypeSpecifier› |
|
| | | ‹TaggedTypeSpecifier› |
|
| | | ‹TypedefName› |
| ‹PrimTypeSpecifier› | ::= | "void" |
|
| | | "char" | "short" | "int" | "long" |
|
| | | "float" | "double" |
|
| | | "signed" | "unsigned" |
|
| | | "_Bool" | "_Complex" |
| ‹TaggedTypeSpecifier› | ::= | {"struct" | "union"} [‹Tag›] "{" ‹StructDeclaration›+ "}" |
|
| | | {"struct" | "union"} ‹Tag› |
|
| | | ‹EnumSpecifier› |
| ‹Tag› | ::= | ‹Identifier› |
|
| | | ‹TypedefName› |
| ‹StructDeclaration› | ::= | ‹TypeQualifier›+ [‹List›‹StructDeclarator›‹Identifier›] ";" |
|
| | | ‹StructSpecifiers› [‹List›‹StructDeclarator›‹AnyIdentifier›] ";" |
| ‹StructSpecifiers› | ::= | ‹TypeQualifier›* ‹TaggedTypeSpecifier› ‹TypeQualifier›* |
|
| | | ‹TypeQualifier›* ‹TypedefName› ‹TypeQualifier›* |
|
| | | ‹TypeQualifier›* {‹PrimTypeSpecifier› ‹TypeQualifier›*}+ |
| ‹StructDeclarator›X | ::= | ‹Declarator›X |
|
| | | [‹Declarator›X] ":" ‹ConstantExpression› |
| ‹EnumSpecifier› | ::= | "enum" [‹Tag›] "{" ‹List›‹Enumerator› [","] "}" |
|
| | | "enum" ‹Tag› |
| ‹Enumerator› | ::= | ‹AnyIdentifier› ["=" ‹ConstantExpression›] |
| ‹TypeQualifier› | ::= | "const" | "restrict" | "volatile" |
| ‹FunctionSpecifier› | ::= | "inline" |
| ‹Declarator›X | ::= | [‹Pointer›] ‹DirectDeclarator›X |
| ‹DirectDeclarator›X | ::= | X |
|
| | | "(" ‹Declarator›X ")" |
|
| | | ‹DirectDeclarator›X "[" ‹TypeQualifier›* [‹AssignmentExpression›] "]" |
|
| | | ‹DirectDeclarator›X "[" "static" ‹TypeQualifier›* ‹AssignmentExpression› "]" |
|
| | | ‹DirectDeclarator›X "[" TypeQualifier+ "static" ‹AssignmentExpression› "]" |
|
| | | ‹DirectDeclarator›X "[" ‹TypeQualifier›* "*" "]" |
|
| | | ‹DirectDeclarator›X "(" ‹ParameterTypeList› ")" |
|
| | | ‹DirectDeclarator›X "(" [‹List›‹Identifier›] ")" |
| ‹Pointer› | ::= | {"*" ‹TypeQualifier›*}+ |
| ‹ParameterTypeList› | ::= | ‹List›‹ParameterDeclaration› ["," "..."] |
| ‹ParameterDeclaration› | ::= | ‹DeclarationModifier›+ [‹Declarator›‹Identifier›] |
|
| | | ‹DeclarationSpecifiers› [‹Declarator›‹AnyIdentifier›] |
|
| | | ‹DeclarationModifier›+ ‹AbstractDeclarator› |
|
| | | ‹DeclarationSpecifiers› ‹AbstractDeclarator› |
| ‹TypeName› | ::= | {‹TypeSpecifier› | ‹TypeQualifier›}+ [‹AbstractDeclarator›] |
| ‹AbstractDeclarator› | ::= | ‹Pointer› |
|
| | | [‹Pointer›] ‹DirectAbstractDeclarator› |
| ‹DirectAbstractDeclarator› | ::= | "(" ‹AbstractDeclarator› ")" |
|
| | | [‹DirectAbstractDeclarator›] "[" ‹TypeQualifier›* [‹AssignmentExpression›] "]" |
|
| | | [‹DirectAbstractDeclarator›] "[" "static" ‹TypeQualifier›* ‹AssignmentExpression› "]" |
|
| | | [‹DirectAbstractDeclarator›] "[" ‹TypeQualifier›+ "static" ‹AssignmentExpression› "]" |
|
| | | [‹DirectAbstractDeclarator›] "[" "*" "]" |
|
| | | [‹DirectAbstractDeclarator›] "(" [‹ParameterTypeList›] ")" |
| ‹Initializer› | ::= | ‹AssignmentExpression› |
|
| | | "{" ‹List›{[‹List›‹Designator› "="] ‹Initializer›} [","] "}" |
| ‹Designator› | ::= | "[" ‹ConstantExpression› "]" |
|
| | | "." ‹AnyIdentifier› |
2.1.3 Statements
The parameterized statement non-terminals such as ‹Statement›X take a flag indicating whether the productions may be right-terminated by a one-armed if statement (i.e., an if statement with no else clause). This is used to avoid the “dangling else” ambiguity.
| ‹Statement›X | ::= | ‹LabeledStatement›X |
|
| | | ‹CompoundStatement› |
|
| | | ‹ExpressionStatement› |
|
| | | ‹SelectionStatement›X |
|
| | | ‹IterationStatement›X |
|
| | | ‹JumpStatement› |
| ‹LabeledStatement›X | ::= | ‹AnyIdentifier› ":" ‹Statement›X |
|
| | | "case" ‹ConstantExpression› ":" ‹Statement›X |
|
| | | "default" ":" ‹Statement›X |
| ‹CompoundStatement› | ::= | "{" ‹BlockItem›* "}" |
| ‹BlockItem› | ::= | ‹Declaration› |
|
| | | ‹Statement›#t |
| ‹ExpressionStatement› | ::= | [‹Expression›] ";" |
| ‹SelectionStatement›X | ::= | ‹IfStatement›X |
|
| | | "switch" "(" ‹Expression› ")" ‹Statement›X |
| ‹IfStatement›#t | ::= | "if" "(" ‹Expression› ")" ‹Statement›#t ["else" ‹Statement›#t] |
| ‹IfStatement›#f | ::= | "if" "(" ‹Expression› ")" ‹Statement›#t "else" ‹Statement›#f |
| ‹IterationStatement›X | ::= | "while" "(" ‹Expression› ")" ‹Statement›X |
|
| | | "do" ‹Statement›#t "while" "(" ‹Expression› ")" ";" |
|
| | | "for" "(" [‹Expression›] ";" [‹Expression›] ";" [‹Expression›] ")" ‹Statement›X |
|
| | | "for" "(" ‹Declaration› [‹Expression›] ";" [‹Expression›] ")" ‹Statement›X |
| ‹JumpStatement› | ::= | "goto" ‹AnyIdentifier› ";" |
|
| | | "continue" ";" |
|
| | | "break" ";" |
|
| | | "return" [‹Expression›] ";" |
2.1.4 Programs
| ‹TranslationUnit› | ::= | ‹ExternalDefinition›+ |
| ‹ExternalDefinition› | ::= | ‹FunctionDefinition› |
|
| | | ‹Declaration› |
| ‹FunctionDefinition› | ::= | ‹FunctionHead› [‹List›‹Declaration›] ‹FunctionBody› |
| ‹FunctionHead› | ::= | ‹DeclarationModifier›+ ‹Declarator›‹Identifier› |
|
| | | ‹DeclarationSpecifiers› ‹Declarator›‹AnyIdentifier› |
| ‹FunctionBody› | ::= | ‹CompoundStatement› |
2.2 Abstract Syntax
The abstract syntax of C is represented as structs. All of the structure definitions are provided by the package
(require (planet dherman/c:3:2/ast)) |
All of the structs defined in this library are prefab structs, and consist entirely of read-able and write-able data.
2.2.1 Source Locations
Source location information is stored with the following struct type.
| |||||||||||||||||||||||||||||||||||
start-offset : exact-nonnegative-integer? | |||||||||||||||||||||||||||||||||||
start-line : exact-positive-integer? | |||||||||||||||||||||||||||||||||||
start-col : exact-nonnegative-integer? | |||||||||||||||||||||||||||||||||||
end-offset : exact-nonnegative-integer? | |||||||||||||||||||||||||||||||||||
end-line : exact-positive-integer? | |||||||||||||||||||||||||||||||||||
end-col : exact-nonnegative-integer? | |||||||||||||||||||||||||||||||||||
path : any |
(position-min p ...+) → position? |
p : position? |
(position-max p ...+) → position? |
p : position? |
(src->syntax x [datum original?]) → syntax? |
x : src? |
datum : any = '... |
original? : boolean? = #t |
(id->syntax id [original?]) → syntax? |
id : id? |
original? : boolean? = #t |
(primitive-type-specifier? x) → boolean? |
x : symbol? |
(unary-operator? x) → boolean? |
x : symbol? |
(binary-operator? x) → boolean? |
x : symbol? |
(assignment-operator? x) → boolean? |
x : symbol? |
(increment-operator? x) → boolean? |
x : symbol? |
2.2.2 Identifiers
(struct (id:qualifier id) (name)) |
name : (or/c 'const 'restrict 'volatile) |
(struct (id:op id) (name)) |
name : (or/c unary-operator? binary-operator? assignment-operator? increment-operator?) |
(struct (id:storage id) (class)) |
class : (or/c 'typedef 'extern 'static 'auto 'register) |
(struct (id:ellipsis id) ()) |
2.2.3 Expressions
(struct (expr:int expr) (value qualifiers)) |
value : integer? |
qualifiers : (listof id:qualifier?) |
(struct (expr:float expr) (value qualifiers)) |
value : inexact-real? |
qualifiers : (listof id:qualifier?) |
Example: |
> (parse-expression "'\\n'") |
#s((expr:char expr 1) #s(src 1 1 0 5 1 4 #f) "\\n" #f) |
(struct (expr:string expr) (source wide?)) |
source : string? |
wide? : boolean? |
Example: |
> (parse-expression "\"foo\\nbar\"") |
#s((expr:string expr 1) #s(src 1 1 0 11 1 10 #f) "foo\\nbar" #f) |
(struct (expr:compound expr) (type inits)) |
type : type? |
inits : (listof (or/c init? (cons (listof dtor?) init?))) |
(struct (expr:array-ref expr) (expr offset)) |
expr : expr? |
offset : expr? |
(struct (expr:member expr) (expr label)) |
expr : expr? |
label : id:label? |
(struct (expr:pointer-member expr) (expr label)) |
expr : expr? |
label : id:label? |
(struct (expr:postfix expr) (expr op)) |
expr : expr? |
op : id:op? |
(struct (expr:prefix expr) (op expr)) |
op : id:op? |
expr : expr? |
(struct (expr:sizeof expr) (term)) |
term : (or/c type? expr?) |
(struct (expr:binop expr) (left op right)) |
left : expr? |
op : id:op? |
right : expr? |
(struct (expr:assign expr) (left op right)) |
left : expr? |
op : id:op? |
right : expr? |
(struct (expr:begin expr) (left right)) |
left : expr? |
right : expr? |
2.2.4 Statements
(struct (stmt:label stmt) (label stmt)) |
label : id:label? |
stmt : stmt? |
(struct (stmt:default stmt) (stmt)) |
stmt : stmt? |
(struct (stmt:switch stmt) (test body)) |
test : expr? |
body : stmt? |
(struct (stmt:while stmt) (test body)) |
test : expr? |
body : stmt? |
(struct (stmt:for stmt) (init test update body)) |
init : (or/c expr? decl? #f) |
test : (or/c expr? #f) |
update : (or/c expr? #f) |
body : stmt? |
(struct (stmt:continue stmt) ()) |
(struct (stmt:break stmt) ()) |
(struct (stmt:return stmt) (result)) |
result : (or/c expr? #f) |
(struct (stmt:empty stmt) ()) |
2.2.5 Declarations
(struct (decl:typedef decl) (type declarators)) |
type : type? |
declarators : (listof declarator-context?) |
(struct (decl:vars decl) (storage-class type declarators)) |
storage-class : (or/c id:storage? #f) |
type : (or/c type? #f) |
declarators : (listof declarator-context?) |
(struct (decl:formal decl) (storage-class type declarator)) |
storage-class : (or/c id:storage? #f) |
type : (or/c type? #f) |
declarator : (or/c declarator-context? type-context?) |
| ||||||||||||||||||||||||||||||
storage-class : (or/c id:storage? #f) | ||||||||||||||||||||||||||||||
inline? : (or/c id:inline? #f) | ||||||||||||||||||||||||||||||
return-type : type? | ||||||||||||||||||||||||||||||
declarator : declarator-context? | ||||||||||||||||||||||||||||||
preamble : (or/c (listof decl?) #f) | ||||||||||||||||||||||||||||||
body : stmt:block? |
(struct (decl:declarator decl) (id type initializer)) |
id : (or/c id:var? #f) |
type : (or/c type? #f) |
initializer : (or/c init? #f) |
(declarator-context? x) → boolean? |
x : any |
(complete-declarator? x) → boolean? |
x : any |
(struct (decl:member-declarator decl) (id type initializer bit-size)) |
id : (or/c id:label? #f) |
type : (or/c type? #f) |
initializer : (or/c init? #f) |
bit-size : (or/c expr? #f) |
(member-declarator-context? x) → boolean? |
x : any |
(complete-member-declarator? x) → boolean? |
x : any |
(struct (decl:member decl) (type declarators)) |
type : (or/c type? #f) |
declarators : (listof decl:declarator?) |
2.2.6 Initializers
(struct (init:compound init) (elements)) |
elements : (listof (or/c init? (cons (listof dtor?) init?))) |
2.2.7 Designators
(struct (dtor:array dtor) (expr)) |
expr : expr? |
(struct (dtor:member dtor) (label)) |
label : id:label? |
2.2.8 Types
(struct (type:primitive type) (name)) |
name : (or/c primitive-type-specifier? (listof primitive-type-specifier?)) |
'void, 'char, 'short, 'int, 'long, 'float, 'double, 'signed, 'unsigned, '_Bool, or '_Complex
'(signed char)
'(unsigned char)
'(signed short)
'(signed short int)
'(unsigned short)
'(unsigned short int)
'(signed int)
'(unsigned int)
'(signed long)
'(long int)
'(signed long int)
'(unsigned long)
'(unsigned long int)
'(long long)
'(signed long long)
'(long long int)
'(signed long long int)
'(unsigned long long)
'(unsigned long long int)
'(long double)
'(float _Complex)
'(double _Complex)
'(long double _Complex)
(struct (type:struct type) (tag fields)) |
tag : id:label? |
fields : (or/c (listof decl:member?) #f) |
(struct (type:union type) (tag variants)) |
tag : id:label? |
variants : (or/c (listof decl:member?) #f) |
(struct (type:enum type) (tag variants)) |
tag : id:label? |
variants : (or/c (listof (or/c id:var? (cons id:var? expr?))) #f) |
(struct (type:array type) (base static? qualifiers length star?)) |
base : type? |
static? : (or/c id:static? #f) |
qualifiers : (listof id:qualifier?) |
length : (or/c expr? #f) |
star? : (or/c id:star? #f) |
(struct (type:pointer type) (base qualifiers)) |
base : type? |
qualifiers : (listof id:qualifier?) |
(struct (type:function type) (return formals)) |
return : type? |
formals : (listof (or/c decl:formal? id:ellipsis?)) |
(struct (type:qualified type) (type qualifiers)) |
type : (or/c type? #f) |
qualifiers : (listof id:qualifier?) |
2.2.9 Type Contexts
typedef int A[32], *PA[32]; |
#f;
a type:pointer whose type:pointer-base field is a type context;
a type:array whose type:array-base field is a type context;
or a type:function whose type:function-return field is a type context.
(type-context? x) → boolean? |
x : any |
(complete-type? x) → boolean? |
x : any |
(apply-type-context context base) → complete-type? |
context : type-context? |
base : complete-type? |
(apply-declarator-context context base) → complete-declarator? |
context : declarator-context? |
base : complete-type? |
(apply-declarator-contexts contexts base) |
→ (listof complete-declarator?) |
contexts : (listof declarator-context?) |
base : complete-type? |
| ||||||||
→ complete-member-declarator? | ||||||||
context : declarator-context? | ||||||||
base : complete-type? |
| ||||||||
→ (listof complete-member-declarator?) | ||||||||
contexts : (listof member-declarator-context?) | ||||||||
base : complete-type? |