# ccmeta.leg -- metalanguage for C # # Copyright (c) 2016-2021 Ian Piumarta and other contributors (see AUTHORS) # All rights reserved (see LICENSE) # # Last edited: 2021-08-16 18:55:57 by piumarta on DESKTOP-GMTB276 %{ /* 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_C_PROTOS() #define META_PROTO_MAX t_Try #define DO_C_PROTOS() \ _DO(Comment) _DO(Token) \ _DO(C_declaration) _DO(C_string) \ _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) _DO(C_initializer) _DO(C_range) _DO(C_conditional) _DO(C_index) \ _DO(C_designation) _DO(C_attribution) _DO(C_deref) _DO(C_block) _DO(C_call) _DO(C_subexpr) \ _DO(C_array) _DO(C_parameter) _DO(C_typeOf) _DO(C_unary) _DO(C_prefix) _DO(C_alignOf) \ _DO(C_sizeOf) _DO(C_cast) _DO(C_attributeSpec) _DO(C_asm) _DO(C_asmExpr) _DO(C_asmExprArg) \ _DO(C_aggregate) _DO(C_attribute) _DO(C_postfix) _DO(C_compound) _DO(C_functionDef) \ _DO(C_exprStatement) _DO(C_switch) _DO(C_goto) _DO(C_continue) _DO(C_break) _DO(C_return) \ _DO(C_case) _DO(C_default) _DO(C_label) _DO(C_labelDeclaration) _DO(C_structSpec) \ _DO(C_structDeclarator) _DO(C_enumSpec) _DO(C_enum) typedef enum { t_UNDEFINED=0, #define _DO(NAME) t_##NAME, DO_PROTOS() #undef _DO } proto_t; #define SYMBOL_PAYLOAD proto_t prototype; int is_C_keyword; #define DELTA 3 #include "scope.c" #include "object.c" #define DO_C_KEYWORDS() \ _DO(__alignof__) _DO(__alignof) _DO(asm) _DO(__asm) _DO(__asm__) _DO(__attribute__) _DO(auto) \ _DO(_Bool) _DO(break) _DO(case) _DO(char) _DO(_Complex) _DO(const) _DO(__const) _DO(continue) \ _DO(default) _DO(do) _DO(double) _DO(else) _DO(enum) _DO(extern) _DO(float) _DO(for) _DO(goto) \ _DO(if) _DO(inline) _DO(int) _DO(long) _DO(register) _DO(restrict) _DO(return) _DO(short) \ _DO(signed) _DO(sizeof) _DO(static) _DO(struct) _DO(switch) _DO(typedef) _DO(typeof) \ _DO(__typeof__) _DO(union) _DO(unsigned) _DO(void) _DO(volatile) _DO(while) #define DO_C_KEYWORDS_GNU() \ _DO(__complex__) _DO(__inline__) _DO(__imag__) _DO(__label__) _DO(__real__) #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(ifTok) _DO(lparen) _DO(rparen) _DO(elseTok) _DO(identifier) _DO(semicolon) \ _DO(whileTok) \ _DO(doTok) _DO(forTok) _DO(initExpr) _DO(condExpr) _DO(incrExpr) _DO(firstSemi) _DO(secondSemi) \ _DO(binary) _DO(specifiers) _DO(declarators) \ _DO(rightCurly) _DO(leftCurly) _DO(initList) _DO(comma) _DO(constExpr1) _DO(constExpr2) \ _DO(ellipsis) _DO(logicalOr) _DO(question) _DO(colon) _DO(leftBracket) _DO(rightBracket) \ _DO(primaryExpr) _DO(typeQualList) _DO(star) _DO(bxor) _DO(paramTypeL) _DO(assignExpr) \ _DO(static) _DO(dynamic) _DO(typeName) _DO(sizeOfTok) _DO(alignOfTok) _DO(llparen) _DO(lrparen) \ _DO(rlparen) _DO(rrparen) _DO(attributeL) _DO(attributeTok) _DO(typeOfTok) _DO(asmTok) _DO(element) \ _DO(volatileTok) _DO(gotoTok) _DO(declarationL) _DO(compoundS) _DO(switchTok) _DO(continueTok) \ _DO(breakTok) _DO(returnTok) _DO(caseTok) _DO(defaultTok) _DO(attribute1) _DO(attribute2) \ _DO(structTok) _DO(enumList) _DO(enumTok) #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); } oop newNullObject() { return null; } /** C constructors used when a program is parsed to build an AST */ 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, ifTok_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, elseTok_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, whileTok_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, doTok_symbol, doTok); map_set(object, statements_symbol, statement); map_set(object, whileTok_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, forTok_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 new_C_goto(oop gotoTok, oop star, oop id, oop semicolon) { oop object = newObject(C_goto_proto); map_set(object, gotoTok_symbol, gotoTok); map_set(object, star_symbol, star); map_set(object, name_symbol, id); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_initializer(oop leftCurly, oop initList, oop comma, oop rightCurly) { oop object = newObject(C_initializer_proto); map_set(object, leftCurly_symbol, leftCurly); map_set(object, initList_symbol, initList); map_set(object, comma_symbol, comma); map_set(object, rightCurly_symbol, rightCurly); return object; } oop new_C_range(oop constExpr1, oop ellipsis, oop constExpr2) { oop object = newObject(C_range_proto); map_set(object, constExpr1_symbol, constExpr1); map_set(object, ellipsis_symbol, ellipsis); map_set(object, constExpr2_symbol, constExpr2); return object; } oop new_C_switch(oop switchTok, oop lParen, oop expression, oop rParen, oop statement) { oop object = newObject(C_switch_proto); map_set(object, switchTok_symbol, switchTok); 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_case (oop caseTok, oop expression, oop colon, oop statement) { oop object = newObject(C_case_proto); map_set(object, caseTok_symbol, caseTok); map_set(object, expression_symbol, expression); map_set(object, colon_symbol, colon); map_set(object, statements_symbol, statement); return object; } oop new_C_default(oop defaultTok, oop colon, oop statement) { oop object = newObject(C_default_proto); map_set(object, defaultTok_symbol, defaultTok); map_set(object, colon_symbol, colon); map_set(object, statements_symbol, statement); return object; } oop new_C_attribution(oop specifier, oop declarator) { oop object = newObject(C_attribution_proto); map_set(object, specifiers_symbol, specifier); map_set(object, declarators_symbol, declarator); return object; } oop new_C_deref(oop star, oop typeQualiferL, oop declarator) { oop object = newObject(C_deref_proto); map_set(object, star_symbol, star); map_set(object, typeQualList_symbol,typeQualiferL); map_set(object, declarators_symbol, declarator); return object; } oop new_C_functionDef(oop specifiers, oop declarator, oop declarationList, oop compoundStatement) { oop object = newObject(C_functionDef_proto); map_set(object, specifiers_symbol, specifiers); map_set(object, declarators_symbol, declarator); map_set(object, declarationL_symbol,declarationList); map_set(object, compoundS_symbol, compoundStatement); return object; } 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 new_C_string(oop str) { oop object = newObject(C_string_proto); map_set(object, text_symbol, str); return object; } oop new_C_char(char *s) { oop object = newObject(C_char_proto); map_set(object, value_symbol, makeString(s)); return object; } oop new_C_id(char* id) { oop object = newObject(C_id_proto); map_set(object, identifier_symbol, intern(id)); return object; } oop new_C_sizeOf(oop sizeOfTok, oop lParen, oop typeName, oop rParen) { oop object = newObject(C_sizeOf_proto); map_set(object, sizeOfTok_symbol, sizeOfTok); map_set(object, lparen_symbol, lParen); map_set(object, typeName_symbol, typeName); map_set(object, rparen_symbol, rParen); return object; } oop new_C_alignOf(oop alignOfTok, oop lParen, oop typeName, oop rParen) { oop object = newObject(C_alignOf_proto); map_set(object, alignOfTok_symbol, alignOfTok); map_set(object, lparen_symbol, lParen); map_set(object, typeName_symbol, typeName); map_set(object, rparen_symbol, rParen); return object; } oop new_C_prefix(oop operator, oop expression) { oop object = newObject(C_prefix_proto); map_set(object, operator_symbol, operator); map_set(object, expression_symbol, expression); return object; } oop new_C_postfix(oop expression, oop operator) { oop object = newObject(C_postfix_proto); map_set(object, expression_symbol, expression); map_set(object, operator_symbol, operator); return object; } oop new_C_unary(oop operator, oop expression) { oop object = newObject(C_unary_proto); map_set(object, operator_symbol, operator); map_set(object, expression_symbol, expression); return object; } 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 new_C_compound(oop leftCurly, oop expression, oop rightCurly) { oop object = newObject(C_compound_proto); map_set(object, leftCurly_symbol, leftCurly); map_set(object, expression_symbol, expression); map_set(object, rightCurly_symbol, rightCurly); return object; } oop new_C_subexpr (oop lParen, oop declarator, oop rParen) { oop object = newObject(C_subexpr_proto); map_set(object, lparen_symbol, lParen); map_set(object, declarators_symbol, declarator); map_set(object, rparen_symbol, rParen); return object; } oop new_C_call(oop declarator, oop lParen, oop paramTypeL, oop rParen) { oop object = newObject(C_call_proto); map_set(object, declarators_symbol, declarator); map_set(object, lparen_symbol, lParen); map_set(object, paramTypeL_symbol, paramTypeL); map_set(object, rparen_symbol, rParen); return object; } oop new_C_array(oop declarator, oop lBracket, oop staticTok, oop typeQualiferL, oop symbol, oop assignExpr, oop rBracket) { oop object = newObject(C_array_proto); map_set(object, declarators_symbol, declarator); map_set(object, leftBracket_symbol, lBracket); map_set(object, static_symbol, staticTok); map_set(object, typeQualList_symbol,typeQualiferL); map_set(object, dynamic_symbol, symbol); map_set(object, assignExpr_symbol, assignExpr); map_set(object, rightBracket_symbol,rBracket); return object; } oop new_C_block(oop bxor, oop typeQualiferL, oop declarator) { oop object = newObject(C_block_proto); map_set(object, bxor_symbol, bxor); map_set(object, typeQualList_symbol,typeQualiferL); map_set(object, declarators_symbol, declarator); return object; } oop new_C_continue(oop continueTok, oop semicolon) { oop object = newObject(C_continue_proto); map_set(object, continueTok_symbol, continueTok); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_break(oop breakTok, oop semicolon) { oop object = newObject(C_break_proto); map_set(object, breakTok_symbol, breakTok); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_return(oop returnTok, oop expression, oop semicolon) { oop object = newObject(C_return_proto); map_set(object, returnTok_symbol, returnTok); map_set(object, expression_symbol, expression); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_exprStatement(oop expression, oop semicolon) { oop object = newObject(C_exprStatement_proto); map_set(object, expression_symbol, expression); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_asm(oop asmTok, oop lParen, oop stringLiteral, oop rParen) { oop object = newObject(C_asm_proto); map_set(object, asmTok_symbol, asmTok); map_set(object, lparen_symbol, lParen); map_set(object, text_symbol, stringLiteral); map_set(object, rparen_symbol, rParen); return object; } oop new_C_asmExpr(oop asmTok, oop volatileTok, oop gotoTok, oop lParen, oop stringLiteral, oop list, oop rParen) { oop object = newObject(C_asmExpr_proto); map_set(object, asmTok_symbol, asmTok); map_set(object, volatileTok_symbol, volatileTok); map_set(object, gotoTok_symbol, gotoTok); map_set(object, lparen_symbol, lParen); map_set(object, text_symbol, stringLiteral); map_set(object, element_symbol, list); map_set(object, rparen_symbol, rParen); return object; } oop new_C_asmExprArg(oop stringLiteral, oop lParen, oop expression, oop rParen) { oop object = newObject(C_asmExprArg_proto); map_set(object, text_symbol, stringLiteral); map_set(object, lparen_symbol, lParen); map_set(object, expression_symbol, expression); map_set(object, rparen_symbol, rParen); 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; } oop new_C_parameter(oop paramSpecifiers, oop declarator) { oop object = newObject(C_parameter_proto); map_set(object, specifiers_symbol, paramSpecifiers); map_set(object, declarators_symbol, declarator); return object; } 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); } void listAppend2(oop obj1, oop obj2) { assert(currentList); map_append(currentList, obj1); map_append(currentList, obj2); } void listWith(oop obj) { listBegin(); listAppend(obj); } oop listEnd(void) { assert(currentList); oop list= currentList; currentList= OopStack_pop(&listOfLists); return list; } void List_addLast(oop list, oop obj) { assert(list); map_append(list, obj); } oop listEmpty(void) { return makeMap(); } int typedeffing = 0; void declarationTypedef(void) { typedeffing++; } void C_declarationBegin(void) { typedeffing = 0; } int C_declarationAbort(void) { typedeffing = 0; return 0; } void C_declarationEnd(void) { typedeffing = 0; } void C_scopeBegin(void) { pushScope(); } int C_scopeAbort(void) { popScope(); assert(actualScope); return 0; } void C_scopeEnd(void) { popScope(); assert(actualScope); } int declarationId(char *s) { if (!typedeffing) return 0; addId(s); return 1; } int isTypedefName(char *s) { if (!isTypedefed(s)) return 0; return 1; } oop new_C_conditional(oop logicalOrExpression, oop question, oop expression, oop colon, oop conditionalExpression) { oop object = newObject(C_conditional_proto); map_set(object, logicalOr_symbol, logicalOrExpression); map_set(object, question_symbol, question); map_set(object, expression_symbol, expression); map_set(object, colon_symbol, colon); map_set(object, condExpr_symbol, conditionalExpression); return object; } oop new_C_designation(oop id, oop colon) { oop object = newObject(C_designation_proto); map_set(object, identifier_symbol, id); map_set(object, colon_symbol, colon); return object; } oop new_C_index(oop primaryExpression, oop lBracket, oop expression, oop rBracket) { oop object = newObject(C_index_proto); map_set(object, primaryExpr_symbol, primaryExpression); map_set(object, leftBracket_symbol, lBracket); map_set(object, expression_symbol, expression); map_set(object, rightBracket_symbol,rBracket); return object; } oop new_C_typeOf(oop typeOf, oop lParen, oop typeName, oop expression, oop rParen) { oop object = newObject(C_typeOf_proto); map_set(object, typeOfTok_symbol, typeOf); map_set(object, lparen_symbol, lParen); map_set(object, typeName_symbol, typeName); map_set(object, expression_symbol, expression); map_set(object, rparen_symbol, rParen); return object; } oop new_C_cast(oop lParen, oop typeName, oop rParen, oop expression) { oop object = newObject(C_cast_proto); map_set(object, lparen_symbol, lParen); map_set(object, typeName_symbol, typeName); map_set(object, rparen_symbol, rParen); map_set(object, expression_symbol, expression); return object; } oop new_C_attributeSpec(oop attributeTok, oop llParen, oop lrParen, oop attributeList, oop rlParen, oop rrParen) { oop object = newObject(C_attributeSpec_proto); map_set(object, attributeTok_symbol,attributeTok); map_set(object, llparen_symbol, llParen); map_set(object, lrparen_symbol, lrParen); map_set(object, attributeL_symbol, attributeList); map_set(object, rlparen_symbol, rlParen); map_set(object, rrparen_symbol, rrParen); return object; } oop new_C_aggregate(oop lParen, oop typeName, oop rParen, oop leftCurly, oop initList, oop comma, oop rightCurly) { oop object = newObject(C_aggregate_proto); map_set(object, lparen_symbol, lParen); map_set(object, typeName_symbol, typeName); map_set(object, rparen_symbol, rParen); map_set(object, leftCurly_symbol, leftCurly); map_set(object, initList_symbol, initList); map_set(object, comma_symbol, comma); map_set(object, rightCurly_symbol, rightCurly); return object; } oop new_C_attribute(oop name, oop lParen, oop expression, oop rParen) { oop object = newObject(C_attribute_proto); map_set(object, text_symbol, name); map_set(object, lparen_symbol, lParen); map_set(object, expression_symbol, expression); map_set(object, rparen_symbol, rParen); return object; } oop new_C_label(oop id, oop colon, oop attributeSpecifier, oop statement) { oop object = newObject(C_label_proto); map_set(object, name_symbol, id); map_set(object, colon_symbol, colon); map_set(object, attributeL_symbol, attributeSpecifier); map_set(object, statements_symbol, statement); return object; } oop new_C_labelDeclaration(oop labelTok, oop list, oop semicolon) { oop object = newObject(C_labelDeclaration_proto); map_set(object, labels_symbol, labelTok); map_set(object, element_symbol, list); map_set(object, semicolon_symbol, semicolon); return object; } oop new_C_structSpec(oop structTok, oop attributeSpecifier1, oop id, oop leftCurly, oop declarationList, oop rightCurly, oop attributeSpecifier2) { oop object = newObject(C_structSpec_proto); map_set(object, structTok_symbol, structTok); map_set(object, attribute1_symbol, attributeSpecifier1); map_set(object, name_symbol, id); map_set(object, leftCurly_symbol, leftCurly); map_set(object, declarationL_symbol,declarationList); map_set(object, rightCurly_symbol, rightCurly); map_set(object, attribute2_symbol, attributeSpecifier2); return object; } oop new_C_structDeclarator(oop declarator, oop colon, oop expression) { oop object = newObject(C_structDeclarator_proto); map_set(object, declarators_symbol, declarator); map_set(object, colon_symbol, colon); map_set(object, expression_symbol, expression); return object; } oop new_C_enumSpec(oop enumTok, oop id, oop leftCurly, oop enumeratorList, oop rightCurly) { oop object = newObject(C_enumSpec_proto); map_set(object, enumTok_symbol, enumTok); map_set(object, name_symbol, id); map_set(object, leftCurly_symbol, leftCurly); map_set(object, enumList_symbol, enumeratorList); map_set(object, rightCurly_symbol, rightCurly); return object; } oop new_C_enumerator(oop id, oop attributeSpecifier, oop expression) { oop object = newObject(C_enum_proto); map_set(object, name_symbol, id); map_set(object, attributeL_symbol, attributeSpecifier); map_set(object, expression_symbol, expression); return object; } #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= 0; 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; int apl = 0; //TODO 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)); icol += strlen(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); } /* Meta Functions */ 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 newIf(oop cond, oop cons, oop alt) { oop obj = newObject(If_proto); map_set(obj, condition_symbol, cond); map_set(obj, consequent_symbol, cons); map_set(obj, alternate_symbol, alt); return obj; } oop newWhile(oop cond, oop body) { oop obj = newObject(While_proto); map_set(obj, condition_symbol, cond); map_set(obj, body_symbol, body); return obj; } oop newDo(oop body, oop cond) { oop obj= newObject(Do_proto); map_set(obj, body_symbol, body); map_set(obj, condition_symbol, cond); return obj; } oop newFor(oop init, oop cond, oop step, oop body) { oop obj= newObject(For_proto); map_set(obj, initialise_symbol, init); map_set(obj, condition_symbol, cond); map_set(obj, update_symbol, step); map_set(obj, body_symbol, body); return obj; } oop newForIn(oop name, oop expression, oop body) { oop obj= newObject(ForIn_proto); map_set(obj, name_symbol, name); map_set(obj, expression_symbol, expression); map_set(obj, body_symbol, body); return obj; } 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 newInteger(oop value) { oop integer = newObject(Integer_proto); map_set(integer, value_symbol, value); return integer; } oop newFloat(oop value) { oop obj = newObject(Float_proto); map_set(obj, value_symbol, value); return obj; } oop newString(oop str) { assert(is(String, str)); oop string = newObject(String_proto); map_set(string, value_symbol, str); return string; } 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 newBinary(oop proto, oop lhs, oop rhs) { oop obj = newObject(proto); map_set(obj, lhs_symbol, lhs); map_set(obj, rhs_symbol, rhs); return obj; } 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; } int toPrint = 0; typedef enum { META = 0, C = 1, } language; language lang = C, printLang = C; %} #--------------------------------------------- C grammar -------------------------------------------------# # yylval == null => "pseudo" op, e.g., change language -- ignored by REPL # yylval == 0 => end of input file while in META mode only start = META_AT META_LPAREN s:meta_exp META_RPAREN { yylval= s } | META_AT META_LCB { yylval= null; lang= META } | &{ lang == META } - s:meta { yylval= s } | &{ lang == META } - META_RCB { yylval= null; lang= C } | &{ lang == C } s:externalDeclaration { yylval= s } error = EOL* < (!EOL .)* EOL* (!EOL .)* > &{ error(yytext), 1 } ### A.1.3 Identifiers # 6.4.2.1 idOpt = id | {$$=newNullObject()} id = { $$= new_C_id(yytext) } - ID = &{ !get(intern(yytext), Symbol, is_C_keyword) } 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) } )+ { $$= new_C_string(listEnd()) } stringLiteralPart = < '"' sCharSequence '"' > { $$= new_C_char(yytext) } - | < 'L''"' sCharSequence '"' > { $$= new_C_char(yytext) } - sCharSequence = ( escapeSequence | !EOL [^\"\\] )* ### A.2.1 Expressions # 6.5.1 primaryExpression = stringLiteral | constant | id | l:LPAREN x:expression r:RPAREN { $$= new_C_subexpr(l, x, r) } | l:LPAREN x:compoundStatement r:RPAREN &{gnu} { $$= new_C_subexpr(l, x, r) } # 6.5.2 postfixExpression = o:LPAREN l:typeName p:RPAREN a:LCURLY r:initializerList ( c:COMMA | {c=newNullObject()} ) b:RCURLY { $$= new_C_aggregate(o, l, p, a, r, c, b) } | l:primaryExpression ( o:LBRACKET r:expression p:RBRACKET { l= new_C_index(l, o, r, p) } | o:LPAREN r:argumentExpressionList p:RPAREN { l= new_C_call(l, o, r, p) } | o:DOT r:id { l= new_C_binary(l, o, r) } | o:PTR r:id { l= new_C_binary(l, o, r) } | o:INC { l= new_C_postfix(l, o) } | o:DEC { l= new_C_postfix(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 { $$= new_C_prefix(o, x) } | o:DEC x:unaryExpression { $$= new_C_prefix(o, x) } | o:unaryOperator x:castExpression { $$= new_C_unary(o, x) } | s:SIZEOF ( l:LPAREN t:typeName r:RPAREN { $$= new_C_sizeOf(s, l, t, r) } | x:unaryExpression { $$= new_C_sizeOf(s, newNullObject(), x, newNullObject()) } ) | s:ALIGNOF ( l:LPAREN t:typeName r:RPAREN { $$= new_C_alignOf(s, l, t, r) } | x:unaryExpression { $$= new_C_alignOf(s, newNullObject(), x, newNullObject()) } ) &{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 { $$= new_C_cast(l, t, r, x) } | unaryExpression # 6.5.5 multiplicativeExpression = l:castExpression ( o:multiplicativeOperator r:castExpression { l= new_C_binary(l, o, r) } )* { $$= l } multiplicativeOperator = STAR | DIV | MOD # 6.5.6 additiveExpression = l:multiplicativeExpression ( o:additiveOperator r:multiplicativeExpression { l= new_C_binary(l, o, r) } )* { $$= l } additiveOperator = PLUS | MINUS # 6.5.7 shiftExpression = l:additiveExpression ( o:shiftOperator r:additiveExpression { l= new_C_binary(l, o, r) } )* { $$= l } shiftOperator = LSHIFT | RSHIFT # 6.5.8 relationalExpression = l:shiftExpression ( o:relationalOperator r:shiftExpression { l= new_C_binary(l, o, r) } )* { $$= l } relationalOperator = LT | LTE | GT | GTE # 6.5.9 equalityExpression = l:relationalExpression ( o:equalityOperator r:relationalExpression { l= new_C_binary(l, o, r) } )* { $$= l } equalityOperator = EQUAL | NOT_EQUAL # 6.5.10 andExpression = l:equalityExpression ( o:BAND r:equalityExpression { l= new_C_binary(l, o, r) } )* { $$= l } # 6.5.11 exclusiveOrExpression = l:andExpression ( o:BXOR r:andExpression { l= new_C_binary(l, o, r) } )* { $$= l } # 6.5.12 inclusiveOrExpression = l:exclusiveOrExpression ( o:BOR r:exclusiveOrExpression { l= new_C_binary(l, o, r) } )* { $$= l } # 6.5.13 logicalAndExpression = l:inclusiveOrExpression ( o:LAND r:inclusiveOrExpression { l= new_C_binary(l, o, r) } )* { $$= l } # 6.5.14 logicalOrExpression = l:logicalAndExpression ( o:LOR r:logicalAndExpression { l= new_C_binary(l, o, r) } )* { $$= l } # 6.5.15 conditionalExpression = l:logicalOrExpression ( q:QUESTION m:expression c:COLON r:conditionalExpression { $$= new_C_conditional(l, q, m, c, r) } | q:QUESTION c:COLON r:conditionalExpression &{gnu} { $$= new_C_conditional(l, q, newNullObject(), c, r) } | { $$= l } ) # 6.5.16 assignmentExpressionOpt = assignmentExpression | {$$=newNullObject()} assignmentExpression = l:unaryExpression o:assignmentOperator r:assignmentExpression { $$= new_C_binary(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= new_C_binary(l, o, r) } )* { $$= l } expressionOpt = expression | { $$= newNullObject() } 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) } # Any list of specifiers and qualifiers at the start of a declaration may contain attribute specifiers | s:attributeSpecifier &{gnu} { listAppend(s) } | s:typedefName &{ !specified++ } { listAppend(s) } | s:typeQualifier { listAppend(s) } | s:functionSpecifier { listAppend(s) } )+ { $$= listEnd() } | &{gnu} { $$= listEmpty() } initDeclaratorListOpt = initDeclaratorList | { $$= listEmpty() } initDeclaratorList = d:initDeclarator { listWith(d) } ( c:COMMA d:initDeclarator { listAppend2(c, d) } )* { $$= listEnd() } initDeclarator = d:declarator ( a:ASSIGN i:initializer &{ !typedeffing } { d= new_C_binary(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 | ( BUILTIN_VA_LIST | _FLOAT128 ) | structOrUnionSpecifier | enumSpecifier # 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=newNullObject()} ) ( i:idOpt ( @{ C_scopeBegin() } l:LCURLY d:structDeclarationList r:RCURLY @{ C_scopeEnd() } | &{ C_scopeAbort() } ) # ..., or after the closing brace. ( b:attributeSpecifiers &{gnu} | {b=newNullObject()} ) | i:id {l=d=r=b=newNullObject()} ) { $$= new_C_structSpec(s, a, i, l, d, r, b) } structOrUnion = STRUCT | UNION structDeclarationList = d:structDeclaration { listWith(d) } ( d:structDeclaration { listAppend(d) } )* { $$= listEnd() } | &{gnu} { $$= newNullObject() } structDeclaration = s:specifierQualifierList d:structDeclaratorList t:SEMI ( &SEMI { listWith(t) } ( t:SEMI { listAppend(t) } )* &{gnu} { t= listEnd() } )? { $$= new_C_declaration(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} { $$= newNullObject() } structDeclarator = ( c:COLON e:constantExpression { d= new_C_structDeclarator(newNullObject(), c, e) } | d:declarator ( c:COLON e:constantExpression | {c=e=newNullObject()} ) { d= new_C_structDeclarator(d, c, e) } ) # An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier ( a:attributeSpecifiers { d= new_C_attribution(d, a) } )? { $$= d } # 6.7.2.2 enumSpecifier = e:ENUM ( i:idOpt l:LCURLY m:enumeratorList r:RCURLY { $$= new_C_enumSpec(e, i, l, m, r) } | i:id { $$= new_C_enumSpec(e, i, newNullObject(), newNullObject(), newNullObject()) } ) 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= new_C_attribution(i, a) } )* ( a:ASSIGN e:constantExpression | {a=e=newNullObject()} ) { $$= new_C_enumerator(i, a, e) } # 6.7.3 typeQualifier = CONST | RESTRICT | VOLATILE | __RESTRICT # 6.7.4 functionSpecifier = INLINE | __INLINE # 6.7.5 declarator = # An attribute specifier list may appear immediately before a declarator a:attributeSpecifier d:declarator &{gnu} { $$= new_C_attribution(a, d) } | p:STAR q:typeQualifierList d:declarator { $$= new_C_deref(p, q, d) } | p:BXOR q:typeQualifierList d:declarator &{apl} { $$= new_C_block(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= new_C_attribution(d, a) } # an asm (or __asm__) keyword may appear after the declarator | &{gnu} a:asm { d= new_C_attribution(d, a) } )* ) { $$= d } directDeclarator = ( l:LPAREN d:declarator r:RPAREN { d= new_C_subexpr(l, d, r) } | &( @{ declarationId(yytext) } ) d:id ) ( @{ C_scopeBegin() } ( l:LPAREN p:parameterTypeList r:RPAREN { d= new_C_call (d, l, p, r) } @{ C_scopeEnd() } | l:LPAREN p:identifierListOpt r:RPAREN { d= new_C_call (d, l, p, r) } @{ C_scopeEnd() } | l:LBRACKET ( s:STATIC q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpression | {s=newNullObject()} q:typeQualifierList t:STATIC e:assignmentExpressionOpt | {s=newNullObject()} q:typeQualifierListOpt t:STAR {e=newNullObject()} | {s=newNullObject()} q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpressionOpt ) r:RBRACKET { d= new_C_array(d, l, s, q, t, e, r) } @{ C_scopeEnd() } | &{ C_scopeAbort() } ) )* { $$= d } typeQualifierListOpt = typeQualifierList | {$$=newNullObject()} typeQualifierList = { listBegin() } ( t:typeQualifier { listAppend(t) } )* { $$= listEnd() } parameterTypeListOpt = parameterTypeList | {$$=newNullObject()} 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 ) { $$= new_C_parameter(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 | {$$=newNullObject()} identifierList = i:id { listWith(i) } ( c:COMMA i:id { listAppend2(c, i) } )* { $$= listEnd() } # 6.7.6 typeName = s:specifierQualifierList d:abstractDeclaratorOpt { $$= new_C_declaration(s, d, newNullObject()) } abstractDeclaratorOpt = abstractDeclarator | {$$=newNullObject()} abstractDeclarator = p:STAR q:typeQualifierList d:abstractDeclaratorOpt { $$= new_C_deref(p, q, d) } | p:BXOR q:typeQualifierList d:abstractDeclaratorOpt &{apl} { $$= new_C_block(p, q, d) } | directAbstractDeclarator directAbstractDeclarator= @{int nonEmpty= 0} ( l:LPAREN d:abstractDeclarator r:RPAREN @{++nonEmpty} { d= new_C_subexpr(l, d, r) } | {d=newNullObject()} ) ( l:LPAREN p:parameterTypeListOpt r:RPAREN @{++nonEmpty} { d= new_C_call (d, l, p, r) } | l:LBRACKET ( s:STATIC q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpression | {s=newNullObject()} q:typeQualifierList t:STATIC e:assignmentExpressionOpt | {s=newNullObject()} q:typeQualifierListOpt t:STAR {e=newNullObject()} | {s=newNullObject()} q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpressionOpt ) r:RBRACKET @{++nonEmpty} { d= new_C_array(d, l, s, q, t, e, r) } )* &{nonEmpty} { $$= d } # 6.7.7 typedefName = &{ isTypedefName(yytext) } { $$= new_C_id(yytext) } - | t:TYPEOF l:LPAREN ( x:expression r:RPAREN { $$= new_C_typeOf(t, l, newNullObject(), x, r) } | x:typeName r:RPAREN { $$= new_C_typeOf(t, l, x, newNullObject(), r) } ) &{gnu} # 6.7.8 initializer = l:LCURLY i:initializerList ( c:COMMA | {c=newNullObject()} ) r:RCURLY { $$= new_C_initializer(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} { $$= newNullObject() } designation = ( d:designatorList ( a:ASSIGN | {a=newNullObject()} &{gnu} ) | d:id a:COLON &{gnu} ) { $$= new_C_designation(d, a) } designatorList = { listBegin() } ( l:LBRACKET x:constantExpression r:RBRACKET { listAppend(new_C_index(newNullObject(), l, x, r)) } | l:LBRACKET x:constantRange r:RBRACKET &{gnu} { listAppend(new_C_index(newNullObject(), l, x, r)) } | l:DOT x:id { listAppend(new_C_binary(newNullObject(), 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=newNullObject()} ) s:statement { $$= new_C_label(i, c, a, s) } | c:CASE x:constantExpression d:COLON s:statement { $$= new_C_case(c, x, d, s) } | c:CASE x:constantRange d:COLON s:statement &{gnu} { $$= new_C_case(c, x, d, s) } | d:DEFAULT c:COLON s:statement { $$= new_C_default(d, c, s) } # 6.8.2 compoundStatement = @{ C_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 { $$= new_C_compound(l, x, r) } @{ C_scopeEnd() } | &{ C_scopeAbort() } # 6.8.3 expressionStatement = SEMI | x:expression s:SEMI { $$= new_C_exprStatement(x, s) } # 6.8.4 selectionStatement = i:IF l:LPAREN x:expression r:RPAREN s:statement ( e:ELSE t:statement | {e=t=newNullObject()} ) { $$= new_C_if(i, l, x, r, s, e, t) } | s:SWITCH l:LPAREN x:expression r:RPAREN t:statement { $$= new_C_switch(s, l, x, r, t) } # 6.8.5 iterationStatement = w:WHILE l:LPAREN x:expression r:RPAREN s:statement { $$= new_C_while(w, l, x, r, s) } | d:DO s:statement w:WHILE l:LPAREN x:expression r:RPAREN t:SEMI { $$= new_C_do(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 { $$= new_C_for(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 { $$= new_C_for(f, l, a, newNullObject(), b, u, c, r, s) } # 6.8.6 jumpStatement = g:GOTO i:id t:SEMI { $$= new_C_goto(g, newNullObject(), i, t) } | c:CONTINUE t:SEMI { $$= new_C_continue(c, t) } | b:BREAK t:SEMI { $$= new_C_break(b, t) } | r:RETURN x:expressionOpt t:SEMI { $$= new_C_return(r, x, t) } | g:GOTO s:STAR x:expression t:SEMI &{gnu} { $$= new_C_goto(g, s, x, t) } ### A.2.4 External definitions # 6.9 ## translationUnit = externalDeclaration+ externalDeclaration = { yylval = newComment(yytext); } | ( SEMI &{gnu} | declaration | functionDefinition | &. &{ errmsg= "declaration expected" } error ) { yylval= $$; } functionDefinition = @{ C_declarationBegin() } ( s:functionDeclarationSpecifiers | &{gnu} {s=newNullObject()} ) d:declarator l:declarationListOpt c:compoundStatement { $$= new_C_functionDef(s, d, l, c) } @{ C_declarationEnd() } | &{ C_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 | {$$=newNullObject()} 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 { $$= new_C_attributeSpec(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=newNullObject()} ) { $$= new_C_attribute(n, l, p, r) } constantRange = a:constantExpression e:ELLIPSIS b:constantExpression { $$= new_C_range(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 { $$= new_C_labelDeclaration(l, listEnd(), s) } asm = a:ASM l:LPAREN s:stringLiteral r:RPAREN { $$= new_C_asm(a, l, s, r) } asmExpr = a:ASM ( v:VOLATILE | {v=newNullObject()} ) ( g:GOTO | {g=newNullObject()} ) 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 { $$= new_C_asmExpr(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=newNullObject()} ){ $$= new_C_asmExprArg(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__" ) } - BUILTIN_VA_LIST = '__builtin_va_list' !IDREST &{gnu} { $$= newToken("__builtin_va_list" ) } - __RESTRICT = '__restrict' !IDREST &{gnu} { $$= newToken("__restrict" ) } - __INLINE = '__inline' !IDREST &{gnu} { $$= newToken("__inline" ) } - _FLOAT128 = '_Float128' !IDREST &{gnu} { $$= newToken("_Float128" ) } - #--------------------------------------------- Meta grammar ----------------------------------------------# # the semicolon has to be explicit with no space eaten afterwards to prevent the # input buffer from moving past it before redirecting input from the imported file meta = META_IMPORT s:META_STRING ";" { $$ = null; inputStackPush(get(s, String, value)) } | s:meta_stmt { $$ = s } | !. { $$ = 0 } # signal end of current input file meta_stmt = s:meta_block { $$ = s } | META_SEMICOLON { $$ = null } | l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, null) } | META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt META_ELSE f:meta_stmt { $$ = newIf(c, t, f ) } | META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt { $$ = newIf(c, t, null) } | META_WHILE META_LPAREN c:meta_exp META_RPAREN s:meta_stmt { $$ = newWhile(c, s) } | META_DO s:meta_stmt META_WHILE META_LPAREN c:meta_exp META_RPAREN { $$ = newDo(s, c) } | META_FOR META_LPAREN i:meta_ident META_IN e:meta_exp META_RPAREN s:meta_stmt { $$ = newForIn(i, e, s) } | META_FOR META_LPAREN i:meta_stmt c:meta_stmt u:meta_exp META_RPAREN s:meta_stmt { $$ = newFor(i, c, u, s) } | s:meta_switch { $$ = s } | META_RETURN e:meta_exp { $$ = newReturn(e) } | META_RETURN { $$ = newReturn(null) } | META_BREAK { $$ = newBreak() } | META_CONTINUE { $$ = newContinue() } | META_THROW e:meta_exp { $$ = newUnary(Throw_proto, e) } | t:meta_try { $$ = t } | e:meta_exp META_SEMICOLON { $$ = e } meta_block = META_LCB m:meta_makeMap ( s:meta_stmt { map_append(m, s) } ) * ( s:meta_exp { map_append(m, s) } ) ? META_RCB { $$ = newBlock(m) } meta_exp = META_VAR l:meta_ident META_ASSIGN e:meta_exp { $$ = newDeclaration(l, e) } # | META_SYNTAX l:META_IDENT p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(l, p, e, makeInteger(2))) } # | META_SYNTAX p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(null, p, e, makeInteger(2))) } # | META_SYNTAX l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, makeInteger(1)) } # | META_SYNTAX p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, makeInteger(1)) } | l:META_IDENT o:meta_assignOp e:meta_exp { $$ = newAssign(Assign_proto, l, o, e) } | l:meta_postfix META_DOT i:META_IDENT o:meta_assignOp e:meta_exp { $$ = newSetMap(SetMember_proto, l, i, o, e) } | l:meta_postfix META_LBRAC i:meta_exp META_RBRAC o:meta_assignOp e:meta_exp { $$ = newSetMap(SetIndex_proto, l, i, o, e) } | l:meta_syntax2 a:meta_argumentList s:meta_block { $$ = (map_append(a, s), apply(globals, globals, l, a, a)) } | c:meta_cond { $$ = c } meta_ident = l:META_IDENT { $$ = l } # | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) } meta_syntax2 = < [a-zA-Z_][a-zA-Z0-9_]* > &{ null != getSyntaxId(2, intern(yytext)) } - { $$ = getSyntaxId(2, intern(yytext)) } meta_try = META_TRY t:meta_stmt i:meta_null c:meta_null f:meta_null ( META_CATCH META_LPAREN i:META_IDENT META_RPAREN c:meta_stmt ) ? ( META_FINALLY f:meta_stmt ) ? { $$ = newTry(t, i, c, f) } meta_null = { $$ = null } meta_assignOp = META_ASSIGN { $$= null } | META_ASSIGNADD { $$= Add_symbol } | META_ASSIGNSUB { $$= Sub_symbol } | META_ASSIGNMUL { $$= Mul_symbol } | META_ASSIGNDIV { $$= Div_symbol } | META_ASSIGNMOD { $$= Mod_symbol } | META_ASSIGNBITOR { $$= Bitor_symbol } | META_ASSIGNBITXOR { $$= Bitxor_symbol } | META_ASSIGNBITAND { $$= Bitand_symbol } | META_ASSIGNSHLEFT { $$= Shleft_symbol } | META_ASSIGNSHRIGHT { $$= Shright_symbol } meta_switch = META_SWITCH META_LPAREN e:meta_exp META_RPAREN META_LCB statements:meta_makeMap labels:meta_makeMap ( META_CASE l:meta_exp META_COLON { map_set(labels, eval(globals, l), makeInteger(map_size(statements))) } | META_DEFAULT META_COLON { map_set(labels, __default___symbol, makeInteger(map_size(statements))) } | s:meta_stmt { map_append(statements, s) } )* META_RCB { $$= newSwitch(e, labels, statements) } meta_cond = c:meta_logor META_QUERY t:meta_exp META_COLON f:meta_cond { $$ = newIf(c, t, f) } | meta_logor meta_logor = l:meta_logand ( META_LOGOR r:meta_logand { l = newBinary(Logor_proto, l, r) } )* { $$ = l } meta_logand = l:meta_bitor ( META_LOGAND r:meta_bitor { l = newBinary(Logand_proto, l, r) } )* { $$ = l } meta_bitor = l:meta_bitxor ( META_BITOR r:meta_bitxor { l = newBinary(Bitor_proto, l, r) } )* { $$ = l } meta_bitxor = l:meta_bitand ( META_BITXOR r:meta_bitand { l = newBinary(Bitxor_proto, l, r) } )* { $$ = l } meta_bitand = l:meta_eq ( META_BITAND r:meta_eq { l = newBinary(Bitand_proto, l, r) } )* { $$ = l } meta_eq = l:meta_ineq ( META_EQUAL r:meta_ineq { l = newBinary(Equal_proto, l, r) } | META_NOTEQ r:meta_ineq { l = newBinary(Noteq_proto, l, r) } )* { $$ = l } meta_ineq = l:meta_shift ( META_LESS r:meta_shift { l = newBinary(Less_proto, l, r) } | META_LESSEQ r:meta_shift { l = newBinary(Lesseq_proto, l, r) } | META_GREATEREQ r:meta_shift { l = newBinary(Greatereq_proto, l, r) } | META_GREATER r:meta_shift { l = newBinary(Greater_proto, l, r) } )* { $$ = l } meta_shift = l:meta_sum ( META_SHLEFT r:meta_sum { l = newBinary(Shleft_proto, l, r) } | META_SHRIGHT r:meta_sum { l = newBinary(Shright_proto, l, r) } )* { $$ = l } meta_sum = l:meta_prod ( META_PLUS r:meta_prod { l = newBinary(Add_proto, l, r) } | META_MINUS r:meta_prod { l = newBinary(Sub_proto, l, r) } )* { $$ = l } meta_prod = l:meta_prefix ( META_MULTI r:meta_prefix { l = newBinary(Mul_proto, l, r) } | META_DIVIDE r:meta_prefix { l = newBinary(Div_proto, l, r) } | META_MODULO r:meta_prefix { l = newBinary(Mod_proto, l, r) } )* { $$ = l } meta_prefix = META_PLUS n:meta_prefix { $$= n } | META_NEGATE n:meta_prefix { $$= newUnary(Neg_proto, n) } | META_TILDE n:meta_prefix { $$= newUnary(Com_proto, n) } | META_PLING n:meta_prefix { $$= newUnary(Not_proto, n) } | META_PLUSPLUS n:meta_prefix { $$= newPreIncrement(n) } | META_MINUSMINUS n:meta_prefix { $$= newPreDecrement(n) } # | META_BACKTICK n:meta_prefix { $$ = newUnary(Quasiquote_proto, n) } # | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) } | n:meta_postfix { $$= n } meta_postfix = i:meta_value ( META_DOT s:META_IDENT a:meta_argumentList { i = newInvoke(i, s, a) } | META_DOT s:META_IDENT !meta_assignOp { i = newGetMap(GetMember_proto, i, s) } | META_LBRAC p:meta_exp META_RBRAC !meta_assignOp { i = newGetMap(GetIndex_proto, i, p) } | a:meta_argumentList { i = (null != getSyntax(1, i)) ? apply(globals, globals, getSyntax(1, i), a, i) : newCall(i, a) } | META_PLUSPLUS { i = newPostIncrement(i) } | META_MINUSMINUS { i = newPostDecrement(i) } ) * { $$ = i } meta_paramList = META_LPAREN m:meta_makeMap ( i:META_IDENT { map_append(m, i) } ( META_COMMA i:META_IDENT { map_append(m, i) } ) * ) ? META_RPAREN { $$ = m } meta_argumentList = META_LPAREN m:meta_makeMap ( e:meta_exp { map_append(m, e) } ( META_COMMA e:meta_exp { map_append(m, e) } ) * ) ? META_RPAREN { $$ = m } meta_value = n:META_FLOAT { $$ = newFloat(n) } | n:meta_integer { $$ = newInteger(n) } | s:meta_string { $$ = newString(s) } | s:meta_symbol { $$ = s } | m:meta_map { $$ = newMap(m) } | META_NULL { $$ = null } | i:META_IDENT { $$ = newGetVariable(i) } | p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, null) } | META_LPAREN ( i:meta_block | i:meta_exp ) META_RPAREN { $$ = i } meta_string = s:META_STRING - { $$ = s } META_STRING = META_DQUOTE < (!META_DQUOTE meta_char)* > META_DQUOTE { $$ = makeString(unescape(yytext)) } meta_char = '\\' . | . meta_symbol = META_HASH ( i:META_IDENT { $$ = newSymbol(i) } | i:meta_string { $$ = newSymbol(intern(get(i, String, value))) } ) meta_map = META_LCB m:meta_makeMap ( k:meta_key META_COLON v:meta_exp { map_set(m, k, v) } ( META_COMMA k:meta_key META_COLON v:meta_exp { map_set(m, k, v) } ) * ) ? META_RCB { $$ = m } | META_LBRAC m:meta_makeMap ( v:meta_exp { map_append(m, v) } ( META_COMMA v:meta_exp { map_append(m, v) } ) * ) ? META_RBRAC { $$ = m } meta_makeMap = { $$ = makeMap() } meta_key = META_IDENT | meta_integer meta_keyword = META_SWITCH | META_CASE | META_DEFAULT | META_DO | META_FOR | META_IN | META_WHILE | META_IF | META_ELSE | META_NULL | META_RETURN | META_BREAK | META_CONTINUE | META_THROW | META_TRY | META_CATCH | META_FINALLY # | META_SYNTAX META_IDENT = !meta_keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } meta_integer = i:META_INTEGER { $$ = i } | '-' i:meta_integer { $$ = makeInteger(-getInteger(i)) } META_INTEGER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) } | '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) } | '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) } | < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) } | META_SQUOTE < (!META_SQUOTE meta_char) > META_SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) } META_FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } | < [-+]* [0-9]* '.' [0-9]+ ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } | < [-+]* [0-9]+ ('e'[-+]*[0-9]+) > - { $$ = makeFloat(strtold(yytext, 0)) } #META_FUN = 'fun' ![a-zA-Z0-9_] - #META_SYNTAX = 'syntax' ![a-zA-Z0-9_] - META_VAR = 'var' ![a-zA-Z0-9_] - META_SWITCH = 'switch' ![a-zA-Z0-9_] - META_CASE = 'case' ![a-zA-Z0-9_] - META_DEFAULT = 'default' ![a-zA-Z0-9_] - META_DO = 'do' ![a-zA-Z0-9_] - META_FOR = 'for' ![a-zA-Z0-9_] - META_IN = 'in' ![a-zA-Z0-9_] - META_WHILE = 'while' ![a-zA-Z0-9_] - META_IF = 'if' ![a-zA-Z0-9_] - META_ELSE = 'else' ![a-zA-Z0-9_] - META_NULL = 'null' ![a-zA-Z0-9_] - META_RETURN = 'return' ![a-zA-Z0-9_] - META_BREAK = 'break' ![a-zA-Z0-9_] - META_CONTINUE = 'continue' ![a-zA-Z0-9_] - META_THROW = 'throw' ![a-zA-Z0-9_] - META_TRY = 'try' ![a-zA-Z0-9_] - META_CATCH = 'catch' ![a-zA-Z0-9_] - META_FINALLY = 'finally' ![a-zA-Z0-9_] - META_IMPORT = 'import' ![a-zA-Z0-9_] - META_HASH = '#' - META_LOGOR = '||' - META_LOGAND = '&&' - META_BITOR = '|' ![|=] - META_BITXOR = '^' ![=] - META_BITAND = '&' ![&=] - META_EQUAL = '==' - META_NOTEQ = '!=' - META_LESS = '<' ![<=] - META_LESSEQ = '<=' - META_GREATEREQ = '>=' - META_GREATER = '>' ![>=] - META_SHLEFT = '<<' ![=] - META_SHRIGHT = '>>' ![=] - META_PLUS = '+' ![+=] - META_MINUS = '-' ![-=] - META_NEGATE = '-' ![-=0-9.] - META_PLUSPLUS = '++' - META_MINUSMINUS = '--' - META_TILDE = '~' - META_PLING = '!' ![=] - META_MULTI = '*' ![=] - META_DIVIDE = '/' ![/=] - META_MODULO = '%' ![=] - META_ASSIGN = '=' ![=] - META_ASSIGNADD = '+=' - META_ASSIGNSUB = '-=' - META_ASSIGNMUL = '*=' - META_ASSIGNDIV = '/=' - META_ASSIGNMOD = '%=' - META_ASSIGNBITOR = '|=' - META_ASSIGNBITXOR = '^=' - META_ASSIGNBITAND = '&=' - META_ASSIGNSHLEFT = '<<=' - META_ASSIGNSHRIGHT = '>>=' - META_QUERY = '?' - META_COLON = ':' - META_SEMICOLON = ';' - META_COMMA = ',' - META_DOT = '.' - #META_BACKTICK = '`' - META_AT = '@' - META_LCB = '{' - META_RCB = '}' - META_LBRAC = '[' - META_RBRAC = ']' - META_LPAREN = '(' - META_RPAREN = ')' - META_DQUOTE = '"' META_SQUOTE = "'" %% ; 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; } #define _DO(NAME) case t_##NAME: DO_C_PROTOS(); break; #undef _DO } 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; oop outputProgram= 0; void outputNode(oop node); void printTree(oop element, language id); 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 (!yylval) { // EOF fclose(inputStack->file); if (top == inputStack) break; inputStackPop(); assert(inputStack); continue; } assert(yylval); if (null == yylval) { // change of language or input file continue; } oop proto = map_get(yylval, __proto___symbol); if (proto == null) { printf("no prototype associated with "); println(yylval); fflush(stdout); fprintf(stderr, "aborting\n"); exit(1); } // proto_number is the enum version of the proto symbol proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype); if (proto_number > META_PROTO_MAX) { if (opt_v > 1) println(yylval); map_append(outputProgram, yylval); continue; } if (toPrint) { printLang = META; printTree(yylval, printLang); } else { if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber); 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 outputNode(oop node) { if (!node) return; switch (getType(node)) { case Undefined: return; case String: outputText(get(node, String, value)); return; case Map: break; 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_string: 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_if: outputNode(map_get(node, ifTok_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, elseTok_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, whileTok_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, doTok_symbol)); outputNode(map_get(node, statements_symbol)); outputNode(map_get(node, whileTok_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, forTok_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_goto: outputNode(map_get(node, gotoTok_symbol)); outputNode(map_get(node, star_symbol)); outputNode(map_get(node, name_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_initializer: outputNode(map_get(node, leftCurly_symbol)); outputNode(map_get(node, initList_symbol)); outputNode(map_get(node, comma_symbol)); outputNode(map_get(node, rightCurly_symbol)); break; case t_C_range: outputNode(map_get(node, constExpr1_symbol)); outputNode(map_get(node, ellipsis_symbol)); outputNode(map_get(node, constExpr2_symbol)); break; case t_C_switch: outputNode(map_get(node, switchTok_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_case: outputNode(map_get(node, caseTok_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, colon_symbol)); outputNode(map_get(node, statements_symbol)); break; case t_C_default: outputNode(map_get(node, defaultTok_symbol)); outputNode(map_get(node, colon_symbol)); outputNode(map_get(node, statements_symbol)); break; case t_C_attribution: outputNode(map_get(node, specifiers_symbol)); outputNode(map_get(node, declarators_symbol)); break; case t_C_deref: outputNode(map_get(node, star_symbol)); outputNode(map_get(node, typeQualList_symbol)); outputNode(map_get(node, declarators_symbol)); break; case t_C_functionDef: outputNode(map_get(node, specifiers_symbol)); outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, declarationL_symbol)); outputNode(map_get(node, compoundS_symbol)); break; case t_C_sizeOf: outputNode(map_get(node, sizeOfTok_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, typeName_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_alignOf: outputNode(map_get(node, alignOfTok_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, typeName_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_prefix: outputNode(map_get(node, operator_symbol)); outputNode(map_get(node, expression_symbol)); break; case t_C_postfix: outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, operator_symbol)); break; case t_C_unary: outputNode(map_get(node, operator_symbol)); outputNode(map_get(node, expression_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; case t_C_compound: outputNode(map_get(node, leftCurly_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rightCurly_symbol)); break; case t_C_subexpr: outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_call: outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, paramTypeL_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_array: outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, leftBracket_symbol)); outputNode(map_get(node, static_symbol)); outputNode(map_get(node, typeQualList_symbol)); outputNode(map_get(node, dynamic_symbol)); outputNode(map_get(node, assignExpr_symbol)); outputNode(map_get(node, rightBracket_symbol)); break; case t_C_block: outputNode(map_get(node, bxor_symbol)); outputNode(map_get(node, typeQualList_symbol)); outputNode(map_get(node, declarators_symbol)); break; case t_C_continue: outputNode(map_get(node, continueTok_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_break: outputNode(map_get(node, breakTok_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_return: outputNode(map_get(node, returnTok_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_exprStatement: outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_asm: outputNode(map_get(node, asmTok_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, text_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_asmExpr: outputNode(map_get(node, asmTok_symbol)); outputNode(map_get(node, volatileTok_symbol)); outputNode(map_get(node, gotoTok_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, text_symbol)); outputNode(map_get(node, element_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_asmExprArg: outputNode(map_get(node, text_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rparen_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_parameter: outputNode(map_get(node, specifiers_symbol)); outputNode(map_get(node, declarators_symbol)); break; case t_C_conditional: outputNode(map_get(node, logicalOr_symbol)); outputNode(map_get(node, question_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, colon_symbol)); outputNode(map_get(node, condExpr_symbol)); break; case t_C_designation: outputNode(map_get(node, identifier_symbol)); outputNode(map_get(node, colon_symbol)); break; case t_C_index: outputNode(map_get(node, primaryExpr_symbol)); outputNode(map_get(node, leftBracket_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rightBracket_symbol)); break; case t_C_typeOf: outputNode(map_get(node, typeOfTok_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, typeName_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_cast: outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, typeName_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, expression_symbol)); break; case t_C_attributeSpec: outputNode(map_get(node, attributeTok_symbol)); outputNode(map_get(node, llparen_symbol)); outputNode(map_get(node, lrparen_symbol)); outputNode(map_get(node, attributeL_symbol)); outputNode(map_get(node, rlparen_symbol)); outputNode(map_get(node, rrparen_symbol)); break; case t_C_aggregate: outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, typeName_symbol)); outputNode(map_get(node, rparen_symbol)); outputNode(map_get(node, leftCurly_symbol)); outputNode(map_get(node, initList_symbol)); outputNode(map_get(node, comma_symbol)); outputNode(map_get(node, rightCurly_symbol)); break; case t_C_attribute: outputNode(map_get(node, text_symbol)); outputNode(map_get(node, lparen_symbol)); outputNode(map_get(node, expression_symbol)); outputNode(map_get(node, rparen_symbol)); break; case t_C_label: outputNode(map_get(node, name_symbol)); outputNode(map_get(node, colon_symbol)); outputNode(map_get(node, attributeL_symbol)); outputNode(map_get(node, statements_symbol)); break; case t_C_labelDeclaration: outputNode(map_get(node, labels_symbol)); outputNode(map_get(node, element_symbol)); outputNode(map_get(node, semicolon_symbol)); break; case t_C_structSpec: outputNode(map_get(node, structTok_symbol)); outputNode(map_get(node, attribute1_symbol)); outputNode(map_get(node, name_symbol)); outputNode(map_get(node, leftCurly_symbol)); outputNode(map_get(node, declarationL_symbol)); outputNode(map_get(node, rightCurly_symbol)); outputNode(map_get(node, attribute2_symbol)); break; case t_C_structDeclarator: outputNode(map_get(node, declarators_symbol)); outputNode(map_get(node, colon_symbol)); outputNode(map_get(node, expression_symbol)); break; case t_C_enumSpec: outputNode(map_get(node, enumTok_symbol)); outputNode(map_get(node, name_symbol)); outputNode(map_get(node, leftCurly_symbol)); outputNode(map_get(node, enumList_symbol)); outputNode(map_get(node, rightCurly_symbol)); break; case t_C_enum: outputNode(map_get(node, name_symbol)); outputNode(map_get(node, attributeL_symbol)); outputNode(map_get(node, expression_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)); } void outputValue(oop node) { if (!node) return; switch (getType(node)) { case Undefined: return; case String: printf("<%s>\n", (get(node, String, value))); return; case Map: break; case Symbol: printf("<%s>\n", get(node, Symbol, name)); return; case Integer: printf("<%lli>\n", getInteger(node)); return; case Float: printf("<%Lf>\n", getFloat(node)); return; default: fprintf(stderr, "\noutputNode: unknown node type %i\n", getType(node)); abort(); } } void printSpace(int depth) { for (int i = 0 ; i < depth ; i++) { printf(" "); } } void outputTree(oop node, int depth) { if(node == null) { printSpace(depth); printf("\n"); return; } 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; outputTree(get(node, Map, elements)[i].value, depth); } return; } // proto_number is the enum version of the proto symbol proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype); printSpace(depth); switch (proto_number) { #define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME); #define OUT(NAME) printSpace(depth+DELTA); outputValue(map_get(node, text_symbol)); CASE(Comment) OUT(Comment); break; CASE(Token) OUT(Token); break; #undef CASE #undef OUT /** C terminal nodes */ #define CASE(NAME) case t_C_##NAME:printf("%s:\n", #NAME); #define OUT(NAME) printSpace(depth+DELTA) ; outputValue(map_get(node, NAME##_symbol)); CASE(int) OUT(text); break; CASE(float) OUT(text); break; CASE(string) OUT(text); break; CASE(char) OUT(value); break; CASE(id) OUT(identifier); break; #undef CASE /** Meta terminal nodes */ #define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME); CASE(Symbol) OUT(value); break; CASE(Integer) OUT(value); break; CASE(Float) OUT(value); break; CASE(String) OUT(value); break; #undef CASE #undef OUT /** C nodes */ #define CASE(NAME) case t_C_##NAME:printf("%s:\n", #NAME); #define OUT(NAME) printSpace(depth+DELTA); printf("(%s)\n", #NAME); outputTree(map_get(node, NAME##_symbol), depth+2*DELTA); CASE(if) OUT(ifTok); OUT(lparen); OUT(condition); OUT(rparen); OUT(consequent); OUT(elseTok); OUT(alternate); break; CASE(while) OUT(whileTok); OUT(lparen); OUT(expression); OUT(rparen); OUT(statements) break; CASE(do) OUT(doTok); OUT(statements); OUT(whileTok); OUT(lparen); OUT(expression); OUT(rparen); OUT(semicolon); break; CASE(for) OUT(forTok); OUT(lparen); OUT(initExpr); OUT(firstSemi); OUT(condExpr); OUT(secondSemi); OUT(incrExpr); OUT(rparen); OUT(statements); break; CASE(goto) OUT(gotoTok); OUT(star); OUT(name); OUT(semicolon); break; CASE(initializer) OUT(leftCurly); OUT(initList); OUT(comma); OUT(rightCurly); break; CASE(range) OUT(constExpr1); OUT(ellipsis); OUT(constExpr2); break; CASE(switch) OUT(switchTok); OUT(lparen); OUT(expression); OUT(rparen); OUT(statements); break; CASE(case) OUT(caseTok); OUT(expression); OUT(colon); OUT(statements); break; CASE(default) OUT(defaultTok); OUT(colon); OUT(statements); break; CASE(attribution) OUT(specifiers); OUT(declarators); break; CASE(deref) OUT(star); OUT(typeQualList); OUT(declarators); break; CASE(functionDef) OUT(specifiers); OUT(declarators); OUT(declarationL); OUT(compoundS); break; CASE(sizeOf) OUT(sizeOfTok); OUT(lparen); OUT(typeName); OUT(rparen); break; CASE(alignOf) OUT(alignOfTok); OUT(lparen); OUT(typeName); OUT(rparen); break; CASE(prefix) OUT(operator); OUT(expression); break; CASE(postfix) OUT(expression); OUT(operator); break; CASE(unary) OUT(operator); OUT(expression); break; CASE(binary) OUT(lhs); OUT(binary); OUT(rhs); break; CASE(compound) OUT(leftCurly); OUT(expression); OUT(rightCurly); break; CASE(subexpr) OUT(lparen); OUT(declarators); OUT(rparen); break; CASE(call) OUT(declarators); OUT(lparen); OUT(paramTypeL); OUT(rparen); break; CASE(array) OUT(declarators); OUT(leftBracket); OUT(static); OUT(typeQualList); OUT(dynamic); OUT(assignExpr); OUT(rightBracket); break; CASE(block) OUT(bxor); OUT(typeQualList); OUT(declarators); break; CASE(continue) OUT(continueTok); OUT(semicolon); break; CASE(break) OUT(breakTok); OUT(semicolon); break; CASE(return) OUT(returnTok); OUT(expression); OUT(semicolon); break; CASE(exprStatement) OUT(expression); OUT(semicolon); break; CASE(asm) OUT(asmTok); OUT(lparen); OUT(text); OUT(rparen); break; CASE(asmExpr) OUT(asmTok); OUT(volatileTok); OUT(gotoTok); OUT(lparen); OUT(text); OUT(element); OUT(rparen); break; CASE(asmExprArg) OUT(text); OUT(lparen); OUT(expression); OUT(rparen); break; CASE(declaration) OUT(specifiers); OUT(declarators); OUT(semicolon); break; CASE(parameter) OUT(specifiers); OUT(declarators); break; CASE(conditional) OUT(logicalOr); OUT(question); OUT(expression); OUT(colon); OUT(condExpr); break; CASE(designation) OUT(identifier); OUT(colon); break; CASE(index) OUT(primaryExpr); OUT(leftBracket); OUT(expression); OUT(rightBracket); break; CASE(typeOf) OUT(typeOfTok); OUT(lparen); OUT(typeName); OUT(expression); OUT(rparen); break; CASE(cast) OUT(lparen); OUT(typeName); OUT(rparen); OUT(expression); break; CASE(attributeSpec) OUT(attributeTok); OUT(llparen); OUT(lrparen); OUT(attributeL); OUT(rlparen); OUT(rrparen); break; CASE(aggregate) OUT(lparen); OUT(typeName); OUT(rparen); OUT(leftCurly); OUT(initList); OUT(comma); OUT(rightCurly); break; CASE(attribute) OUT(text); OUT(lparen); OUT(expression); OUT(rparen); break; CASE(label) OUT(name); OUT(colon); OUT(attributeL); OUT(statements); break; CASE(labelDeclaration) OUT(labels); OUT(element); OUT(semicolon); break; CASE(structSpec) OUT(structTok); OUT(attribute1); OUT(name); OUT(leftCurly); OUT(declarationL); OUT(rightCurly); OUT(attribute2); break; CASE(structDeclarator) OUT(declarators); OUT(colon); OUT(expression); break; CASE(enumSpec) OUT(enumTok); OUT(name); OUT(leftCurly); OUT(enumList); OUT(rightCurly); break; CASE(enum) OUT(name); OUT(attributeL); OUT(expression); break; #undef CASE /** Meta nodes */ #define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME); CASE(Map) OUT(value); break; CASE(Declaration) OUT(lhs); OUT(rhs); break; CASE(If) OUT(condition); OUT(consequent); OUT(alternate); break; CASE(While) OUT(condition); OUT(body); break; CASE(Do) OUT(body); OUT(condition); break; CASE(For) OUT(initialise); OUT(condition); OUT(update); OUT(body); break; CASE(ForIn) OUT(name); OUT(expression); OUT(body); break; CASE(Switch) OUT(expression); OUT(labels); OUT(statements); break; CASE(Func) OUT(name); OUT(param); OUT(body); OUT(fixed); break; CASE(Call) OUT(func); OUT(args); break; CASE(Invoke) OUT(this); OUT(name); OUT(args); break; CASE(Block) OUT(statements); break; CASE(Break) break; CASE(Try) OUT(try); OUT(exception); OUT(catch); OUT(finally); break; CASE(Return) OUT(value); break; CASE(Logor) OUT(lhs); OUT(rhs); break; CASE(Logand) OUT(lhs); OUT(rhs); break; CASE(Continue) break; CASE(Bitand) OUT(lhs); OUT(rhs); break; CASE(Bitor) OUT(lhs); OUT(rhs); break; CASE(Bitxor) OUT(lhs); OUT(rhs); break; CASE(Equal) OUT(lhs); OUT(rhs); break; CASE(Noteq) OUT(lhs); OUT(rhs); break; CASE(Less) OUT(lhs); OUT(rhs); break; CASE(Lesseq) OUT(lhs); OUT(rhs); break; CASE(Greatereq) OUT(lhs); OUT(rhs); break; CASE(Greater) OUT(lhs); OUT(rhs); break; CASE(Shleft) OUT(lhs); OUT(rhs); break; CASE(Shright) OUT(lhs); OUT(rhs); break; CASE(Add) OUT(lhs); OUT(rhs); break; CASE(Sub) OUT(lhs); OUT(rhs); break; CASE(Mul) OUT(lhs); OUT(rhs); break; CASE(Div) OUT(lhs); OUT(rhs); break; CASE(Mod) OUT(lhs); OUT(rhs); break; CASE(Throw) OUT(rhs); break; CASE(Neg) OUT(rhs); break; CASE(Com) OUT(rhs); break; CASE(Not) OUT(rhs); break; CASE(PreIncVariable) OUT(rhs); break; CASE(PreIncMember) OUT(rhs); break; CASE(PreIncIndex) OUT(rhs); break; CASE(PostIncVariable) OUT(rhs); break; CASE(PostIncMember) OUT(rhs); break; CASE(PostIncIndex) OUT(rhs); break; CASE(PreDecVariable) OUT(rhs); break; CASE(PreDecMember) OUT(rhs); break; CASE(PreDecIndex) OUT(rhs); break; CASE(PostDecVariable) OUT(rhs); break; CASE(PostDecMember) OUT(rhs); break; CASE(PostDecIndex) OUT(rhs); break; /** TODO * CASE(Quasiquote) * PRINT(Quasiquote); * OUT(rhs); * break; * CASE(Unquote) * PRINT(Unquote); * OUT(rhs); * break; */ /** Unknown node */ default: printf("I cannot print a node with proto_number %i\n", proto_number); exit(0); } #undef PRINT #undef CASE #undef OUT } void printTree(oop element, language id) { if (id == C) printf("-- C program --\n"); else if (id == META) printf("-- Meta program --\n"); else fprintf(stderr, "Wrong language in printTree()"); outputTree(element, 3); printf("\n"); } int main(int argc, char **argv) { # if (USE_GC) GC_INIT(); # endif symbol_table= makeMap(); globals= makeMap(); outputProgram= 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); /* File scope */ pushScope(); #define _DO(NAME) set(intern(#NAME), Symbol, is_C_keyword, 1); DO_C_KEYWORDS() if(gnu) { DO_C_KEYWORDS_GNU(); } #undef _DO int repled = 0; /* Checking arguments */ while (argc-- > 1) { ++argv; if (!strcmp(*argv, "-g")) ++opt_g; else if (!strcmp(*argv, "-v")) ++opt_v; else if (!strcmp(*argv, "-t")) toPrint = 1; else if (!strcmp(*argv, "-")) { readEvalPrint(globals, NULL); repled= 1; } else { readEvalPrint(globals, *argv); repled= 1; } } if (!repled) { readEvalPrint(globals, NULL); } printLang = C; for (size_t i= 0; i < map_size(outputProgram); ++i) { oop element= get(outputProgram, Map, elements)[i].value; if (toPrint) printTree(element, printLang); else outputNode(element); } 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)); } popScope(); assert(!actualScope); return 0; (void)yyAccept; } // Local Variables: // indent-tabs-mode: nil // End: