# ccmeta.leg -- metalanguage for C # # Copyright (c) 2016-2021 Ian Piumarta and other contributors (see AUTHORS) # All rights reserved (see LICENSE) # # Last edited: 2021-07-12 18:54:53 by piumarta on DESKTOP-LTPREOB %{ /* compile: leg -o ccmeta.c ccmeta.leg * cc -o ccmeta ccmeta.c -lgc -lm * * run: ./ccmeta < ccmeta-test.txt */ #include #include #define DO_PROTOS() \ _DO(Undefined) _DO(Integer) _DO(Float) _DO(String) _DO(Symbol) _DO(Function) _DO(Map) \ _DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \ _DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \ _DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand) \ _DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) \ _DO(Shleft) _DO(Shright) \ _DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com) \ _DO(PreIncVariable) _DO(PreIncMember) _DO(PreIncIndex) \ _DO(PostIncVariable) _DO(PostIncMember) _DO(PostIncIndex) \ _DO(PreDecVariable) _DO(PreDecMember) _DO(PreDecIndex) \ _DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \ _DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \ _DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \ /* _DO(Quasiquote) _DO(Unquote) */ \ _DO(Comment) _DO(Token) \ _DO(C_declaration) \ _DO(C_if) _DO(C_int) _DO(C_float) _DO(C_char) _DO(C_id) _DO(C_while) _DO(C_do) _DO(C_for) \ _DO(C_binary) typedef enum { t_UNDEFINED=0, #define _DO(NAME) t_##NAME, DO_PROTOS() #undef _DO } proto_t; #define SYMBOL_PAYLOAD proto_t prototype; #include "object.c" #include enum jb_t { j_return = 1, j_break, j_continue, j_throw, }; typedef struct jb_record { sigjmp_buf jb; oop result; struct jb_record *next; } jb_record; jb_record *jbs= NULL; #define jbRecPush() \ struct jb_record jbrec; \ jbrec.next= jbs; \ jbs= &jbrec #define jbRecPop() \ assert(jbs == &jbrec); \ jbs= jbrec.next // this is the global scope oop globals= 0; #define DO_SYMBOLS() \ DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__) \ _DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate) \ _DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise) \ _DO(update) _DO(this) _DO(fixed) _DO(operator) _DO(map) _DO(func) \ _DO(try) _DO(catch) _DO(finally) _DO(exception) \ _DO(__line__) _DO(__file__) \ _DO(comment) \ _DO(text) _DO(if) _DO(lparen) _DO(rparen) _DO(else) _DO(identifier) _DO(semicolon) _DO(while) \ _DO(do) _DO(for) _DO(initExpr) _DO(condExpr) _DO(incrExpr) _DO(firstSemi) _DO(secondSemi) \ _DO(binary) _DO(specifiers) _DO(declarators) #define _DO(NAME) oop NAME##_symbol; DO_SYMBOLS() #undef _DO #define _DO(NAME) oop NAME##_proto; DO_PROTOS() #undef _DO int opt_g= 0; int opt_v= 0; oop mrAST= &_null; void printBacktrace(oop top); void runtimeError(char *fmt, ...); typedef struct input_t { oop name; FILE *file; struct input_t *next; int lineNumber; } input_t; input_t *inputStack= NULL; void inputStackPush(char *name) { FILE *file = stdin; if (NULL != name) { file= fopen(name, "rb"); if (NULL == file) { perror(name); exit(1); } } else { name= ""; } input_t *input = malloc(sizeof(input_t)); input->name= makeString(name); input->lineNumber= 1; input->file= file; input->next= inputStack; inputStack= input; return; } input_t *inputStackPop(void) { assert(inputStack); input_t *first= inputStack; inputStack= first->next; return first; } int isFalse(oop obj) { return obj == null || (isInteger(obj) && (0 == getInteger(obj))); } int isTrue(oop obj) { return !isFalse(obj); } oop newObject(oop proto) { oop map = makeMap(); map_set(map, __proto___symbol, proto); // set context (file and line) for runtime error msg map_set(map, __line___symbol, makeInteger(inputStack->lineNumber)); map_set(map, __file___symbol, inputStack->name); return map; } void printObjectName(oop object) { assert(is(Map, object)); oop name = map_get(object, __name___symbol); if (name != null) { println(name); return; } oop proto = map_get(object, __proto___symbol); if (proto != null) { printObjectName(proto); } else { fprintf(stderr, "\nThis map has no name\n"); } } // this always creates the key in "object" oop newVariable(oop object, oop key, oop value) { map_set(object, key, value); return value; } // this looks in object and everything in the __proto__ chain until it finds the key; // if the key is not found and it is #__proto__ then the Map prototype is returned oop getVariable(oop object, oop key) { while (!map_hasKey(object, key)) { object = map_get(object, __proto___symbol); if (null == object) { if (key == __proto___symbol) return getVariable(globals, Map_symbol); runtimeError("Undefined: %s", printString(key)); } } return map_get(object, key); } oop getMember(oop object, oop key) { while (!map_hasKey(object, key)) { object = map_get(object, __proto___symbol); if (null == object) { return null; } } return map_get(object, key); } // this follows the __proto__ chain until it finds the key, if it fails it behaves like newMember oop setVariable(oop object, oop key, oop value) { oop obj= object; while (!map_hasKey(obj, key)) { obj= map_get(obj, __proto___symbol); if (null == obj) { return map_set(object, key, value); } } return map_set(obj, key, value); } oop getProperty(oop object, oop key) { if (!map_hasKey(object, key)) { runtimeError("Undefined: .%s", printString(key)); } return map_get(object, key); } oop newMap(oop value) { oop map = newObject(Map_proto); map_set(map, value_symbol, value); return map; } oop newDeclaration(oop name, oop exp) { oop declaration = newObject(Declaration_proto); map_set(declaration, lhs_symbol, name); map_set(declaration, rhs_symbol, exp); return declaration; } oop new_C_if(oop ifTok, oop lParen, oop condition, oop rParen, oop consequent, oop elseTok, oop alternate) { oop obj = newObject(C_if_proto); map_set(obj, if_symbol, ifTok); map_set(obj, lparen_symbol, lParen); map_set(obj, condition_symbol, condition); map_set(obj, rparen_symbol, rParen); map_set(obj, consequent_symbol, consequent); map_set(obj, else_symbol, elseTok); map_set(obj, alternate_symbol, alternate); return obj; } oop new_C_while(oop whileTok, oop lParen, oop expression, oop rParen, oop statement) { oop object = newObject(C_while_proto); map_set(object, while_symbol, whileTok); map_set(object, lparen_symbol, lParen); map_set(object, expression_symbol, expression); map_set(object, rparen_symbol, rParen); map_set(object, statements_symbol, statement); return object; } oop new_C_do(oop doTok, oop statement, oop whileTok, oop lParen, oop expression, oop rParen, oop semicolon) { oop object = newObject(C_do_proto); map_set(object, do_symbol, doTok); map_set(object, statements_symbol, statement); map_set(object, while_symbol, whileTok); map_set(object, lparen_symbol, lParen); map_set(object, expression_symbol, expression); map_set(object, rparen_symbol, rParen); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_for(oop forTok, oop lParen, oop initExpr, oop semicolon1, oop condExpr, oop semicolon2, oop incrExpr, oop rParen, oop statement) { oop object = newObject(C_for_proto); map_set(object, for_symbol, forTok); map_set(object, lparen_symbol, lParen); map_set(object, initExpr_symbol, initExpr); map_set(object, firstSemi_symbol, semicolon1); map_set(object, condExpr_symbol, condExpr); map_set(object, secondSemi_symbol, semicolon2); map_set(object, incrExpr_symbol, incrExpr); map_set(object, rparen_symbol, rParen); map_set(object, statements_symbol, statement); return object; } oop newSwitch(oop expression, oop labels, oop statements) { oop obj= newObject(Switch_proto); map_set(obj, expression_symbol, expression); map_set(obj, labels_symbol, labels); map_set(obj, statements_symbol, statements); return obj; } // take char *name or oop already interned? oop newSymbol(oop name) { oop symbol = newObject(Symbol_proto); // what is the less confusing, name or value? maybe another word like identifier? map_set(symbol, value_symbol, name); return symbol; } oop new_C_int(char *text) { oop object = newObject(C_int_proto); map_set(object, text_symbol, makeString(text)); return object; } oop new_C_float(char *text) { oop object = newObject(C_float_proto); map_set(object, text_symbol, makeString(text)); return object; } int digitValue(int c) { if (c < '0') return -1; if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c) if ('9' < c && c < 'A') return -1; if ('Z' < c) return -1; if (c >= 'A') c -= ('A' - 10); else c -= '0'; return c; } int isradix(int r, int c) { c= digitValue(c); return 0 <= c && c < r; } char *unescape(char *s) { char *t= strdup(s); int in= 0, out= 0, c= 0; while (0 != (c= t[in++])) { if ('\\' == c && 0 != (c= t[in])) { ++in; switch (c) { case 'a': c= '\a'; break; case 'b': c= '\b'; break; case 'e': c= '\e'; break; case 'f': c= '\f'; break; case 'n': c= '\n'; break; case 'r': c= '\r'; break; case 't': c= '\t'; break; case 'v': c= '\v'; break; case '0'...'7': { c -= '0'; if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; break; } case 'x': { c= 0; if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); break; } case 'u': { c= 0; if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); break; } } } t[out++]= c; } t[out]= 0; return t; } oop newString(oop str) { assert(is(String, str)); oop string = newObject(String_proto); map_set(string, value_symbol, str); return string; } oop new_C_char(char *s) { oop object = newObject(C_char_proto); map_set(object, value_symbol, makeString(s)); return object; } oop newPreIncrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_GetVariable: proto= PreIncVariable_proto; break; case t_GetMember: proto= PreIncMember_proto; break; case t_GetIndex: proto= PreIncIndex_proto; break; default: { printf("\nNon-lvalue after ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPostIncrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_GetVariable: proto= PostIncVariable_proto; break; case t_GetMember: proto= PostIncMember_proto; break; case t_GetIndex: proto= PostIncIndex_proto; break; default: { printf("\nNon-lvalue before ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPreDecrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_GetVariable: proto= PreDecVariable_proto; break; case t_GetMember: proto= PreDecMember_proto; break; case t_GetIndex: proto= PreDecIndex_proto; break; default: { printf("\nNon-lvalue after ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPostDecrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_GetVariable: proto= PostDecVariable_proto; break; case t_GetMember: proto= PostDecMember_proto; break; case t_GetIndex: proto= PostDecIndex_proto; break; default: { printf("\nNon-lvalue before ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newUnary(oop proto, oop rhs) { oop obj = newObject(proto); map_set(obj, rhs_symbol, rhs); return obj; } oop new_C_binary(oop lhs, oop binary, oop rhs) { oop object = newObject(C_binary_proto); map_set(object, lhs_symbol, lhs); map_set(object, binary_symbol, binary); map_set(object, rhs_symbol, rhs); return object; } oop newAssign(oop proto, oop lhs, oop operator, oop rhs) { oop obj = newObject(proto); map_set(obj, lhs_symbol, lhs); map_set(obj, operator_symbol, operator); map_set(obj, rhs_symbol, rhs); return obj; } oop newSetMap(oop proto, oop map, oop key, oop operator, oop value) { oop obj = newObject(proto); map_set(obj, map_symbol, map); map_set(obj, key_symbol, key); map_set(obj, operator_symbol, operator); map_set(obj, value_symbol, value); return obj; } oop newGetMap(oop proto, oop map, oop key) { oop obj = newObject(proto); map_set(obj, map_symbol, map); map_set(obj, key_symbol, key); return obj; } oop newGetVariable(oop name) { oop id= newObject(GetVariable_proto); map_set(id, key_symbol, name); return id; } oop newFunc(oop name, oop param, oop body, oop fixed) { oop func = newObject(Func_proto); map_set(func, name_symbol, name); map_set(func, param_symbol, param); map_set(func, body_symbol, body); map_set(func, fixed_symbol, fixed); return func; } oop apply(oop scope, oop this, oop func, oop args, oop ast); oop getSyntaxId(int n, oop key) { oop val = map_get(globals, key); if (!is(Function, val)) return null; oop fix = get(val, Function, fixed); if (!isInteger(fix)) return null; if (n != getInteger(fix)) return null; return val; } oop getSyntax(int n, oop func) { if (map_get(func, __proto___symbol) != GetVariable_proto) return null; oop key = map_get(func, key_symbol); return getSyntaxId(n, key); } oop newCall(oop func, oop args) { oop call = newObject(Call_proto); map_set(call, func_symbol, func); map_set(call, args_symbol, args); return call; } oop newInvoke(oop this, oop name, oop args) { oop obj = newObject(Invoke_proto); map_set(obj, this_symbol, this); map_set(obj, name_symbol, name); map_set(obj, args_symbol, args); return obj; } oop newBlock(oop statements) { oop obj = newObject(Block_proto); map_set(obj, statements_symbol, statements); return obj; } oop newReturn(oop exp) { oop obj = newObject(Return_proto); map_set(obj, value_symbol, exp); return obj; } oop newBreak(void) { oop obj = newObject(Break_proto); return obj; } oop newContinue(void) { oop obj = newObject(Continue_proto); return obj; } oop newTry(oop try, oop exception, oop catch, oop finally) { oop obj = newObject(Try_proto); map_set(obj, try_symbol, try); map_set(obj, exception_symbol, exception); map_set(obj, catch_symbol, catch); map_set(obj, finally_symbol, finally); return obj; } oop new_C_id(char* id) { oop object = newObject(C_id_proto); map_set(object, identifier_symbol, intern(id)); return object; } oop new_C_declaration(oop specifiers, oop declarators, oop semicolon) { oop object = newObject(C_declaration_proto); map_set(object, specifiers_symbol, specifiers); map_set(object, declarators_symbol, declarators); map_set(object, semicolon_symbol, semicolon); return object; } void C_declarationBegin(void) {} int C_declarationAbort(void) { return 0; } void C_declarationEnd(void) {} #define YY_INPUT(buf, result, max_size) \ { \ int yyc= feof(inputStack->file) ? EOF : getc(inputStack->file); \ result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \ } #define YYSTYPE oop YYSTYPE yylval; int errorLine= 1; void syntaxError(char *text) { fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text); exit(1); } oop eval(oop scope, oop ast); struct _yycontext; int yyparsefrom(int (*yystart)(struct _yycontext *yy)); int irow= 0, icol= 0; int gnu= 1; char *errmsg= "no error"; void error(char *source) { fprintf(stderr, "\n%s near: %s\n", errmsg, source); exit(1); } #define newBegin() newToken("{") #define newEnd() newToken("}") oop newToken(char *text) { oop obj = newObject(Token_proto); map_set(obj, text_symbol, makeString(text)); return obj; } oop newComment(char *text) { oop obj = newObject(Comment_proto); map_set(obj, text_symbol, makeString(text)); return obj; } void setComment(oop ast, oop comment) { map_set(ast, comment_symbol, comment); } OopStack listOfLists= BUFFER_INITIALISER; oop currentList= 0; void listBegin(void) { OopStack_push(&listOfLists, currentList); currentList= makeMap(); } void listAppend(oop obj) { assert(currentList); map_append(currentList, obj); } oop listEnd(void) { assert(currentList); oop list= currentList; currentList= OopStack_pop(&listOfLists); return list; } oop listEmpty(void) { return makeMap(); } void declarationTypedef(void) { printf("DECLARATION TYPEDEF\n"); } %} start = externalDeclaration error = EOL* < (!EOL .)* EOL* (!EOL .)* > &{ error(yytext), 1 } ### A.1.3 Identifiers # 6.4.2.1 idOpt = id #| TODO : End parsing | {$$=0} id = { $$= new_C_id(yytext) } - ID = #| TODO : &{ !intern(yytext)->isKeyword } name = { $$= new_C_id(yytext) } - NAME = IDFIRST IDREST* IDFIRST = [a-zA-Z_] | universalCharacterName | '$' &{gnu} IDREST = IDFIRST | [0-9] digit = [0-9] ### A.1.4 Universal character names # 6.4.3 universalCharacterName = "\\u" hexQuad | "\\U" hexQuad hexQuad hexQuad = hexadecimalDigit hexadecimalDigit hexadecimalDigit hexadecimalDigit #|### #| #|### A.1.5 Constants # 6.4.4 constant = characterConstant | floatingConstant | integerConstant # 6.4.4.1 integerConstant = < ( hexadecimalConstant | octalConstant | binaryConstant &{gnu} | decimalConstant ) integerSuffix? > { $$ = new_C_int(yytext); } - decimalConstant = [1-9][0-9]* octalConstant = '0'[0-9]* hexadecimalConstant = hexadecimalPrefix [a-fA-F0-9]+ binaryConstant = '0'[bB][01]+ hexadecimalPrefix = '0'[xX] octalDigit = [0-7] hexadecimalDigit = [0-9A-Fa-f] integerSuffix = ( [uU][lL]?[lL]? | [lL][lL]?[uU]? ) ( imaginarySuffix &{gnu} )? imaginarySuffix = [ij] # 6.4.4.2 floatingConstant = <( decimalFloatingConstant | hexadecimalFloatingConstant )> { $$ = new_C_float(yytext); } - decimalFloatingConstant = fractionalConstant exponentPart? floatingSuffix? | digitSequence exponentPart floatingSuffix? hexadecimalFloatingConstant = hexadecimalPrefix hexadecimalFractionalConstant binaryExponentPart floatingSuffix? | hexadecimalPrefix hexadecimalDigitSequence binaryExponentPart floatingSuffix? fractionalConstant = digitSequence '.' digitSequence? | '.' digitSequence exponentPart = [eE] [-+]? digitSequence digitSequence = digit+ hexadecimalFractionalConstant = hexadecimalDigitSequence '.' hexadecimalDigitSequence? | '.' hexadecimalDigitSequence binaryExponentPart = [pP] [-+]? digitSequence hexadecimalDigitSequence = hexadecimalDigit+ floatingSuffix = [fFlL] imaginarySuffix? # 6.4.4.4 characterConstant = < "'" cCharSequence "'" > { $$ = new_C_char(yytext) } - | < "L'" cCharSequence "'" > { $$ = new_C_char(yytext) } - cCharSequence = ( escapeSequence | !EOL [^\'\\] )* escapeSequence = simpleEscapeSequence | octalEscapeSequence | hexadecimalEscapeSequence | universalCharacterName | '\\' EOL | '\\' Blank+ EOL &{gnu} | '\\' . &{gnu} simpleEscapeSequence = '\\'([\'\"?\\abfnrtv] | 'e' &{gnu}) octalEscapeSequence = '\\' octalDigit octalDigit? octalDigit? hexadecimalEscapeSequence = '\\x' hexadecimalDigit+ #|### A.1.6 String literals #| #|# 6.4.5 #| #|stringLiteral = { $$= listBegin() } #| ( s:stringLiteralPart { listAppend(s) } #| )+ { $$= newString(listEnd()) } #| #|stringLiteralPart = < '"' sCharSequence '"' > { $$= newText(yytext) } - #| | < 'L''"' sCharSequence '"' > { $$= newText(yytext) } - #| #|sCharSequence = ( escapeSequence | !EOL [^\"\\] )* #| #|### A.2.1 Expressions #| #|# 6.5.1 #| #|primaryExpression = stringLiteral | constant | id #| | l:LPAREN x:expression r:RPAREN { $$= newSubexpr(l, x, r) } #| | l:LPAREN x:compoundStatement r:RPAREN &{gnu} { $$= newSubexpr(l, x, r) } #| #|# 6.5.2 #| #|postfixExpression = o:LPAREN l:typeName p:RPAREN #| a:LCURLY r:initializerList ( c:COMMA | {c=0} ) b:RCURLY { $$= newAggregate(o, l, p, a, r, c, b) } #| | l:primaryExpression #| ( o:LBRACKET r:expression p:RBRACKET { l= newIndex(l, o, r, p) } #| | o:LPAREN r:argumentExpressionList p:RPAREN { l= newCall(l, o, r, p) } #| | o:DOT r:id { l= newBinary(l, o, r) } #| | o:PTR r:id { l= newBinary(l, o, r) } #| | o:INC { l= newPostfix(l, o) } #| | o:DEC { l= newPostfix(l, o) } #| )* { $$= l } #| #|argumentExpressionList = { listBegin() } #| ( x:assignmentExpression { listAppend(x) } #| ( c:COMMA x:assignmentExpression { listAppend2(c, x) } #| )* #| )? { $$= listEnd() } #| #|# 6.5.3 #| #|unaryExpression = o:INC x:unaryExpression { $$= newPrefix(o, x) } #| | o:DEC x:unaryExpression { $$= newPrefix(o, x) } #| | o:unaryOperator x:castExpression { $$= newUnary(o, x) } #| | s:SIZEOF ( l:LPAREN t:typeName r:RPAREN { $$= newSizeof(s, l, t, r) } #| | x:unaryExpression { $$= newSizeof(s, 0, x, 0) } #| ) #| | s:ALIGNOF ( l:LPAREN t:typeName r:RPAREN { $$= newAlignof(s, l, t, r) } #| | x:unaryExpression { $$= newAlignof(s, 0, x, 0) } #| ) &{gnu} #| | asmExpr &{gnu} #| | postfixExpression #| #|unaryOperator = BAND | STAR | PLUS | MINUS | BNOT | LNOT #| | LAND &{gnu} #| | REAL &{gnu} #| | IMAG &{gnu} #| #|# 6.5.4 #| #|castExpression = l:LPAREN t:typeName r:RPAREN x:castExpression { $$= newCast(l, t, r, x) } #| | unaryExpression #| #|# 6.5.5 #| #|multiplicativeExpression = l:castExpression #| ( o:multiplicativeOperator r:castExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|multiplicativeOperator = STAR | DIV | MOD #| #|# 6.5.6 #| #|additiveExpression = l:multiplicativeExpression #| ( o:additiveOperator r:multiplicativeExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|additiveOperator = PLUS | MINUS #| #|# 6.5.7 #| #|shiftExpression = l:additiveExpression #| ( o:shiftOperator r:additiveExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|shiftOperator = LSHIFT | RSHIFT #| #|# 6.5.8 #| #|relationalExpression = l:shiftExpression #| ( o:relationalOperator r:shiftExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|relationalOperator = LT | LTE | GT | GTE #| #|# 6.5.9 #| #|equalityExpression = l:relationalExpression #| ( o:equalityOperator r:relationalExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|equalityOperator = EQUAL | NOT_EQUAL #| #|# 6.5.10 #| #|andExpression = l:equalityExpression #| ( o:BAND r:equalityExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|# 6.5.11 #| #|exclusiveOrExpression = l:andExpression #| ( o:BXOR r:andExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|# 6.5.12 #| #|inclusiveOrExpression = l:exclusiveOrExpression #| ( o:BOR r:exclusiveOrExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|# 6.5.13 #| #|logicalAndExpression = l:inclusiveOrExpression #| ( o:LAND r:inclusiveOrExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|# 6.5.14 #| #|logicalOrExpression = l:logicalAndExpression #| ( o:LOR r:logicalAndExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|# 6.5.15 #| #|conditionalExpression = l:logicalOrExpression #| ( q:QUESTION m:expression c:COLON r:conditionalExpression { $$= newConditional(l, q, m, c, r) } #| | q:QUESTION c:COLON r:conditionalExpression &{gnu} { $$= newConditional(l, q, 0, c, r) } #| | { $$= l } #| ) #| #|# 6.5.16 #| #|assignmentExpressionOpt = assignmentExpression | {$$=0} #| #|assignmentExpression = l:unaryExpression o:assignmentOperator r:assignmentExpression { $$= newBinary(l, o, r) } #| | conditionalExpression #| #|assignmentOperator = ASSIGN #| | STAR_ASSIGN | DIV_ASSIGN | MOD_ASSIGN | PLUS_ASSIGN | MINUS_ASSIGN #| | LSHIFT_ASSIGN | RSHIFT_ASSIGN | BAND_ASSIGN | BXOR_ASSIGN | BOR_ASSIGN #| #|# 6.5.17 #| #|expression = l:assignmentExpression #| ( o:COMMA r:assignmentExpression { l= newBinary(l, o, r) } #| )* { $$= l } #| #|expressionOpt = expression | { $$= 0 } #| #|constantExpression = conditionalExpression #| #|### A.2.2 Declarations #| #|# 6.7 #| declaration = @{ C_declarationBegin() } ( s:declarationSpecifiers d:initDeclaratorListOpt t:SEMI { $$= new_C_declaration(s, d, t) } @{ C_declarationEnd() } | &{ C_declarationAbort() } ) declarationSpecifiers = @{ int specified= 0 } { listBegin() } ( s:storageClassSpecifier { listAppend(s) } | s:typeSpecifier @{ specified++ } { listAppend(s) } #| | s:typedefName &{ !specified++ } { listAppend(s) } #| | s:typeQualifier { listAppend(s) } #| | s:functionSpecifier { listAppend(s) } )+ { $$= listEnd() } | &{gnu} { $$= listEmpty() } #|initDeclaratorListOpt = initDeclaratorList | { $$= 0 } initDeclaratorListOpt = { $$= listEmpty() } #|initDeclaratorList = d:initDeclarator { listWith(d) } #| ( c:COMMA d:initDeclarator { listAppend2(c, d) } #| )* { $$= listEnd() } #| #|initDeclarator = d:declarator #| ( a:ASSIGN i:initializer { d= newBinary(d, a, i) } #| )? { $$= d } #| #|# 6.7.1 storageClassSpecifier = TYPEDEF @{ declarationTypedef() } | AUTO #| | parameterStorageClassSpecifier #| | functionStorageClassSpecifier #| #|parameterStorageClassSpecifier = REGISTER #| #|functionStorageClassSpecifier = EXTERN | STATIC #| #|# 6.7.2 typeSpecifier = VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE | SIGNED | UNSIGNED | BOOL | COMPLEX #| | structOrUnionSpecifier #| | enumSpecifier #| # Any list of specifiers and qualifiers at the start of a declaration may contain attribute specifiers #| | attributeSpecifier &{gnu} #| #|# 6.7.2.1 #| #|structOrUnionSpecifier = s:structOrUnion #| # An attribute specifier list may appear as part of a struct, union or enum specifier. It may go #| # either immediately after the struct, union or enum keyword... #| ( a:attributeSpecifiers &{gnu} | {a=0} ) #| ( i:idOpt ( @{ scopeBegin() } #| l:LCURLY d:structDeclarationList r:RCURLY #| @{ scopeEnd() } #| | &{ scopeAbort() } #| ) #| # ..., or after the closing brace. #| ( b:attributeSpecifiers &{gnu} | {b=0} ) #| | i:id {l=d=r=b=0} #| ) { $$= newStructSpec(s, a, i, l, d, r, b) } #| #|structOrUnion = STRUCT | UNION #| #|structDeclarationList = d:structDeclaration { listWith(d) } #| ( d:structDeclaration { listAppend(d) } #| )* { $$= listEnd() } #| | &{gnu} { $$= 0 } #| #|structDeclaration = s:specifierQualifierList d:structDeclaratorList t:SEMI #| ( &SEMI { listWith(t) } #| ( t:SEMI { listAppend(t) } #| )* &{gnu} { t= listEnd() } #| )? { $$= newDeclaration(s, d, t) } #| #|specifierQualifierList = @{ int specified= 0 } { listBegin() } #| ( ( t:typeSpecifier @{ specified++ } #| | t:typedefName &{ !specified++ } #| | t:typeQualifier #| ) { listAppend(t) } #| )+ { $$= listEnd() } #| #|structDeclaratorList = d:structDeclarator { listWith(d) } #| ( c:COMMA d:structDeclarator { listAppend2(c, d) } #| )* { $$= listEnd() } #| | &{gnu} { $$= 0 } #| #|structDeclarator = ( c:COLON e:constantExpression { d= newStructDeclarator(0, c, e) } #| | d:declarator ( c:COLON e:constantExpression | {c=e=0} ) { d= newStructDeclarator(d, c, e) } #| ) #| # An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier #| ( a:attributeSpecifiers { d= newAttribution(d, a) } #| )? { $$= d } #| #|# 6.7.2.2 #| #|enumSpecifier = e:ENUM #| ( i:idOpt l:LCURLY m:enumeratorList r:RCURLY { $$= newEnumSpec(e, i, l, m, r) } #| | i:id { $$= newEnumSpec(e, i, 0, 0, 0) } #| ) #| #|enumeratorList = e:enumerator { listWith(e) } #| ( c:COMMA e:enumerator { listAppend(c); listAppend(e) } #| )* #| ( c:COMMA { listAppend(c) } #| )? { $$= listEnd() } #| #|enumerator = i:id #| # an attribute specifier list may appear as part of an enumerator. The attribute goes after the #| # enumeration constant, before =, if present. #| ( a:attributeSpecifier &{gnu} { i= newAttribution(i, a) } #| )* #| ( a:ASSIGN e:constantExpression | {a=e=0} ) { $$= newEnumerator(i, a, e) } #| #|# 6.7.3 #| #|typeQualifier = CONST | RESTRICT | VOLATILE #| #|# 6.7.4 #| #|functionSpecifier = INLINE #| #|# 6.7.5 #| #|declarator = # An attribute specifier list may appear immediately before a declarator #| a:attributeSpecifier d:declarator &{gnu} { $$= newAttribution(a, d) } #| | p:STAR q:typeQualifierList d:declarator { $$= newDeref(p, q, d) } #| | p:BXOR q:typeQualifierList d:declarator &{apl} { $$= newBlock(p, q, d) } #| | ( d:directDeclarator #| # An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier #| ( &{gnu} a:attributeSpecifier { d= newAttribution(d, a) } #| # an asm (or __asm__) keyword may appear after the declarator #| | &{gnu} a:asm { d= newAttribution(d, a) } #| )* #| ) { $$= d } #| #|directDeclarator = ( l:LPAREN d:declarator r:RPAREN { d= newSubexpr(l, d, r) } #| | &( @{ declarationId(yytext) } ) #| d:id #| ) ( @{ scopeBegin() } #| ( l:LPAREN p:parameterTypeList r:RPAREN { d= newCall (d, l, p, r) } #| @{ scopeEnd() } #| | l:LPAREN p:identifierListOpt r:RPAREN { d= newCall (d, l, p, r) } #| @{ scopeEnd() } #| | l:LBRACKET ( s:STATIC q:typeQualifierListOpt {t=0} e:assignmentExpression #| | {s=0} q:typeQualifierList t:STATIC e:assignmentExpressionOpt #| | {s=0} q:typeQualifierListOpt t:STAR {e=0} #| | {s=0} q:typeQualifierListOpt {t=0} e:assignmentExpressionOpt ) r:RBRACKET { d= newArray(d, l, s, q, t, e, r) } #| @{ scopeEnd() } #| | &{ scopeAbort() } #| ) #| )* { $$= d } #| #|typeQualifierListOpt = typeQualifierList | {$$=0} #| #|typeQualifierList = { listBegin() } #| ( t:typeQualifier { listAppend(t) } #| )* { $$= listEnd() } #| #|parameterTypeListOpt = parameterTypeList | {$$=0} #| #|parameterTypeList = p:parameterList #| ( c:COMMA v:ELLIPSIS { List_addLast(p, c); List_addLast(p, v) } #| )? { $$= p } #| #|parameterList = p:parameterDeclaration { listWith(p) } #| ( ( c:COMMA | c:SEMI &{gnu} ) { listAppend(c) } #| p:parameterDeclaration { listAppend(p) } #| )* { $$= listEnd() } #| #|parameterDeclaration = s:parameterDeclarationSpecifiers #| ( d:declarator | d:abstractDeclaratorOpt ) { $$= newParameter(s, d) } #| #|parameterDeclarationSpecifiers #| = @{ int specified= 0 } { listBegin() } #| ( s:parameterStorageClassSpecifier { listAppend(s) } #| | s:typeSpecifier @{ specified++ } { listAppend(s) } #| | s:typedefName &{ !specified++ } { listAppend(s) } #| | s:typeQualifier { listAppend(s) } #| | s:functionSpecifier { listAppend(s) } #| )+ { $$= listEnd() } #| #|identifierListOpt = identifierList | {$$=0} #| #|identifierList = i:id { listWith(i) } #| ( c:COMMA i:id { listAppend2(c, i) } #| )* { $$= listEnd() } #| #|# 6.7.6 #| #|typeName = s:specifierQualifierList d:abstractDeclaratorOpt { $$= newDeclaration(s, d, 0) } #| #|abstractDeclaratorOpt = abstractDeclarator | {$$=0} #| #|abstractDeclarator = p:STAR q:typeQualifierList d:abstractDeclaratorOpt { $$= newDeref(p, q, d) } #| | p:BXOR q:typeQualifierList d:abstractDeclaratorOpt &{apl} { $$= newBlock(p, q, d) } #| | directAbstractDeclarator #| #|directAbstractDeclarator= @{int nonEmpty= 0} #| ( l:LPAREN d:abstractDeclarator r:RPAREN @{++nonEmpty} { d= newSubexpr(l, d, r) } #| | {d=0} #| ) ( l:LPAREN p:parameterTypeListOpt r:RPAREN @{++nonEmpty} { d= newCall (d, l, p, r) } #| | l:LBRACKET #| ( s:STATIC q:typeQualifierListOpt {t=0} e:assignmentExpression #| | {s=0} q:typeQualifierList t:STATIC e:assignmentExpressionOpt #| | {s=0} q:typeQualifierListOpt t:STAR {e=0} #| | {s=0} q:typeQualifierListOpt {t=0} e:assignmentExpressionOpt #| ) r:RBRACKET @{++nonEmpty} { d= newArray(d, l, s, q, t, e, r) } #| )* &{nonEmpty} { $$= d } #| #|# 6.7.7 #| #|typedefName = &{ isTypedefName(yytext) } { $$= newId(yytext) } - #| | t:TYPEOF l:LPAREN #| ( x:expression r:RPAREN { $$= newTypeof(t, l, 0, x, r) } #| | x:typeName r:RPAREN { $$= newTypeof(t, l, x, 0, r) } #| ) &{gnu} #| #|# 6.7.8 #| #|initializer = l:LCURLY i:initializerList ( c:COMMA | {c=0} ) r:RCURLY { $$= newInitializer(l, i, c, r) } #| | assignmentExpression #| #|initializerList = { listBegin() } #| ( d:designation { listAppend(d) } #| )? i:initializer { listAppend(i) } #| ( c:COMMA { listAppend(c) } #| ( d:designation { listAppend(d) } #| )? i:initializer { listAppend(i) } #| )* { $$= listEnd() } #| | &{gnu} { $$= 0 } #| #|designation = ( d:designatorList ( a:ASSIGN | {a=0} &{gnu} ) #| | d:id a:COLON &{gnu} #| ) { $$= newDesignation(d, a) } #| #|designatorList = { listBegin() } #| ( l:LBRACKET x:constantExpression r:RBRACKET { listAppend(newIndex(0, l, x, r)) } #| | l:LBRACKET x:constantRange r:RBRACKET &{gnu} { listAppend(newIndex(0, l, x, r)) } #| | l:DOT x:id { listAppend(newBinary(0, l, x)) } #| )+ { $$= listEnd() } #| #|### A.2.3 Statements #| #|# 6.8 #| #|statement = expressionStatement #| | labeledStatement #| | compoundStatement #| | selectionStatement #| | iterationStatement #| | jumpStatement #| #|# 6.8.1 #| #|labeledStatement = i:id c:COLON #| # an attribute specifier list may appear after the colon following a label, other than a case or default label #| ( a:attributeSpecifiers &{gnu} | {a=0} ) #| s:statement { $$= newLabel(i, c, a, s) } #| | c:CASE x:constantExpression d:COLON s:statement { $$= newCase(c, x, d, s) } #| | c:CASE x:constantRange d:COLON s:statement &{gnu} { $$= newCase(c, x, d, s) } #| | d:DEFAULT c:COLON s:statement { $$= newDefault(d, c, s) } #| #|# 6.8.2 #| #|compoundStatement = @{ scopeBegin() } #| l:LCURLY { listBegin() } #| ( x:localLabelDeclaration &{gnu} { listAppend(x) } #| )* #| ( x:declaration { listAppend(x) } #| | x:statement { listAppend(x) } #| | x:functionDefinition &{gnu} { listAppend(x) } #| | !'}' &{ errmsg= "statement expected" } error #| )* { x= listEnd() } #| r:RCURLY { $$= newCompound(l, x, r) } #| @{ scopeEnd() } #| | &{ scopeAbort() } #| #|# 6.8.3 #| #|expressionStatement = SEMI #| | x:expression s:SEMI { $$= newExprStatement(x, s) } #| #|# 6.8.4 #| #|selectionStatement = i:IF l:LPAREN x:expression r:RPAREN s:statement #| ( e:ELSE t:statement | {e=t=0} ) { $$= newIf(i, l, x, r, s, e, t) } #| | s:SWITCH l:LPAREN x:expression r:RPAREN t:statement { $$= newSwitch(s, l, x, r, t) } #| #|# 6.8.5 #| #|iterationStatement = w:WHILE l:LPAREN x:expression r:RPAREN s:statement { $$= newWhile(w, l, x, r, s) } #| | d:DO s:statement w:WHILE l:LPAREN x:expression r:RPAREN t:SEMI { $$= newDo(d, s, w, l, x, r, t) } #| | f:FOR l:LPAREN a:expressionOpt t:SEMI b:expressionOpt u:SEMI #| c:expressionOpt r:RPAREN s:statement { $$= newFor(f, l, a, t, b, u, c, r, s) } #| | f:FOR l:LPAREN a:declaration b:expressionOpt u:SEMI #| c:expressionOpt r:RPAREN s:statement { $$= newFor(f, l, a, 0, b, u, c, r, s) } #| #|# 6.8.6 #| #|jumpStatement = g:GOTO i:id t:SEMI { $$= newGoto(g, 0, i, t) } #| | c:CONTINUE t:SEMI { $$= newContinue(c, t) } #| | b:BREAK t:SEMI { $$= newBreak(b, t) } #| | r:RETURN x:expressionOpt t:SEMI { $$= newReturn(r, x, t) } #| | g:GOTO s:STAR x:expression t:SEMI &{gnu} { $$= newGoto(g, s, x, t) } #| #|### A.2.4 External definitions #| #|# 6.9 #| #|translationUnit = externalDeclaration+ #| externalDeclaration = { yylval = newComment(yytext); } | ( SEMI &{gnu} | c:constant { yylval = c; } #################| TODO | declaration #| | functionDefinition #| | meta | &. &{ errmsg= "declaration expected" } error ) { yylval= $$; } #|functionDefinition = @{ declarationBegin() } #| ( s:functionDeclarationSpecifiers | &{gnu} {s=0} ) #| d:declarator #| l:declarationListOpt #| c:compoundStatement { $$= newFunctionDefinition(s, d, l, c) } #| @{ declarationEnd() } #| | &{ declarationAbort() } #| #|functionDeclarationSpecifiers #| = @{ int specified= 0 } { listBegin() } #| ( s:functionStorageClassSpecifier { listAppend(s) } #| | s:typeSpecifier @{ ++specified } { listAppend(s) } #| | &{ !specified } s:typedefName @{ ++specified } { listAppend(s) } #| | s:typeQualifier { listAppend(s) } #| | s:functionSpecifier { listAppend(s) } #| )+ { $$= listEnd() } #| #|declarationListOpt = declarationList | {$$=0} #| #|declarationList = d:declaration { $$= listWith(d) } #| ( d:declaration { listAppend(d) } #| )* { $$= listEnd() } #| #|### GNU C extensions #| #|# An attribute specifier is of the form __attribute__ ((attribute-list)). An attribute list is a #|# possibly empty comma-separated sequence of attributes #| #|attributeSpecifier = a:ATTRIBUTE ll:LPAREN lr:LPAREN { listBegin() } #| ( b:attribute { listAppend(b) } #| )? ( c:COMMA { listAppend(c) } #| ( b:attribute { listAppend(b) } #| )? )* rl:RPAREN rr:RPAREN { $$= newAttributeSpec(a, ll, lr, listEnd(), rl, rr) } #| #|attributeSpecifiers = &ATTRIBUTE { listBegin() } #| a:attributeSpecifier { listAppend(a) } #| ( a:attributeSpecifier { listAppend(a) } #| )* { $$= listEnd() } #| #|# where each attribute is one of the following: #|# Empty. Empty attributes are ignored. #|# An attribute name (which may be an identifier such as unused, or a reserved word such as const). #|# An attribute name followed by a parenthesized list of parameters for the attribute. These parameters take one of the following forms: #|# An identifier. For example, mode attributes use this form. #|# An identifier followed by a comma and a non-empty comma-separated list of expressions. For example, format attributes use this form. #|# A possibly empty comma-separated list of expressions. For example, format_arg attributes use this #|# form with the list being a single integer constant expression, and alias attributes use #|# this form with the list being a single string constant. #| #|attribute = n:name ( l:LPAREN { listBegin() } #| ( p:expression { listAppend(p) } #| ( p:COMMA { listAppend(p) } #| p:expression { listAppend(p) } #| )* #| )? #| r:RPAREN { p= listEnd() } #| | {l=p=r=0} #| ) { $$= newAttribute(n, l, p, r) } #| #|constantRange = a:constantExpression e:ELLIPSIS b:constantExpression { $$= newRange(a, e, b) } #| #|localLabelDeclaration = l:LABEL &{gnu} { listBegin() } #| i:id { listAppend(i) } #| ( c:COMMA i:id { listAppend2(c, i) } #| )* #| ( c:COMMA { listAppend(c) } #| )? #| s:SEMI { $$= newLabelDeclaration(l, listEnd(), s) } #| #|asm = a:ASM l:LPAREN s:stringLiteral r:RPAREN { $$= newAsm(a, l, s, r) } #| #|asmExpr = a:ASM ( v:VOLATILE | {v=0} ) ( g:GOTO | {g=0} ) #| l:LPAREN s:stringLiteral { listBegin() } #| ( c:COLON { listAppend(c) } #| ( p:asmExprArgs { listAppend(p) } #| )? #| ( c:COLON { listAppend(c) } #| ( p:asmExprArgs { listAppend(p) } #| )? #| ( c:COLON { listAppend(c) } #| ( p:stringLiteralList { listAppend(p) } #| )? #| ( c:COLON { listAppend(c) } #| ( p:ids { listAppend(p) } #| )? #| )? #| )? #| )? #| )? #| r:RPAREN { $$= newAsmExpr(a, v, g, l, s, listEnd(), r) } #| #|asmExprArgs = a:asmExprArg { listWith(a) } #| ( c:COMMA a:asmExprArg { listAppend2(c, a) } #| )* { $$= listEnd() } #| #|asmExprArg = s:stringLiteral ( l:LPAREN e:expression r:RPAREN | {l=e=r=0} ){ $$= newAsmExprArg(s, l, e, r) } #| #|stringLiteralList = s:stringLiteral { listWith(s) } #| ( c:COMMA s:stringLiteral { listAppend2(c, s) } #| )* { $$= listEnd() } #| #|ids = i:id { listWith(i) } #| ( c:COMMA i:id { listAppend2(c, i) } #| )* { $$= listEnd() } - = < Space* > { if (yyleng && $$) setComment($$, newComment(yytext)) } Space = Blank | Comment | EOL | Directive | "__extension__" &{gnu} { icol += 13 } Blank = ( [\003-\010] | '\013' | '\f' | [\016-\037] | [\177-\377] | ' ' ) { ++icol } | '\t' { icol= (icol + 8) & ~7 } EOL = ( "\r\n" | '\n' | '\r' ) { ++irow; icol= 0 } Comment = "/*" ( !"*/" (EOL | Any) )* "*/" | "//" ( ![\n\r] Any )* EOL Directive = "#" (!EOL .)* Any = . { ++icol } ### ASSIGN = '=' !'=' { $$= newToken("=" ) } - COLON = ':' { $$= newToken(":" ) } - COMMA = ',' { $$= newToken("," ) } - QUESTION = '?' { $$= newToken("?" ) } - SEMI = ';' { $$= newToken(";" ) } - PTR = "->" { $$= newToken("->" ) } - DOT = '.' !'.' { $$= newToken("." ) } - ELLIPSIS = '...' { $$= newToken("..." ) } - LPAREN = '(' { $$= newToken("(" ) } - RPAREN = ')' { $$= newToken(")" ) } - LBRACKET = '[' { $$= newToken("[" ) } - RBRACKET = ']' { $$= newToken("]" ) } - LCURLY = '{' { $$= newBegin( ) } - RCURLY = '}' { $$= newEnd ( ) } - EQUAL = "==" { $$= newToken("==" ) } - NOT_EQUAL = "!=" { $$= newToken("!=" ) } - LTE = "<=" { $$= newToken("<=" ) } - LT = "<" !'=' { $$= newToken("<" ) } - GTE = ">=" { $$= newToken(">=" ) } - GT = ">" !'=' { $$= newToken(">" ) } - DIV = '/' ![=*] { $$= newToken("/" ) } - DIV_ASSIGN = "/=" { $$= newToken("/=" ) } - PLUS = '+' ![+=] { $$= newToken("+" ) } - PLUS_ASSIGN = "+=" { $$= newToken("+=" ) } - INC = "++" { $$= newToken("++" ) } - MINUS = '-' ![-=] { $$= newToken("-" ) } - MINUS_ASSIGN = "-=" { $$= newToken("-=" ) } - DEC = "--" { $$= newToken("--" ) } - STAR = '*' !'=' { $$= newToken("*" ) } - STAR_ASSIGN = "*=" { $$= newToken("*=" ) } - MOD = '%' !'=' { $$= newToken("%" ) } - MOD_ASSIGN = "%=" { $$= newToken("%=" ) } - RSHIFT = ">>" !'=' { $$= newToken(">>" ) } - RSHIFT_ASSIGN = ">>=" { $$= newToken(">>=" ) } - LSHIFT = "<<" !'=' { $$= newToken("<<" ) } - LSHIFT_ASSIGN = "<<=" { $$= newToken("<<=" ) } - LAND = "&&" { $$= newToken("&&" ) } - LNOT = '!' !'=' { $$= newToken("!" ) } - LOR = "||" { $$= newToken("||" ) } - BAND = '&' ![&=] { $$= newToken("&" ) } - BAND_ASSIGN = "&=" { $$= newToken("&=" ) } - BNOT = '~' { $$= newToken("~" ) } - BOR = '|' ![|=] { $$= newToken("|" ) } - BOR_ASSIGN = "|=" { $$= newToken("|=" ) } - BXOR = '^' !'=' { $$= newToken("^" ) } - BXOR_ASSIGN = "^=" { $$= newToken("^=" ) } - ALIGNOF = '__alignof__' !IDREST { $$= newToken("__alignof__" ) } - | '__alignof' !IDREST { $$= newToken("__alignof" ) } - ASM = 'asm' !IDREST { $$= newToken("asm" ) } - | '__asm' !IDREST { $$= newToken("__asm" ) } - | '__asm__' !IDREST { $$= newToken("__asm__" ) } - ATTRIBUTE = '__attribute__' !IDREST { $$= newToken("__attribute__") } - AUTO = 'auto' !IDREST { $$= newToken("auto" ) } - BOOL = '_Bool' !IDREST { $$= newToken("_Bool" ) } - BREAK = 'break' !IDREST { $$= newToken("break" ) } - CASE = 'case' !IDREST { $$= newToken("case" ) } - CHAR = 'char' !IDREST { $$= newToken("char" ) } - COMPLEX = '_Complex' !IDREST { $$= newToken("_Complex" ) } - | '__complex__' !IDREST &{gnu} { $$= newToken("__complex__" ) } - CONST = 'const' !IDREST { $$= newToken("const" ) } - | '__const' !IDREST { $$= newToken("__const" ) } - CONTINUE = 'continue' !IDREST { $$= newToken("continue" ) } - DEFAULT = 'default' !IDREST { $$= newToken("default" ) } - DO = 'do' !IDREST { $$= newToken("do" ) } - DOUBLE = 'double' !IDREST { $$= newToken("double" ) } - ELSE = 'else' !IDREST { $$= newToken("else" ) } - ENUM = 'enum' !IDREST { $$= newToken("enum" ) } - EXTERN = 'extern' !IDREST { $$= newToken("extern" ) } - FLOAT = 'float' !IDREST { $$= newToken("float" ) } - FOR = 'for' !IDREST { $$= newToken("for" ) } - GOTO = 'goto' !IDREST { $$= newToken("goto" ) } - IF = 'if' !IDREST { $$= newToken("if" ) } - INLINE = 'inline' !IDREST { $$= newToken("inline" ) } - | '__inline__' !IDREST &{gnu} { $$= newToken("__inline__" ) } - INT = 'int' !IDREST { $$= newToken("int" ) } - LONG = 'long' !IDREST { $$= newToken("long" ) } - REGISTER = 'register' !IDREST { $$= newToken("register" ) } - RESTRICT = 'restrict' !IDREST { $$= newToken("restrict" ) } - RETURN = 'return' !IDREST { $$= newToken("return" ) } - SHORT = 'short' !IDREST { $$= newToken("short" ) } - SIGNED = 'signed' !IDREST { $$= newToken("signed" ) } - SIZEOF = 'sizeof' !IDREST { $$= newToken("sizeof" ) } - STATIC = 'static' !IDREST { $$= newToken("static" ) } - STRUCT = 'struct' !IDREST { $$= newToken("struct" ) } - SWITCH = 'switch' !IDREST { $$= newToken("switch" ) } - TYPEDEF = 'typedef' !IDREST { $$= newToken("typedef" ) } - TYPEOF = 'typeof' !IDREST { $$= newToken("typeof" ) } - | '__typeof__' !IDREST { $$= newToken("__typeof__" ) } - UNION = 'union' !IDREST { $$= newToken("union" ) } - UNSIGNED = 'unsigned' !IDREST { $$= newToken("unsigned" ) } - VOID = 'void' !IDREST { $$= newToken("void" ) } - VOLATILE = 'volatile' !IDREST { $$= newToken("volatile" ) } - WHILE = 'while' !IDREST { $$= newToken("while" ) } - IMAG = '__imag__' !IDREST &{gnu} { $$= newToken("__imag__" ) } - LABEL = '__label__' !IDREST &{gnu} { $$= newToken("__label__") } - REAL = '__real__' !IDREST &{gnu} { $$= newToken("__real__" ) } - %% ; oop map_zip(oop map, oop keys, oop values) { assert(is(Map, map)); assert(is(Map, keys)); assert(is(Map, values)); size_t sk= map_size(keys), sv= map_size(values); if (sk < sv) sk= sv; for (size_t i= 0; i < sk; ++i) { oop key = i < sk && map_hasIntegerKey(keys, i) ? get(keys, Map, elements)[i].value : makeInteger(i); oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null; map_set(map, key, value); } return map; } oop clone(oop obj) { switch(getType(obj)) { case Undefined: case Integer: case Float: case Function: case Symbol: return obj; case String: return makeString(get(obj, String, value)); case Map: { struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity)); memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity)); oop map= malloc(sizeof(*obj)); memcpy(map, obj, sizeof(*obj)); set(map, Map, elements, elements); return map; } } return obj; } struct Call { oop ast, function; }; DECLARE_BUFFER(struct Call, CallArray); CallArray backtrace= BUFFER_INITIALISER; struct Call CallArray_pop(CallArray *oa) { assert(oa->position > 0); return oa->contents[--oa->position]; } void trace(oop ast, oop func) { CallArray_append(&backtrace, (struct Call){ ast, func }); } void untrace(oop ast) { struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast); } void printLocation(oop ast) { fflush(stdout); if (!is(Map, ast)) return; char *fileName = get (map_get(ast, __file___symbol), String, value); int lineNumber = getInteger(map_get(ast, __line___symbol) ); fprintf(stderr, "%s:%i", fileName, lineNumber); } void printlnLocation(oop ast) { fflush(stdout); if (!is(Map, ast)) return; printLocation(ast); fprintf(stderr, "\n"); } void printBacktrace(oop top) { fflush(stdout); printLocation(top); while (CallArray_position(&backtrace) > 0) { struct Call call= CallArray_pop(&backtrace); if (is(Map, call.ast) && Call_proto == map_get(call.ast, __proto___symbol)) { oop name= get(call.function, Function, name); if (null != name) { printf(" in "); if (get(call.function, Function, primitive)) printf("primitive "); else printf("function "); println(get(call.function, Function, name)); } } else { printf("\n"); } printLocation(call.ast); } printf("\n"); } void runtimeError(char *fmt, ...) { fflush(stdout); va_list ap; va_start(ap, fmt); fprintf(stderr, "\n"); vfprintf(stderr, fmt, ap); fprintf(stderr, "\n"); va_end(ap); printBacktrace(mrAST); exit(1); } #define TYPESIG(L, R) L*NTYPES+R #define CASE(L, R) case TYPESIG(L, R) oop addOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs)); CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value)); CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs)); CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value)); CASE(String , String ): return string_concat(lhs, rhs); } runtimeError("addition between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } oop subOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs)); CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value)); CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs)); CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value)); } runtimeError("substraction between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } oop mulOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs)); CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value)); CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs)); CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value)); CASE(String , Integer): return string_mul(lhs, rhs); CASE(Integer, String ): return string_mul(rhs, lhs); } runtimeError("multiplication between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } oop divOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs)); CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value)); CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs)); CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value)); } runtimeError("division between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } oop modOperation(oop lhs, oop rhs) { switch (TYPESIG(getType(lhs), getType(rhs))) { CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs)); CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value))); } runtimeError("modulo between two incompatible types"); return NULL; // to prevent: control may reach end of non-void function } #undef TYPESIG #undef CASE #if 0 oop expandUnquotes(oop scope, oop obj) { obj = clone(obj); if (!is(Map, obj)) { return obj; } if (map_get(obj, __proto___symbol) == Unquote_proto) { return eval(scope, map_get(obj, rhs_symbol)); } for (size_t i= 0; i < map_size(obj); ++i) { struct Pair *pair= &get(obj, Map, elements)[i]; if (__proto___symbol != pair->key) { pair->value= expandUnquotes(scope, pair->value); } } return obj; } #endif oop applyOperator(oop op, oop lhs, oop rhs) { if (null != op) { assert(is(Symbol, op)); switch (get(op, Symbol, prototype)) { case t_Add: return addOperation(lhs, rhs); case t_Sub: return subOperation(lhs, rhs); case t_Mul: return mulOperation(lhs, rhs); case t_Div: return divOperation(lhs, rhs); case t_Mod: return modOperation(lhs, rhs); case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs)); case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs)); case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs)); case t_Shleft: return makeInteger(getInteger(lhs) << getInteger(rhs)); case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs)); default: { fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype)); exit(1); } } } return rhs; } oop freeScopes= 0; // pool of free scopes oop fixScope(oop scope) // prevent this scope and its parents from being recycled { assert(is(Map, scope)); oop tmp= scope; while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) { tmp->Map.flags |= MAP_ENCLOSED; tmp= map_get(tmp, __proto___symbol); } return scope; } oop newScope(oop parent) { if (0 == freeScopes) freeScopes= makeMap(); oop scope= freeScopes; assert(is(Map, scope)); freeScopes= freeScopes->Map.pool; scope->Map.size= 0; map_set(scope, __proto___symbol, parent); return scope; } void delScope(oop scope) { assert(is(Map, scope)); if (scope->Map.flags & MAP_ENCLOSED) { printf("IGNORE %p\n", scope); return; } scope->Map.pool= freeScopes; freeScopes= scope; } oop evalArgs(oop scope, oop args); oop apply(oop scope, oop this, oop func, oop args, oop ast) { assert(is(Function, func)); if (NULL != get(func, Function, primitive)) { return get(func, Function, primitive)(scope, args); } oop param = get(func, Function, param); oop localScope = newScope(get(func, Function, parentScope)); map_zip(localScope, param, args); map_set(localScope, this_symbol, this); map_set(localScope, __arguments___symbol, args); jbRecPush(); trace(ast, func); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { untrace(ast); delScope(localScope); oop result = jbs->result; jbRecPop(); return result; } case j_break: { delScope(localScope); runtimeError("break outside of a loop or switch"); } case j_continue: { delScope(localScope); runtimeError("continue outside of a loop"); } case j_throw: { untrace(ast); delScope(localScope); oop res= jbs->result; jbRecPop(); jbs->result= res; siglongjmp(jbs->jb, j_throw); } } oop result= eval(localScope, get(func, Function, body)); untrace(ast); delScope(localScope); jbRecPop(); return result; } oop eval(oop scope, oop ast) { if (opt_v > 3) { printf("EVAL: "); println(ast); } switch(getType(ast)) { case Undefined: case Integer: case Float: case String: case Function: return ast; case Symbol: return getVariable(scope, ast); case Map: break; } assert(is(Map, ast)); mrAST= ast; oop proto = map_get(ast, __proto___symbol); if (proto == null) { return ast; } // proto_number is the enum version of the proto symbol proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype); switch (proto_number) { case t_UNDEFINED: { assert(0); return 0; } case t_Map: { oop map= clone(map_get(ast, value_symbol)); for (size_t i= 0; i < map_size(map); ++i) { struct Pair *pair= &get(map, Map, elements)[i]; pair->value= eval(scope, pair->value); } return map; } #if 0 case t_Quasiquote: { oop obj = map_get(ast, rhs_symbol); return expandUnquotes(scope, obj); } case t_Unquote: { runtimeError("@ outside of `"); } #endif case t_Declaration: { oop lhs = map_get(ast, lhs_symbol); oop rhs = eval(scope, map_get(ast, rhs_symbol)); return newVariable(scope, lhs, rhs); } case t_If: { oop condition = map_get(ast, condition_symbol ); oop consequent = map_get(ast, consequent_symbol); oop alternate = map_get(ast, alternate_symbol ); return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate); } case t_While: { oop condition = map_get(ast, condition_symbol ); oop body = map_get(ast, body_symbol); oop result = null; jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: case j_throw: { oop result = jbs->result; jbRecPop(); assert(jbs); jbs->result = result; siglongjmp(jbs->jb, jbt); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { break; } } while (isTrue(eval(scope, condition))) result= eval(scope, body); jbRecPop(); return result; } case t_Do: { oop body = map_get(ast, body_symbol); oop condition = map_get(ast, condition_symbol ); oop result = null; jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: case j_throw: { oop result = jbs->result; jbRecPop(); assert(jbs); jbs->result = result; siglongjmp(jbs->jb, jbt); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { goto restart_do; } } do { result= eval(scope, body); restart_do:; } while (isTrue(eval(scope, condition))); jbRecPop(); return result; } case t_For: { oop initialise = map_get(ast, initialise_symbol ); oop condition = map_get(ast, condition_symbol ); oop update = map_get(ast, update_symbol ); oop body = map_get(ast, body_symbol); oop result = null; oop localScope = newScope(scope); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: case j_throw: { delScope(localScope); oop result = jbs->result; jbRecPop(); assert(jbs); jbs->result = result; siglongjmp(jbs->jb, jbt); assert(0); } case j_break: { delScope(localScope); jbRecPop(); return result; } case j_continue: { goto restart_for; } } for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) { result= eval(localScope, body); restart_for:; } delScope(localScope); jbRecPop(); return result; } case t_ForIn: { oop expr = eval(scope, map_get(ast, expression_symbol)); if (!is(Map, expr)) return null; oop name = map_get(ast, name_symbol ) ; oop body = map_get(ast, body_symbol ) ; oop result = null; oop localScope = newScope(scope); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: case j_throw: { delScope(localScope); oop result = jbs->result; jbRecPop(); assert(jbs); jbs->result = result; siglongjmp(jbs->jb, jbt); assert(0); } case j_break: { delScope(localScope); jbRecPop(); return result; } case j_continue: { goto restart_forin; } } for (size_t i= 0; i < map_size(expr); ++i) { map_set(localScope, name, get(expr, Map, elements)[i].key); result= eval(localScope, body); restart_forin:; } delScope(localScope); jbRecPop(); return result; } case t_Switch: { oop expression = map_get(ast, expression_symbol ); oop labels = map_get(ast, labels_symbol ); oop statements = map_get(ast, statements_symbol ); oop result = eval(scope, expression); oop label = map_get(labels, result); if (null == label) label= map_get(labels, __default___symbol); if (null == label) return result; assert(isInteger(label)); int limit= map_size(statements); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: case j_throw: { oop result = jbs->result; jbRecPop(); assert(jbs); jbs->result = result; siglongjmp(jbs->jb, jbt); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { jbRecPop(); assert(jbs); siglongjmp(jbs->jb, j_continue); assert(0); } } for (int i= getInteger(label); i < limit; ++i) { assert(map_hasIntegerKey(statements, i)); result= eval(scope, get(statements, Map, elements)[i].value); } jbRecPop(); return result; } case t_Assign: { oop lhs = map_get(ast, lhs_symbol); oop op = map_get(ast, operator_symbol); oop rhs = eval(scope, map_get(ast, rhs_symbol)); if (null != op) rhs= applyOperator(op, getVariable(scope, lhs), rhs); setVariable(scope, lhs, rhs); if (is(Function, rhs) && null == get(rhs, Function, name)) { set(rhs, Function, name, lhs); } return rhs; } case t_Func: { oop name = map_get(ast, name_symbol); oop param = map_get(ast, param_symbol); oop body = map_get(ast, body_symbol); oop fixed = map_get(ast, fixed_symbol); oop func = makeFunction(NULL, name, param, body, fixScope(scope), fixed); if (opt_v > 4) { printf("funcscope: "); println(scope); printf("globalScope: "); println(scope); } if (name != null) newVariable(scope, name, func); return func; } case t_Call: { oop func = eval(scope, map_get(ast, func_symbol)); if (!is(Function, func)) { printf("\ncannot call %s\n", printString(func)); printBacktrace(ast); exit(1); } oop args = map_get(ast, args_symbol); if (isFalse(get(func, Function, fixed))) { args = evalArgs(scope, args); } return apply(scope, globals, func, args, ast); } case t_Invoke: { oop this = eval(scope, map_get(ast, this_symbol)); oop func = map_get(ast, name_symbol); assert(is(Symbol, func)); func = getVariable(this, func); if (!is(Function, func)) { printf("\ncannot invoke %s\n", printString(func)); printBacktrace(ast); exit(1); } oop args = map_get(ast, args_symbol); if (isFalse(get(func, Function, fixed))) { args = evalArgs(scope, args); } return apply(scope, this, func, args, ast); } case t_Return: { assert(jbs); jbs->result = eval(scope, map_get(ast, value_symbol)); siglongjmp(jbs->jb, j_return); } case t_Break: { assert(jbs); siglongjmp(jbs->jb, j_break); } case t_Continue: { assert(jbs); siglongjmp(jbs->jb, j_continue); } case t_Throw: { assert(jbs); jbs->result = eval(scope, map_get(ast, rhs_symbol)); siglongjmp(jbs->jb, j_throw); } case t_Try: { oop try = map_get(ast, try_symbol); oop exception = map_get(ast, exception_symbol); oop catch = map_get(ast, catch_symbol); oop finally = map_get(ast, finally_symbol); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); if (0 == jbt) { oop res = eval(scope, try); jbRecPop(); eval(scope, finally); return res; } oop res= jbs->result; jbRecPop(); // something happend in the try block if (j_throw == jbt) { assert(jbs); jbs->result= res; if (null == catch) { return eval(scope, finally); } oop localScope= newScope(scope); setVariable(localScope, exception, res); jbRecPush(); jbt= sigsetjmp(jbs->jb, 0); if (0 == jbt) { eval(localScope, catch); delScope(localScope); jbRecPop(); return eval(scope, finally); } delScope(localScope); // something happend in the catch block res= jbs->result; jbRecPop(); } eval(scope, finally); assert(jbs); jbs->result= res; siglongjmp(jbs->jb, jbt); } case t_Block: { oop statements = map_get(ast, statements_symbol); int i = 0; oop index; oop statement, res; oop localScope = newScope(scope); while ((index = makeInteger(i)), map_hasKey(statements, index)) { statement = map_get(statements, index); res = eval(localScope, statement); i++; } delScope(localScope); return res; } case t_GetVariable: { return getVariable(scope, map_get(ast, key_symbol)); } case t_GetMember: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = map_get(ast, key_symbol); return getMember(map, key); } case t_SetMember: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = map_get(ast, key_symbol); oop op = map_get(ast, operator_symbol); oop value = eval(scope, map_get(ast, value_symbol)); if (null != op) value= applyOperator(op, getProperty(map, key), value); if (is(Function, value) && null == get(value, Function, name)) { set(value, Function, name, key); } return map_set(map, key, value); } case t_GetIndex: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = eval(scope, map_get(ast, key_symbol)); switch (getType(map)) { case String: if (getInteger(key) >= get(map, String, size)) { runtimeError("GetIndex out of range on String"); } return makeInteger(unescape(get(map, String, value))[getInteger(key)]); case Map: return getVariable(map, key); default: runtimeError("GetIndex on non Map or String"); } } case t_SetIndex: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = eval(scope, map_get(ast, key_symbol)); oop op = map_get(ast, operator_symbol); oop value = eval(scope, map_get(ast, value_symbol)); switch (getType(map)) { case String: if (getInteger(key) >= get(map, String, size)) { runtimeError("SetIndex out of range on String"); } get(map, String, value)[getInteger(key)] = getInteger(value); return value; case Map: if (null != op) value= applyOperator(op, map_get(map, key), value); return map_set(map, key, value); default: runtimeError("SetIndex on non Map or String"); } } case t_Symbol: case t_Integer: case t_Float: case t_String: { return map_get(ast, value_symbol); } case t_Logor: { oop lhs = map_get(ast, lhs_symbol); oop rhs = map_get(ast, rhs_symbol); if (isTrue(eval(scope, lhs))) return makeInteger(1); if (isTrue(eval(scope, rhs))) return makeInteger(1); return makeInteger(0); } case t_Logand: { oop lhs = map_get(ast, lhs_symbol); oop rhs = map_get(ast, rhs_symbol); if (isFalse(eval(scope, lhs))) return makeInteger(0); if (isFalse(eval(scope, rhs))) return makeInteger(0); return makeInteger(1); } # define RELATION(NAME, OPERATOR) \ case t_##NAME: { \ oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return makeInteger(oopcmp(lhs, rhs) OPERATOR 0); \ } # define BINARY(NAME, OPERATOR) \ case t_##NAME: { \ oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \ } # define BINARYOP(NAME, FUNCPREFIX) \ case t_##NAME: { \ oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return FUNCPREFIX##Operation(lhs, rhs); \ } BINARY(Bitor, | ); BINARY(Bitxor, ^ ); BINARY(Bitand, & ); RELATION(Equal, ==); RELATION(Noteq, !=); RELATION(Less, < ); RELATION(Lesseq, <=); RELATION(Greatereq, >=); RELATION(Greater, > ); BINARY(Shleft, <<); BINARY(Shright, >>); BINARYOP(Add, add); BINARYOP(Mul, mul); BINARYOP(Sub, sub); BINARYOP(Div, div); BINARYOP(Mod, mod); # undef BINARYOP # undef BINARY # undef RELATION case t_Not: { oop rhs = eval(scope, map_get(ast, rhs_symbol)); return makeInteger(isFalse(rhs)); } # define UNARY(NAME, OPERATOR) \ case t_##NAME: { \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return makeInteger(OPERATOR getInteger(rhs)); \ } UNARY(Neg, -); UNARY(Com, ~); # undef UNARY case t_PreIncVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); val= makeInteger(getInteger(val) + 1); return setVariable(scope, key, val); } case t_PreDecVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); val= makeInteger(getInteger(val) - 1); return setVariable(scope, key, val); } case t_PreIncMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); val= makeInteger(getInteger(val) + 1); return map_set(map, key, val); } case t_PreDecMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); val= makeInteger(getInteger(val) - 1); return map_set(map, key, val); } case t_PreIncIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); val= makeInteger(getInteger(val) + 1); return map_set(map, key, val); } case t_PreDecIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); val= makeInteger(getInteger(val) - 1); return map_set(map, key, val); } case t_PostIncVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); oop inc= makeInteger(getInteger(val) + 1); setVariable(scope, key, inc); return val; } case t_PostDecVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); oop inc= makeInteger(getInteger(val) - 1); setVariable(scope, key, inc); return val; } case t_PostIncMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) + 1); map_set(map, key, inc); return val; } case t_PostDecMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) - 1); map_set(map, key, inc); return val; } case t_PostIncIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) + 1); map_set(map, key, inc); return val; } case t_PostDecIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) - 1); map_set(map, key, inc); return val; } } printf("EVAL "); println(ast); assert(0); return null; } oop prim_exit(oop scope, oop params) { int status= 0; if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; if (isInteger(arg)) status= getInteger(arg); } exit(status); } oop prim_keys(oop scope, oop params) { if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; if (is(Map, arg)) return map_keys(arg); } return null; } oop prim_values(oop scope, oop params) { if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; if (is(Map, arg)) return map_values(arg); } return null; } oop prim_length(oop scope, oop params) { if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; switch (getType(arg)) { case String: return makeInteger(string_size(arg)); case Symbol: return makeInteger(strlen(get(arg, Symbol, name))); case Map: return makeInteger(map_size(arg)); default: break; } } return null; } oop prim_apply(oop scope, oop params) { oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value; oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value; return apply(scope, globals, func, args, mrAST); } oop prim_invoke(oop scope, oop params) { oop this= null; if (map_hasIntegerKey(params, 0)) this= get(params, Map, elements)[0].value; oop func= null; if (map_hasIntegerKey(params, 1)) func= get(params, Map, elements)[1].value; oop args= null; if (map_hasIntegerKey(params, 2)) args= get(params, Map, elements)[2].value; return apply(scope, this, func, args, mrAST); } oop prim_clone(oop scope, oop params) { if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value); return null; } oop prim_print(oop scope, oop params) { assert(is(Map, params)); for (int i= 0; map_hasIntegerKey(params, i); ++i) { print(get(params, Map, elements)[i].value); } return params; } oop evalArgs(oop scope, oop args) { int i = 0; oop params = makeMap(); oop index; while ((index = makeInteger(i)), map_hasKey(args, index)) { map_set(params, index, eval(scope, map_get(args, index))); i++; } return params; } oop AST= NULL; void readEvalPrint(oop scope, char *fileName) { inputStackPush(fileName); input_t *top= inputStack; jbRecPush(); jb_record *jtop= jbs; int jbt= sigsetjmp(jbs->jb, 0); if (0 == jbt) { while (yyparse()) { if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber); if (!yylval) { fclose(inputStack->file); if (top == inputStack) break; inputStackPop(); assert(inputStack); continue; } // EOF if (opt_v > 1) println(yylval); oop res = eval(scope, yylval); if (opt_v > 0) println(res); assert(jbs == jtop); } assert(inputStack); inputStackPop(); jbRecPop(); return; } assert(jbs == jtop); oop res = jbs->result; jbRecPop(); switch (jbt) { case j_return: runtimeError("return outside of a function"); case j_break: runtimeError("break outside of a loop or switch"); case j_continue: runtimeError("continue outside of a loop"); case j_throw: runtimeError("unhandled exception: %s", printString(res)); } } oop prim_import(oop scope, oop params) { if (map_hasIntegerKey(params, 0)) { char *file= get(get(params, Map, elements)[0].value, String, value); if (yyctx->__pos < yyctx->__limit) { yyctx->__limit--; ungetc(yyctx->__buf[yyctx->__limit], inputStack->file); } readEvalPrint(scope, file); } return null; } oop prim_String(oop scope, oop params) { if (!map_hasIntegerKey(params, 0)) return null; return makeString(printString(get(params, Map, elements)[0].value)); } oop prim_scope(oop scope, oop params) { return fixScope(scope); } #include oop prim_microseconds(oop scope, oop params) { struct rusage ru; getrusage(RUSAGE_SELF, &ru); return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec); } int orow= 0; int ocol= 0; void outputText(char *text) { printf("%s", text); ocol += strlen(text); } void outputInt(int_t value) { ocol += printf(FMT_I, value); } void outputFloat(flt_t value) { ocol += printf(FMT_F, value); } void outputNode(oop node) { if (!node) return; switch (getType(node)) { case Undefined: return; case String: outputText(get(node, String, value)); return; case Map: break; case Integer: outputInt(getInteger(node)); return; case Float: outputFloat(getFloat(node)); return; case Symbol: outputText(get(node, Symbol, name)); return; default: fprintf(stderr, "\noutputNode: unknown node type %i\n", getType(node)); abort(); } assert(is(Map, node)); oop proto= map_get(node, __proto___symbol); if (null == proto) { // assume this is just a list of nodes size_t size= map_size(node); for (size_t i= 0; i < size; ++i) { if (!map_hasIntegerKey(node, i)) break; outputNode(get(node, Map, elements)[i].value); } return; } // proto_number is the enum version of the proto symbol proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype); switch (proto_number) { case t_Comment: outputNode(map_get(node, text_symbol)); break; case t_Token: outputNode(map_get(node, text_symbol)); break; case t_C_int: outputNode(map_get(node, text_symbol)); break; case t_C_float: outputNode(map_get(node, text_symbol)); break; case t_C_char: outputNode(map_get(node, value_symbol)); break; case t_C_id: outputNode(map_get(node, identifier_symbol)); break; case t_C_declaration: outputNode(map_get(node, specifiers_symbol)); outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_if: outputNode(map_get(node, if_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, condition_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, consequent_symbol)); outputNode(map_get(node, else_symbol)); // null if no else clause outputNode(map_get(node, alternate_symbol)); // null if no else clause break; case t_C_while: outputNode(map_get(node, while_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, statements_symbol)); break; case t_C_do: outputNode(map_get(node, do_symbol)); outputNode(map_get(node, statements_symbol)); outputNode(map_get(node, while_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_for: outputNode(map_get(node, for_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, initExpr_symbol)); outputNode(map_get(node, firstSemi_symbol)); outputNode(map_get(node, condExpr_symbol)); outputNode(map_get(node, secondSemi_symbol)); outputNode(map_get(node, incrExpr_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, statements_symbol)); break; case t_C_binary: outputNode(map_get(node, lhs_symbol)); outputNode(map_get(node, binary_symbol)); outputNode(map_get(node, rhs_symbol)); break; default: printf("I cannot print a node with proto_number %i\n", proto_number); exit(0); } #if 0 while (orow < node->row) { printf("\n"); ++orow; ocol= 0; } while (ocol < node->col) { printf(" " ); ++ocol; } #endif outputNode(map_get(node, comment_symbol)); } int main(int argc, char **argv) { # if (USE_GC) GC_INIT(); # endif symbol_table= makeMap(); globals= makeMap(); map_set(globals, intern("exit" ), makeFunction(prim_exit, intern("exit" ), null, null, globals, null)); map_set(globals, intern("keys" ), makeFunction(prim_keys, intern("keys" ), null, null, globals, null)); map_set(globals, intern("values" ), makeFunction(prim_values, intern("values" ), null, null, globals, null)); map_set(globals, intern("length" ), makeFunction(prim_length, intern("length" ), null, null, globals, null)); map_set(globals, intern("print" ), makeFunction(prim_print, intern("print" ), null, null, globals, null)); map_set(globals, intern("invoke" ), makeFunction(prim_invoke, intern("invoke" ), null, null, globals, null)); map_set(globals, intern("apply" ), makeFunction(prim_apply, intern("apply" ), null, null, globals, null)); map_set(globals, intern("clone" ), makeFunction(prim_clone, intern("clone" ), null, null, globals, null)); map_set(globals, intern("import" ), makeFunction(prim_import, intern("import" ), null, null, globals, null)); map_set(globals, intern("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null)); map_set(globals, intern("String" ), makeFunction(prim_String , intern("String" ), null, null, globals, null)); map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), null, null, globals, null)); #define _DO(NAME) NAME##_symbol=intern(#NAME); DO_SYMBOLS() #undef _DO #define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME); DO_PROTOS() #undef _DO #define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol); DO_PROTOS() #undef _DO #define _DO(NAME) map_set(globals, NAME##_symbol, NAME##_proto); DO_PROTOS() #undef _DO AST = makeMap(); map_set(globals, intern("AST"), AST); #define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto); DO_PROTOS() #undef _DO fixScope(globals); /**/ inputStackPush(NULL); while (yyparse()) { outputNode(yylval); } return 0; /**/ int repled = 0; while (argc-- > 1) { ++argv; if (!strcmp(*argv, "-g")) ++opt_g; else if (!strcmp(*argv, "-v")) ++opt_v; else if (!strcmp(*argv, "-")) { readEvalPrint(globals, NULL); repled= 1; } else { readEvalPrint(globals, *argv); repled= 1; } } if (!repled) { readEvalPrint(globals, NULL); } if (opt_g) { if (nalloc < 1024) printf("[GC: %lli bytes allocated]\n", nalloc ); else if (nalloc < 1024*1024) printf("[GC: %lli kB allocated]\n", nalloc / 1024 ); else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n", (double)nalloc / ( 1024*1024)); else printf("[GC: %.2f GB allocated]\n", (double)nalloc / (1024*1024*1024)); } return 0; (void)yyAccept; } // Local Variables: // indent-tabs-mode: nil // End: