From 71a087422fd5d77c8dfcd54c6c5e8c3ffd5c0c6d Mon Sep 17 00:00:00 2001 From: Ian Piumarta Date: Tue, 6 Jul 2021 15:54:15 +0900 Subject: [PATCH] Initial import of framework. --- Makefile | 25 + buffer.h | 128 +++ ccmeta-test.txt | 10 + ccmeta.leg | 2690 +++++++++++++++++++++++++++++++++++++++++++++++ object.c | 688 ++++++++++++ 5 files changed, 3541 insertions(+) create mode 100644 Makefile create mode 100644 buffer.h create mode 100644 ccmeta-test.txt create mode 100644 ccmeta.leg create mode 100644 object.c diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d649f29 --- /dev/null +++ b/Makefile @@ -0,0 +1,25 @@ +CFLAGS = -I/opt/local/include -std=gnu99 -Wall -Wno-unused-label -Wno-unused-function -g +LDLIBS = -L/opt/local/lib -lgc -lm + +MAIN = ccmeta + +all : $(MAIN) + +$(MAIN) : $(MAIN).c object.c buffer.h + $(CC) $(CFLAGS) -o $@ $@.c $(LDLIBS) + +.SUFFIXES: .leg .c + +.leg.c : + leg $< > $@.new + mv $@.new $@ + +tidy : .FORCE + rm -f *~ + +clean : .FORCE + rm -f $(MAIN) $(MAIN).c + +spotless : clean tidy + +.FORCE : diff --git a/buffer.h b/buffer.h new file mode 100644 index 0000000..dc4b7f7 --- /dev/null +++ b/buffer.h @@ -0,0 +1,128 @@ +#ifndef __buffer_h +#define __buffer_h + +#include +#include +#include +#include + +#define BUFFER_INITIALISER { 0, 0, 0 } + +#define DECLARE_BUFFER(TYPE, NAME) \ + \ +typedef struct \ +{ \ + TYPE *contents; \ + size_t position; \ + size_t capacity; \ +} NAME; \ + \ +extern inline NAME *new##NAME(NAME *b) \ +{ \ + return calloc(1, sizeof(NAME)); \ +} \ + \ +extern inline NAME *NAME##_release(NAME *b) \ +{ \ + if (b->contents) free(b->contents); \ + memset(b, 0, sizeof(NAME)); \ + return b; \ +} \ + \ +extern inline void NAME##_delete(NAME *b) \ +{ \ + NAME##_release(b); \ + free(b); \ +} \ + \ +extern inline void NAME##_clear(NAME *b) \ +{ \ + b->position= 0; \ +} \ + \ +extern inline size_t NAME##_position(NAME *b) \ +{ \ + return b->position; \ +} \ + \ +extern inline void NAME##_errorBounds(NAME *b, ssize_t index) \ +{ \ + fprintf(stderr, "index %zi out of bounds for "#NAME" of size %zi\n", index, b->capacity); \ + abort(); \ +} \ + \ +extern inline void NAME##_errorMemory(NAME *b) \ +{ \ + fprintf(stderr, "out of memory typing to grow "#NAME" of size %zi\n", b->capacity); \ + abort(); \ +} \ + \ +extern inline TYPE NAME##_get(NAME *b, ssize_t index) \ +{ \ + if (index >= 0) { \ + if (index < b->position) return b->contents[index]; \ + } \ + else { \ + if (b->position + index >= 0) return b->contents[b->position + index]; \ + } \ + NAME##_errorBounds(b, index); \ + abort(); \ + /* NOTREACHED */ \ +} \ + \ +extern inline NAME *NAME##_grow(NAME *b, size_t size) \ +{ \ + if (0 == size) size= 2; \ + if (b->capacity < size) { \ + b->contents= b->contents \ + ? realloc(b->contents, sizeof(TYPE) * size) \ + : malloc ( sizeof(TYPE) * size); \ + if (!b->contents) NAME##_errorMemory(b); \ + memset(b->contents + b->capacity, 0, sizeof(TYPE) * (size - b->capacity)); \ + b->capacity= size; \ + } \ + return b; \ +} \ + \ +extern inline TYPE NAME##_append(NAME *b, TYPE value) \ +{ \ + if (b->position == b->capacity) NAME##_grow(b, b->capacity * 2); \ + return b->contents[b->position++]= value; \ +} \ + \ +extern inline void NAME##_appendAll(NAME *b, const TYPE *s, size_t len) \ +{ \ + while (len--) NAME##_append(b, *s++); \ +} \ + \ +extern inline TYPE *NAME##_buffer(NAME *b) \ +{ \ + return b->contents; \ +} + +#define DECLARE_STRING_BUFFER(TYPE, NAME) \ + \ +DECLARE_BUFFER(TYPE, NAME); \ + \ +extern inline TYPE *NAME##_appendString(NAME *b, TYPE *string) \ +{ \ + for (TYPE *ptr= string; *ptr; ++ptr) NAME##_append(b, *string++); \ + return string; \ +} \ + \ +extern inline TYPE *NAME##_contents(NAME *b) \ +{ \ + NAME##_append(b, 0); \ + b->position--; \ + return b->contents; \ +} + +#define buffer_do(T, V, B) \ + for ( size_t index_of_##V= 0; \ + index_of_##V < (B)->position; \ + index_of_##V = (B)->position ) \ + for ( T V; \ + index_of_##V < (B)->position && (V= (B)->contents[index_of_##V], 1); \ + ++index_of_##V ) + +#endif // __buffer_h diff --git a/ccmeta-test.txt b/ccmeta-test.txt new file mode 100644 index 0000000..875be29 --- /dev/null +++ b/ccmeta-test.txt @@ -0,0 +1,10 @@ +; +; +; +// comment +; +; +/* multi + * line + * comment + */ diff --git a/ccmeta.leg b/ccmeta.leg new file mode 100644 index 0000000..2a4550f --- /dev/null +++ b/ccmeta.leg @@ -0,0 +1,2690 @@ +%{ + +/* compile: leg -o parse.c parse.leg + * cc -o parse parse.c + * + * run: echo "3+4" | ./parse + */ + +#include +#include + +#define DO_PROTOS() \ + _DO(Undefined) _DO(Integer) _DO(Float) _DO(String) _DO(Symbol) _DO(Function) _DO(Map) \ + _DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \ + _DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \ + _DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand) \ + _DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) \ + _DO(Shleft) _DO(Shright) \ + _DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com) \ + _DO(PreIncVariable) _DO(PreIncMember) _DO(PreIncIndex) \ + _DO(PostIncVariable) _DO(PostIncMember) _DO(PostIncIndex) \ + _DO(PreDecVariable) _DO(PreDecMember) _DO(PreDecIndex) \ + _DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \ + _DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \ + _DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \ + /* _DO(Quasiquote) _DO(Unquote) */ \ + _DO(Comment) _DO(Token) \ + _DO(C_if) + +typedef enum { +t_UNDEFINED=0, +#define _DO(NAME) t_##NAME, +DO_PROTOS() +#undef _DO +} proto_t; + +#define SYMBOL_PAYLOAD proto_t prototype; + +#include "object.c" + +#include + +enum jb_t { + j_return = 1, + j_break, + j_continue, + j_throw, +}; + +typedef struct jb_record +{ + sigjmp_buf jb; + oop result; + struct jb_record *next; +} jb_record; + +jb_record *jbs= NULL; + +#define jbRecPush() \ + struct jb_record jbrec; \ + jbrec.next= jbs; \ + jbs= &jbrec + +#define jbRecPop() \ + assert(jbs == &jbrec); \ + jbs= jbrec.next + +// this is the global scope +oop globals= 0; + +#define DO_SYMBOLS() \ + DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__) \ + _DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate) \ + _DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise) \ + _DO(update) _DO(this) _DO(fixed) _DO(operator) _DO(map) _DO(func) \ + _DO(try) _DO(catch) _DO(finally) _DO(exception) \ + _DO(__line__) _DO(__file__) \ + _DO(comment) \ + _DO(text) _DO(if) _DO(lparen) _DO(rparen) _DO(else) + + +#define _DO(NAME) oop NAME##_symbol; +DO_SYMBOLS() +#undef _DO + +#define _DO(NAME) oop NAME##_proto; +DO_PROTOS() +#undef _DO + +int opt_g= 0; +int opt_v= 0; +oop mrAST= &_null; + +void printBacktrace(oop top); +void runtimeError(char *fmt, ...); + +typedef struct input_t +{ + oop name; + FILE *file; + struct input_t *next; + int lineNumber; +} input_t; + +input_t *inputStack= NULL; + +void inputStackPush(char *name) { + FILE *file = stdin; + if (NULL != name) { + file= fopen(name, "rb"); + if (NULL == file) { + perror(name); + exit(1); + } + } else { + name= ""; + } + input_t *input = malloc(sizeof(input_t)); + input->name= makeString(name); + input->lineNumber= 1; + input->file= file; + input->next= inputStack; + inputStack= input; + return; +} + +input_t *inputStackPop(void) { + assert(inputStack); + input_t *first= inputStack; + inputStack= first->next; + return first; +} + +int isFalse(oop obj) +{ + return obj == null || (isInteger(obj) && (0 == getInteger(obj))); +} + +int isTrue(oop obj) +{ + return !isFalse(obj); +} + +oop newObject(oop proto) +{ + oop map = makeMap(); + map_set(map, __proto___symbol, proto); + // set context (file and line) for runtime error msg + map_set(map, __line___symbol, makeInteger(inputStack->lineNumber)); + map_set(map, __file___symbol, inputStack->name); + return map; +} + +void printObjectName(oop object) +{ + assert(is(Map, object)); + oop name = map_get(object, __name___symbol); + if (name != null) { + println(name); + return; + } + + oop proto = map_get(object, __proto___symbol); + if (proto != null) { + printObjectName(proto); + } else { + fprintf(stderr, "\nThis map has no name\n"); + } +} + +// this always creates the key in "object" +oop newVariable(oop object, oop key, oop value) +{ + map_set(object, key, value); + return value; +} + +// this looks in object and everything in the __proto__ chain until it finds the key; +// if the key is not found and it is #__proto__ then the Map prototype is returned +oop getVariable(oop object, oop key) +{ + while (!map_hasKey(object, key)) { + object = map_get(object, __proto___symbol); + if (null == object) { + if (key == __proto___symbol) + return getVariable(globals, Map_symbol); + runtimeError("Undefined: %s", printString(key)); + } + } + return map_get(object, key); +} + +oop getMember(oop object, oop key) +{ + while (!map_hasKey(object, key)) { + object = map_get(object, __proto___symbol); + if (null == object) { + return null; + } + } + return map_get(object, key); +} + +// this follows the __proto__ chain until it finds the key, if it fails it behaves like newMember +oop setVariable(oop object, oop key, oop value) +{ + oop obj= object; + while (!map_hasKey(obj, key)) { + obj= map_get(obj, __proto___symbol); + if (null == obj) { + return map_set(object, key, value); + } + } + return map_set(obj, key, value); +} + +oop getProperty(oop object, oop key) +{ + if (!map_hasKey(object, key)) { + runtimeError("Undefined: .%s", printString(key)); + } + return map_get(object, key); +} + +oop newMap(oop value) +{ + oop map = newObject(Map_proto); + map_set(map, value_symbol, value); + return map; +} + +oop newDeclaration(oop name, oop exp) +{ + oop declaration = newObject(Declaration_proto); + map_set(declaration, lhs_symbol, name); + map_set(declaration, rhs_symbol, exp); + return declaration; +} + +oop new_C_if(oop ifTok, oop lParen, oop condition, oop rParen, oop consequent, oop elseTok, oop alternate) +{ + oop obj = newObject(C_if_proto); + map_set(obj, if_symbol, ifTok); + map_set(obj, lparen_symbol, lParen); + map_set(obj, condition_symbol, condition); + map_set(obj, rparen_symbol, rParen); + map_set(obj, consequent_symbol, consequent); + map_set(obj, else_symbol, elseTok); + map_set(obj, alternate_symbol, alternate); + return obj; +} + +oop 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; +} + +int digitValue(int c) +{ + if (c < '0') return -1; + if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c) + if ('9' < c && c < 'A') return -1; + if ('Z' < c) return -1; + if (c >= 'A') c -= ('A' - 10); else c -= '0'; + return c; +} + +int isradix(int r, int c) +{ + c= digitValue(c); + return 0 <= c && c < r; +} + +char *unescape(char *s) +{ + char *t= strdup(s); + int in= 0, out= 0, c= 0; + while (0 != (c= t[in++])) { + if ('\\' == c && 0 != (c= t[in])) { + ++in; + switch (c) { + case 'a': c= '\a'; break; + case 'b': c= '\b'; break; + case 'e': c= '\e'; break; + case 'f': c= '\f'; break; + case 'n': c= '\n'; break; + case 'r': c= '\r'; break; + case 't': c= '\t'; break; + case 'v': c= '\v'; break; + case '0'...'7': { + c -= '0'; + if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; + if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; + break; + } + case 'x': { + c= 0; + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + break; + } + case 'u': { + c= 0; + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); + break; + } + } + } + t[out++]= c; + } + t[out]= 0; + return t; +} + +oop newString(oop str) +{ assert(is(String, str)); + oop string = newObject(String_proto); + map_set(string, value_symbol, str); + return string; +} + +oop 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; +} + +#define YY_INPUT(buf, result, max_size) \ +{ \ + int yyc= feof(inputStack->file) ? EOF : getc(inputStack->file); \ + result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \ +} + +#define YYSTYPE oop + +YYSTYPE yylval; + +int errorLine= 1; + +void syntaxError(char *text) +{ + fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text); + exit(1); +} + +oop eval(oop scope, oop ast); + +struct _yycontext; + +int yyparsefrom(int (*yystart)(struct _yycontext *yy)); + +int irow= 0, icol= 0; +int gnu= 1; + +char *errmsg= "no error"; + +void error(char *source) +{ + fprintf(stderr, "\n%s near: %s\n", errmsg, source); + exit(1); +} + +#define newBegin() newToken("{") +#define newEnd() newToken("}") + +oop newToken(char *text) +{ + oop obj = newObject(Token_proto); + map_set(obj, text_symbol, makeString(text)); + return obj; +} + +oop newComment(char *text) +{ + oop obj = newObject(Comment_proto); + map_set(obj, text_symbol, makeString(text)); + return obj; +} + +void setComment(oop ast, oop comment) +{ + map_set(ast, comment_symbol, comment); +} + +%} + + +start = externalDeclaration + +error = EOL* < (!EOL .)* EOL* (!EOL .)* > &{ error(yytext), 1 } + +#|### A.1.3 Identifiers +#| +#|# 6.4.2.1 +#| +#|idOpt = id | {$$=0} +#| +#|id = { $$= newId(yytext) } - +#|ID = &{ !intern(yytext)->isKeyword } +#| +#|name = { $$= newId(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? > { $$= newInt(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 )> { $$= newFloat(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 "'" > { $$= newChar(yytext) } - +#| | < "L'" cCharSequence "'" > { $$= newChar(yytext) } - +#| +#|cCharSequence = ( escapeSequence | !EOL [^\'\\] )* +#| +#|escapeSequence = simpleEscapeSequence +#| | octalEscapeSequence +#| | hexadecimalEscapeSequence +#| | universalCharacterName +#| | '\\' EOL +#| | '\\' Blank+ EOL &{gnu} +#| | '\\' . &{gnu} +#| +#|simpleEscapeSequence = '\\'([\'\"?\\abfnrtv] | 'e' &{gnu}) +#| +#|octalEscapeSequence = '\\' octalDigit octalDigit? octalDigit? +#| +#|hexadecimalEscapeSequence = '\\x' hexadecimalDigit+ +#| +#|### A.1.6 String literals +#| +#|# 6.4.5 +#| +#|stringLiteral = { $$= listBegin() } +#| ( s:stringLiteralPart { listAppend(s) } +#| )+ { $$= newString(listEnd()) } +#| +#|stringLiteralPart = < '"' sCharSequence '"' > { $$= newText(yytext) } - +#| | < 'L''"' sCharSequence '"' > { $$= newText(yytext) } - +#| +#|sCharSequence = ( escapeSequence | !EOL [^\"\\] )* +#| +#|### A.2.1 Expressions +#| +#|# 6.5.1 +#| +#|primaryExpression = stringLiteral | constant | id +#| | l:LPAREN x:expression r:RPAREN { $$= newSubexpr(l, x, r) } +#| | l:LPAREN x:compoundStatement r:RPAREN &{gnu} { $$= newSubexpr(l, x, r) } +#| +#|# 6.5.2 +#| +#|postfixExpression = o:LPAREN l:typeName p:RPAREN +#| a:LCURLY r:initializerList ( c:COMMA | {c=0} ) b:RCURLY { $$= newAggregate(o, l, p, a, r, c, b) } +#| | l:primaryExpression +#| ( o:LBRACKET r:expression p:RBRACKET { l= newIndex(l, o, r, p) } +#| | o:LPAREN r:argumentExpressionList p:RPAREN { l= newCall(l, o, r, p) } +#| | o:DOT r:id { l= newBinary(l, o, r) } +#| | o:PTR r:id { l= newBinary(l, o, r) } +#| | o:INC { l= newPostfix(l, o) } +#| | o:DEC { l= newPostfix(l, o) } +#| )* { $$= l } +#| +#|argumentExpressionList = { listBegin() } +#| ( x:assignmentExpression { listAppend(x) } +#| ( c:COMMA x:assignmentExpression { listAppend2(c, x) } +#| )* +#| )? { $$= listEnd() } +#| +#|# 6.5.3 +#| +#|unaryExpression = o:INC x:unaryExpression { $$= newPrefix(o, x) } +#| | o:DEC x:unaryExpression { $$= newPrefix(o, x) } +#| | o:unaryOperator x:castExpression { $$= newUnary(o, x) } +#| | s:SIZEOF ( l:LPAREN t:typeName r:RPAREN { $$= newSizeof(s, l, t, r) } +#| | x:unaryExpression { $$= newSizeof(s, 0, x, 0) } +#| ) +#| | s:ALIGNOF ( l:LPAREN t:typeName r:RPAREN { $$= newAlignof(s, l, t, r) } +#| | x:unaryExpression { $$= newAlignof(s, 0, x, 0) } +#| ) &{gnu} +#| | asmExpr &{gnu} +#| | postfixExpression +#| +#|unaryOperator = BAND | STAR | PLUS | MINUS | BNOT | LNOT +#| | LAND &{gnu} +#| | REAL &{gnu} +#| | IMAG &{gnu} +#| +#|# 6.5.4 +#| +#|castExpression = l:LPAREN t:typeName r:RPAREN x:castExpression { $$= newCast(l, t, r, x) } +#| | unaryExpression +#| +#|# 6.5.5 +#| +#|multiplicativeExpression = l:castExpression +#| ( o:multiplicativeOperator r:castExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|multiplicativeOperator = STAR | DIV | MOD +#| +#|# 6.5.6 +#| +#|additiveExpression = l:multiplicativeExpression +#| ( o:additiveOperator r:multiplicativeExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|additiveOperator = PLUS | MINUS +#| +#|# 6.5.7 +#| +#|shiftExpression = l:additiveExpression +#| ( o:shiftOperator r:additiveExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|shiftOperator = LSHIFT | RSHIFT +#| +#|# 6.5.8 +#| +#|relationalExpression = l:shiftExpression +#| ( o:relationalOperator r:shiftExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|relationalOperator = LT | LTE | GT | GTE +#| +#|# 6.5.9 +#| +#|equalityExpression = l:relationalExpression +#| ( o:equalityOperator r:relationalExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|equalityOperator = EQUAL | NOT_EQUAL +#| +#|# 6.5.10 +#| +#|andExpression = l:equalityExpression +#| ( o:BAND r:equalityExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|# 6.5.11 +#| +#|exclusiveOrExpression = l:andExpression +#| ( o:BXOR r:andExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|# 6.5.12 +#| +#|inclusiveOrExpression = l:exclusiveOrExpression +#| ( o:BOR r:exclusiveOrExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|# 6.5.13 +#| +#|logicalAndExpression = l:inclusiveOrExpression +#| ( o:LAND r:inclusiveOrExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|# 6.5.14 +#| +#|logicalOrExpression = l:logicalAndExpression +#| ( o:LOR r:logicalAndExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|# 6.5.15 +#| +#|conditionalExpression = l:logicalOrExpression +#| ( q:QUESTION m:expression c:COLON r:conditionalExpression { $$= newConditional(l, q, m, c, r) } +#| | q:QUESTION c:COLON r:conditionalExpression &{gnu} { $$= newConditional(l, q, 0, c, r) } +#| | { $$= l } +#| ) +#| +#|# 6.5.16 +#| +#|assignmentExpressionOpt = assignmentExpression | {$$=0} +#| +#|assignmentExpression = l:unaryExpression o:assignmentOperator r:assignmentExpression { $$= newBinary(l, o, r) } +#| | conditionalExpression +#| +#|assignmentOperator = ASSIGN +#| | STAR_ASSIGN | DIV_ASSIGN | MOD_ASSIGN | PLUS_ASSIGN | MINUS_ASSIGN +#| | LSHIFT_ASSIGN | RSHIFT_ASSIGN | BAND_ASSIGN | BXOR_ASSIGN | BOR_ASSIGN +#| +#|# 6.5.17 +#| +#|expression = l:assignmentExpression +#| ( o:COMMA r:assignmentExpression { l= newBinary(l, o, r) } +#| )* { $$= l } +#| +#|expressionOpt = expression | { $$= 0 } +#| +#|constantExpression = conditionalExpression +#| +#|### A.2.2 Declarations +#| +#|# 6.7 +#| +#|declaration = @{ declarationBegin() } +#| ( s:declarationSpecifiers +#| d:initDeclaratorListOpt +#| t:SEMI { $$= newDeclaration(s, d, t) } +#| @{ declarationEnd() } +#| | &{ declarationAbort() } +#| ) +#| +#|declarationSpecifiers = @{ int specified= 0 } { listBegin() } +#| ( s:storageClassSpecifier { listAppend(s) } +#| | s:typeSpecifier @{ specified++ } { listAppend(s) } +#| | s:typedefName &{ !specified++ } { listAppend(s) } +#| | s:typeQualifier { listAppend(s) } +#| | s:functionSpecifier { listAppend(s) } +#| )+ { $$= listEnd() } +#| | &{gnu} { $$= 0 } +#| +#|initDeclaratorListOpt = initDeclaratorList | { $$= 0 } +#| +#|initDeclaratorList = d:initDeclarator { listWith(d) } +#| ( c:COMMA d:initDeclarator { listAppend2(c, d) } +#| )* { $$= listEnd() } +#| +#|initDeclarator = d:declarator +#| ( a:ASSIGN i:initializer { d= newBinary(d, a, i) } +#| )? { $$= d } +#| +#|# 6.7.1 +#| +#|storageClassSpecifier = TYPEDEF @{ declarationTypedef() } +#| | AUTO +#| | parameterStorageClassSpecifier +#| | functionStorageClassSpecifier +#| +#|parameterStorageClassSpecifier = REGISTER +#| +#|functionStorageClassSpecifier = EXTERN | STATIC +#| +#|# 6.7.2 +#| +#|typeSpecifier = VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE | SIGNED | UNSIGNED | BOOL | COMPLEX +#| | structOrUnionSpecifier +#| | enumSpecifier +#| # Any list of specifiers and qualifiers at the start of a declaration may contain attribute specifiers +#| | attributeSpecifier &{gnu} +#| +#|# 6.7.2.1 +#| +#|structOrUnionSpecifier = s:structOrUnion +#| # An attribute specifier list may appear as part of a struct, union or enum specifier. It may go +#| # either immediately after the struct, union or enum keyword... +#| ( a:attributeSpecifiers &{gnu} | {a=0} ) +#| ( i:idOpt ( @{ scopeBegin() } +#| l:LCURLY d:structDeclarationList r:RCURLY +#| @{ scopeEnd() } +#| | &{ scopeAbort() } +#| ) +#| # ..., or after the closing brace. +#| ( b:attributeSpecifiers &{gnu} | {b=0} ) +#| | i:id {l=d=r=b=0} +#| ) { $$= newStructSpec(s, a, i, l, d, r, b) } +#| +#|structOrUnion = STRUCT | UNION +#| +#|structDeclarationList = d:structDeclaration { listWith(d) } +#| ( d:structDeclaration { listAppend(d) } +#| )* { $$= listEnd() } +#| | &{gnu} { $$= 0 } +#| +#|structDeclaration = s:specifierQualifierList d:structDeclaratorList t:SEMI +#| ( &SEMI { listWith(t) } +#| ( t:SEMI { listAppend(t) } +#| )* &{gnu} { t= listEnd() } +#| )? { $$= newDeclaration(s, d, t) } +#| +#|specifierQualifierList = @{ int specified= 0 } { listBegin() } +#| ( ( t:typeSpecifier @{ specified++ } +#| | t:typedefName &{ !specified++ } +#| | t:typeQualifier +#| ) { listAppend(t) } +#| )+ { $$= listEnd() } +#| +#|structDeclaratorList = d:structDeclarator { listWith(d) } +#| ( c:COMMA d:structDeclarator { listAppend2(c, d) } +#| )* { $$= listEnd() } +#| | &{gnu} { $$= 0 } +#| +#|structDeclarator = ( c:COLON e:constantExpression { d= newStructDeclarator(0, c, e) } +#| | d:declarator ( c:COLON e:constantExpression | {c=e=0} ) { d= newStructDeclarator(d, c, e) } +#| ) +#| # An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier +#| ( a:attributeSpecifiers { d= newAttribution(d, a) } +#| )? { $$= d } +#| +#|# 6.7.2.2 +#| +#|enumSpecifier = e:ENUM +#| ( i:idOpt l:LCURLY m:enumeratorList r:RCURLY { $$= newEnumSpec(e, i, l, m, r) } +#| | i:id { $$= newEnumSpec(e, i, 0, 0, 0) } +#| ) +#| +#|enumeratorList = e:enumerator { listWith(e) } +#| ( c:COMMA e:enumerator { listAppend(c); listAppend(e) } +#| )* +#| ( c:COMMA { listAppend(c) } +#| )? { $$= listEnd() } +#| +#|enumerator = i:id +#| # an attribute specifier list may appear as part of an enumerator. The attribute goes after the +#| # enumeration constant, before =, if present. +#| ( a:attributeSpecifier &{gnu} { i= newAttribution(i, a) } +#| )* +#| ( a:ASSIGN e:constantExpression | {a=e=0} ) { $$= newEnumerator(i, a, e) } +#| +#|# 6.7.3 +#| +#|typeQualifier = CONST | RESTRICT | VOLATILE +#| +#|# 6.7.4 +#| +#|functionSpecifier = INLINE +#| +#|# 6.7.5 +#| +#|declarator = # An attribute specifier list may appear immediately before a declarator +#| a:attributeSpecifier d:declarator &{gnu} { $$= newAttribution(a, d) } +#| | p:STAR q:typeQualifierList d:declarator { $$= newDeref(p, q, d) } +#| | p:BXOR q:typeQualifierList d:declarator &{apl} { $$= newBlock(p, q, d) } +#| | ( d:directDeclarator +#| # An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier +#| ( &{gnu} a:attributeSpecifier { d= newAttribution(d, a) } +#| # an asm (or __asm__) keyword may appear after the declarator +#| | &{gnu} a:asm { d= newAttribution(d, a) } +#| )* +#| ) { $$= d } +#| +#|directDeclarator = ( l:LPAREN d:declarator r:RPAREN { d= newSubexpr(l, d, r) } +#| | &( @{ declarationId(yytext) } ) +#| d:id +#| ) ( @{ scopeBegin() } +#| ( l:LPAREN p:parameterTypeList r:RPAREN { d= newCall (d, l, p, r) } +#| @{ scopeEnd() } +#| | l:LPAREN p:identifierListOpt r:RPAREN { d= newCall (d, l, p, r) } +#| @{ scopeEnd() } +#| | l:LBRACKET ( s:STATIC q:typeQualifierListOpt {t=0} e:assignmentExpression +#| | {s=0} q:typeQualifierList t:STATIC e:assignmentExpressionOpt +#| | {s=0} q:typeQualifierListOpt t:STAR {e=0} +#| | {s=0} q:typeQualifierListOpt {t=0} e:assignmentExpressionOpt ) r:RBRACKET { d= newArray(d, l, s, q, t, e, r) } +#| @{ scopeEnd() } +#| | &{ scopeAbort() } +#| ) +#| )* { $$= d } +#| +#|typeQualifierListOpt = typeQualifierList | {$$=0} +#| +#|typeQualifierList = { listBegin() } +#| ( t:typeQualifier { listAppend(t) } +#| )* { $$= listEnd() } +#| +#|parameterTypeListOpt = parameterTypeList | {$$=0} +#| +#|parameterTypeList = p:parameterList +#| ( c:COMMA v:ELLIPSIS { List_addLast(p, c); List_addLast(p, v) } +#| )? { $$= p } +#| +#|parameterList = p:parameterDeclaration { listWith(p) } +#| ( ( c:COMMA | c:SEMI &{gnu} ) { listAppend(c) } +#| p:parameterDeclaration { listAppend(p) } +#| )* { $$= listEnd() } +#| +#|parameterDeclaration = s:parameterDeclarationSpecifiers +#| ( d:declarator | d:abstractDeclaratorOpt ) { $$= newParameter(s, d) } +#| +#|parameterDeclarationSpecifiers +#| = @{ int specified= 0 } { listBegin() } +#| ( s:parameterStorageClassSpecifier { listAppend(s) } +#| | s:typeSpecifier @{ specified++ } { listAppend(s) } +#| | s:typedefName &{ !specified++ } { listAppend(s) } +#| | s:typeQualifier { listAppend(s) } +#| | s:functionSpecifier { listAppend(s) } +#| )+ { $$= listEnd() } +#| +#|identifierListOpt = identifierList | {$$=0} +#| +#|identifierList = i:id { listWith(i) } +#| ( c:COMMA i:id { listAppend2(c, i) } +#| )* { $$= listEnd() } +#| +#|# 6.7.6 +#| +#|typeName = s:specifierQualifierList d:abstractDeclaratorOpt { $$= newDeclaration(s, d, 0) } +#| +#|abstractDeclaratorOpt = abstractDeclarator | {$$=0} +#| +#|abstractDeclarator = p:STAR q:typeQualifierList d:abstractDeclaratorOpt { $$= newDeref(p, q, d) } +#| | p:BXOR q:typeQualifierList d:abstractDeclaratorOpt &{apl} { $$= newBlock(p, q, d) } +#| | directAbstractDeclarator +#| +#|directAbstractDeclarator= @{int nonEmpty= 0} +#| ( l:LPAREN d:abstractDeclarator r:RPAREN @{++nonEmpty} { d= newSubexpr(l, d, r) } +#| | {d=0} +#| ) ( l:LPAREN p:parameterTypeListOpt r:RPAREN @{++nonEmpty} { d= newCall (d, l, p, r) } +#| | l:LBRACKET +#| ( s:STATIC q:typeQualifierListOpt {t=0} e:assignmentExpression +#| | {s=0} q:typeQualifierList t:STATIC e:assignmentExpressionOpt +#| | {s=0} q:typeQualifierListOpt t:STAR {e=0} +#| | {s=0} q:typeQualifierListOpt {t=0} e:assignmentExpressionOpt +#| ) r:RBRACKET @{++nonEmpty} { d= newArray(d, l, s, q, t, e, r) } +#| )* &{nonEmpty} { $$= d } +#| +#|# 6.7.7 +#| +#|typedefName = &{ isTypedefName(yytext) } { $$= newId(yytext) } - +#| | t:TYPEOF l:LPAREN +#| ( x:expression r:RPAREN { $$= newTypeof(t, l, 0, x, r) } +#| | x:typeName r:RPAREN { $$= newTypeof(t, l, x, 0, r) } +#| ) &{gnu} +#| +#|# 6.7.8 +#| +#|initializer = l:LCURLY i:initializerList ( c:COMMA | {c=0} ) r:RCURLY { $$= newInitializer(l, i, c, r) } +#| | assignmentExpression +#| +#|initializerList = { listBegin() } +#| ( d:designation { listAppend(d) } +#| )? i:initializer { listAppend(i) } +#| ( c:COMMA { listAppend(c) } +#| ( d:designation { listAppend(d) } +#| )? i:initializer { listAppend(i) } +#| )* { $$= listEnd() } +#| | &{gnu} { $$= 0 } +#| +#|designation = ( d:designatorList ( a:ASSIGN | {a=0} &{gnu} ) +#| | d:id a:COLON &{gnu} +#| ) { $$= newDesignation(d, a) } +#| +#|designatorList = { listBegin() } +#| ( l:LBRACKET x:constantExpression r:RBRACKET { listAppend(newIndex(0, l, x, r)) } +#| | l:LBRACKET x:constantRange r:RBRACKET &{gnu} { listAppend(newIndex(0, l, x, r)) } +#| | l:DOT x:id { listAppend(newBinary(0, l, x)) } +#| )+ { $$= listEnd() } +#| +#|### A.2.3 Statements +#| +#|# 6.8 +#| +#|statement = expressionStatement +#| | labeledStatement +#| | compoundStatement +#| | selectionStatement +#| | iterationStatement +#| | jumpStatement +#| +#|# 6.8.1 +#| +#|labeledStatement = i:id c:COLON +#| # an attribute specifier list may appear after the colon following a label, other than a case or default label +#| ( a:attributeSpecifiers &{gnu} | {a=0} ) +#| s:statement { $$= newLabel(i, c, a, s) } +#| | c:CASE x:constantExpression d:COLON s:statement { $$= newCase(c, x, d, s) } +#| | c:CASE x:constantRange d:COLON s:statement &{gnu} { $$= newCase(c, x, d, s) } +#| | d:DEFAULT c:COLON s:statement { $$= newDefault(d, c, s) } +#| +#|# 6.8.2 +#| +#|compoundStatement = @{ scopeBegin() } +#| l:LCURLY { listBegin() } +#| ( x:localLabelDeclaration &{gnu} { listAppend(x) } +#| )* +#| ( x:declaration { listAppend(x) } +#| | x:statement { listAppend(x) } +#| | x:functionDefinition &{gnu} { listAppend(x) } +#| | !'}' &{ errmsg= "statement expected" } error +#| )* { x= listEnd() } +#| r:RCURLY { $$= newCompound(l, x, r) } +#| @{ scopeEnd() } +#| | &{ scopeAbort() } +#| +#|# 6.8.3 +#| +#|expressionStatement = SEMI +#| | x:expression s:SEMI { $$= newExprStatement(x, s) } +#| +#|# 6.8.4 +#| +#|selectionStatement = i:IF l:LPAREN x:expression r:RPAREN s:statement +#| ( e:ELSE t:statement | {e=t=0} ) { $$= newIf(i, l, x, r, s, e, t) } +#| | s:SWITCH l:LPAREN x:expression r:RPAREN t:statement { $$= newSwitch(s, l, x, r, t) } +#| +#|# 6.8.5 +#| +#|iterationStatement = w:WHILE l:LPAREN x:expression r:RPAREN s:statement { $$= newWhile(w, l, x, r, s) } +#| | d:DO s:statement w:WHILE l:LPAREN x:expression r:RPAREN t:SEMI { $$= newDo(d, s, w, l, x, r, t) } +#| | f:FOR l:LPAREN a:expressionOpt t:SEMI b:expressionOpt u:SEMI +#| c:expressionOpt r:RPAREN s:statement { $$= newFor(f, l, a, t, b, u, c, r, s) } +#| | f:FOR l:LPAREN a:declaration b:expressionOpt u:SEMI +#| c:expressionOpt r:RPAREN s:statement { $$= newFor(f, l, a, 0, b, u, c, r, s) } +#| +#|# 6.8.6 +#| +#|jumpStatement = g:GOTO i:id t:SEMI { $$= newGoto(g, 0, i, t) } +#| | c:CONTINUE t:SEMI { $$= newContinue(c, t) } +#| | b:BREAK t:SEMI { $$= newBreak(b, t) } +#| | r:RETURN x:expressionOpt t:SEMI { $$= newReturn(r, x, t) } +#| | g:GOTO s:STAR x:expression t:SEMI &{gnu} { $$= newGoto(g, s, x, t) } +#| +#|### A.2.4 External definitions +#| +#|# 6.9 +#| +#|translationUnit = externalDeclaration+ +#| +externalDeclaration = { yylval= newComment(yytext); } + | ( SEMI &{gnu} +#| | declaration +#| | functionDefinition +#| | meta + | &. &{ errmsg= "declaration expected" } error + ) { yylval= $$; } + +#|functionDefinition = @{ declarationBegin() } +#| ( s:functionDeclarationSpecifiers | &{gnu} {s=0} ) +#| d:declarator +#| l:declarationListOpt +#| c:compoundStatement { $$= newFunctionDefinition(s, d, l, c) } +#| @{ declarationEnd() } +#| | &{ declarationAbort() } +#| +#|functionDeclarationSpecifiers +#| = @{ int specified= 0 } { listBegin() } +#| ( s:functionStorageClassSpecifier { listAppend(s) } +#| | s:typeSpecifier @{ ++specified } { listAppend(s) } +#| | &{ !specified } s:typedefName @{ ++specified } { listAppend(s) } +#| | s:typeQualifier { listAppend(s) } +#| | s:functionSpecifier { listAppend(s) } +#| )+ { $$= listEnd() } +#| +#|declarationListOpt = declarationList | {$$=0} +#| +#|declarationList = d:declaration { $$= listWith(d) } +#| ( d:declaration { listAppend(d) } +#| )* { $$= listEnd() } +#| +#|### GNU C extensions +#| +#|# An attribute specifier is of the form __attribute__ ((attribute-list)). An attribute list is a +#|# possibly empty comma-separated sequence of attributes +#| +#|attributeSpecifier = a:ATTRIBUTE ll:LPAREN lr:LPAREN { listBegin() } +#| ( b:attribute { listAppend(b) } +#| )? ( c:COMMA { listAppend(c) } +#| ( b:attribute { listAppend(b) } +#| )? )* rl:RPAREN rr:RPAREN { $$= newAttributeSpec(a, ll, lr, listEnd(), rl, rr) } +#| +#|attributeSpecifiers = &ATTRIBUTE { listBegin() } +#| a:attributeSpecifier { listAppend(a) } +#| ( a:attributeSpecifier { listAppend(a) } +#| )* { $$= listEnd() } +#| +#|# where each attribute is one of the following: +#|# Empty. Empty attributes are ignored. +#|# An attribute name (which may be an identifier such as unused, or a reserved word such as const). +#|# An attribute name followed by a parenthesized list of parameters for the attribute. These parameters take one of the following forms: +#|# An identifier. For example, mode attributes use this form. +#|# An identifier followed by a comma and a non-empty comma-separated list of expressions. For example, format attributes use this form. +#|# A possibly empty comma-separated list of expressions. For example, format_arg attributes use this +#|# form with the list being a single integer constant expression, and alias attributes use +#|# this form with the list being a single string constant. +#| +#|attribute = n:name ( l:LPAREN { listBegin() } +#| ( p:expression { listAppend(p) } +#| ( p:COMMA { listAppend(p) } +#| p:expression { listAppend(p) } +#| )* +#| )? +#| r:RPAREN { p= listEnd() } +#| | {l=p=r=0} +#| ) { $$= newAttribute(n, l, p, r) } +#| +#|constantRange = a:constantExpression e:ELLIPSIS b:constantExpression { $$= newRange(a, e, b) } +#| +#|localLabelDeclaration = l:LABEL &{gnu} { listBegin() } +#| i:id { listAppend(i) } +#| ( c:COMMA i:id { listAppend2(c, i) } +#| )* +#| ( c:COMMA { listAppend(c) } +#| )? +#| s:SEMI { $$= newLabelDeclaration(l, listEnd(), s) } +#| +#|asm = a:ASM l:LPAREN s:stringLiteral r:RPAREN { $$= newAsm(a, l, s, r) } +#| +#|asmExpr = a:ASM ( v:VOLATILE | {v=0} ) ( g:GOTO | {g=0} ) +#| l:LPAREN s:stringLiteral { listBegin() } +#| ( c:COLON { listAppend(c) } +#| ( p:asmExprArgs { listAppend(p) } +#| )? +#| ( c:COLON { listAppend(c) } +#| ( p:asmExprArgs { listAppend(p) } +#| )? +#| ( c:COLON { listAppend(c) } +#| ( p:stringLiteralList { listAppend(p) } +#| )? +#| ( c:COLON { listAppend(c) } +#| ( p:ids { listAppend(p) } +#| )? +#| )? +#| )? +#| )? +#| )? +#| r:RPAREN { $$= newAsmExpr(a, v, g, l, s, listEnd(), r) } +#| +#|asmExprArgs = a:asmExprArg { listWith(a) } +#| ( c:COMMA a:asmExprArg { listAppend2(c, a) } +#| )* { $$= listEnd() } +#| +#|asmExprArg = s:stringLiteral ( l:LPAREN e:expression r:RPAREN | {l=e=r=0} ){ $$= newAsmExprArg(s, l, e, r) } +#| +#|stringLiteralList = s:stringLiteral { listWith(s) } +#| ( c:COMMA s:stringLiteral { listAppend2(c, s) } +#| )* { $$= listEnd() } +#| +#|ids = i:id { listWith(i) } +#| ( c:COMMA i:id { listAppend2(c, i) } +#| )* { $$= listEnd() } + +- = < Space* > { if (yyleng && $$) setComment($$, newComment(yytext)) } + +Space = Blank | Comment | EOL | Directive + | "__extension__" &{gnu} { icol += 13 } + +Blank = ( [\003-\010] | '\013' | '\f' | [\016-\037] | [\177-\377] | ' ' ) { ++icol } + | '\t' { icol= (icol + 8) & ~7 } + +EOL = ( "\r\n" | '\n' | '\r' ) { ++irow; icol= 0 } + +Comment = "/*" ( !"*/" (EOL | Any) )* "*/" + | "//" ( ![\n\r] Any )* EOL + +Directive = "#" (!EOL .)* + +Any = . { ++icol } + +### + +ASSIGN = '=' !'=' { $$= newToken("=" ) } - +COLON = ':' { $$= newToken(":" ) } - +COMMA = ',' { $$= newToken("," ) } - +QUESTION = '?' { $$= newToken("?" ) } - +SEMI = ';' { $$= newToken(";" ) } - +PTR = "->" { $$= newToken("->" ) } - + +DOT = '.' !'.' { $$= newToken("." ) } - +ELLIPSIS = '...' { $$= newToken("..." ) } - + +LPAREN = '(' { $$= newToken("(" ) } - +RPAREN = ')' { $$= newToken(")" ) } - +LBRACKET = '[' { $$= newToken("[" ) } - +RBRACKET = ']' { $$= newToken("]" ) } - +LCURLY = '{' { $$= newBegin( ) } - +RCURLY = '}' { $$= newEnd ( ) } - + +EQUAL = "==" { $$= newToken("==" ) } - +NOT_EQUAL = "!=" { $$= newToken("!=" ) } - +LTE = "<=" { $$= newToken("<=" ) } - +LT = "<" !'=' { $$= newToken("<" ) } - +GTE = ">=" { $$= newToken(">=" ) } - +GT = ">" !'=' { $$= newToken(">" ) } - + +DIV = '/' ![=*] { $$= newToken("/" ) } - +DIV_ASSIGN = "/=" { $$= newToken("/=" ) } - +PLUS = '+' ![+=] { $$= newToken("+" ) } - +PLUS_ASSIGN = "+=" { $$= newToken("+=" ) } - +INC = "++" { $$= newToken("++" ) } - +MINUS = '-' ![-=] { $$= newToken("-" ) } - +MINUS_ASSIGN = "-=" { $$= newToken("-=" ) } - +DEC = "--" { $$= newToken("--" ) } - +STAR = '*' !'=' { $$= newToken("*" ) } - +STAR_ASSIGN = "*=" { $$= newToken("*=" ) } - +MOD = '%' !'=' { $$= newToken("%" ) } - +MOD_ASSIGN = "%=" { $$= newToken("%=" ) } - +RSHIFT = ">>" !'=' { $$= newToken(">>" ) } - +RSHIFT_ASSIGN = ">>=" { $$= newToken(">>=" ) } - +LSHIFT = "<<" !'=' { $$= newToken("<<" ) } - +LSHIFT_ASSIGN = "<<=" { $$= newToken("<<=" ) } - + +LAND = "&&" { $$= newToken("&&" ) } - +LNOT = '!' !'=' { $$= newToken("!" ) } - +LOR = "||" { $$= newToken("||" ) } - + +BAND = '&' ![&=] { $$= newToken("&" ) } - +BAND_ASSIGN = "&=" { $$= newToken("&=" ) } - +BNOT = '~' { $$= newToken("~" ) } - +BOR = '|' ![|=] { $$= newToken("|" ) } - +BOR_ASSIGN = "|=" { $$= newToken("|=" ) } - +BXOR = '^' !'=' { $$= newToken("^" ) } - +BXOR_ASSIGN = "^=" { $$= newToken("^=" ) } - + +ALIGNOF = '__alignof__' !IDREST { $$= newToken("__alignof__" ) } - + | '__alignof' !IDREST { $$= newToken("__alignof" ) } - +ASM = 'asm' !IDREST { $$= newToken("asm" ) } - + | '__asm' !IDREST { $$= newToken("__asm" ) } - + | '__asm__' !IDREST { $$= newToken("__asm__" ) } - +ATTRIBUTE = '__attribute__' !IDREST { $$= newToken("__attribute__") } - +AUTO = 'auto' !IDREST { $$= newToken("auto" ) } - +BOOL = '_Bool' !IDREST { $$= newToken("_Bool" ) } - +BREAK = 'break' !IDREST { $$= newToken("break" ) } - +CASE = 'case' !IDREST { $$= newToken("case" ) } - +CHAR = 'char' !IDREST { $$= newToken("char" ) } - +COMPLEX = '_Complex' !IDREST { $$= newToken("_Complex" ) } - + | '__complex__' !IDREST &{gnu} { $$= newToken("__complex__" ) } - +CONST = 'const' !IDREST { $$= newToken("const" ) } - + | '__const' !IDREST { $$= newToken("__const" ) } - +CONTINUE = 'continue' !IDREST { $$= newToken("continue" ) } - +DEFAULT = 'default' !IDREST { $$= newToken("default" ) } - +DO = 'do' !IDREST { $$= newToken("do" ) } - +DOUBLE = 'double' !IDREST { $$= newToken("double" ) } - +ELSE = 'else' !IDREST { $$= newToken("else" ) } - +ENUM = 'enum' !IDREST { $$= newToken("enum" ) } - +EXTERN = 'extern' !IDREST { $$= newToken("extern" ) } - +FLOAT = 'float' !IDREST { $$= newToken("float" ) } - +FOR = 'for' !IDREST { $$= newToken("for" ) } - +GOTO = 'goto' !IDREST { $$= newToken("goto" ) } - +IF = 'if' !IDREST { $$= newToken("if" ) } - +INLINE = 'inline' !IDREST { $$= newToken("inline" ) } - + | '__inline__' !IDREST &{gnu} { $$= newToken("__inline__" ) } - +INT = 'int' !IDREST { $$= newToken("int" ) } - +LONG = 'long' !IDREST { $$= newToken("long" ) } - +REGISTER = 'register' !IDREST { $$= newToken("register" ) } - +RESTRICT = 'restrict' !IDREST { $$= newToken("restrict" ) } - +RETURN = 'return' !IDREST { $$= newToken("return" ) } - +SHORT = 'short' !IDREST { $$= newToken("short" ) } - +SIGNED = 'signed' !IDREST { $$= newToken("signed" ) } - +SIZEOF = 'sizeof' !IDREST { $$= newToken("sizeof" ) } - +STATIC = 'static' !IDREST { $$= newToken("static" ) } - +STRUCT = 'struct' !IDREST { $$= newToken("struct" ) } - +SWITCH = 'switch' !IDREST { $$= newToken("switch" ) } - +TYPEDEF = 'typedef' !IDREST { $$= newToken("typedef" ) } - +TYPEOF = 'typeof' !IDREST { $$= newToken("typeof" ) } - + | '__typeof__' !IDREST { $$= newToken("__typeof__" ) } - +UNION = 'union' !IDREST { $$= newToken("union" ) } - +UNSIGNED = 'unsigned' !IDREST { $$= newToken("unsigned" ) } - +VOID = 'void' !IDREST { $$= newToken("void" ) } - +VOLATILE = 'volatile' !IDREST { $$= newToken("volatile" ) } - +WHILE = 'while' !IDREST { $$= newToken("while" ) } - + +IMAG = '__imag__' !IDREST &{gnu} { $$= newToken("__imag__" ) } - +LABEL = '__label__' !IDREST &{gnu} { $$= newToken("__label__") } - +REAL = '__real__' !IDREST &{gnu} { $$= newToken("__real__" ) } - + +%% +; + + +oop map_zip(oop map, oop keys, oop values) +{ + assert(is(Map, map)); + assert(is(Map, keys)); + assert(is(Map, values)); + size_t sk= map_size(keys), sv= map_size(values); + if (sk < sv) sk= sv; + for (size_t i= 0; i < sk; ++i) { + oop key = i < sk && map_hasIntegerKey(keys, i) ? get(keys, Map, elements)[i].value : makeInteger(i); + oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null; + map_set(map, key, value); + } + return map; +} + +oop clone(oop obj) +{ + switch(getType(obj)) { + case Undefined: + case Integer: + case Float: + case Function: + case Symbol: + return obj; + case String: + return makeString(get(obj, String, value)); + case Map: { + struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity)); + memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity)); + oop map= malloc(sizeof(*obj)); + memcpy(map, obj, sizeof(*obj)); + set(map, Map, elements, elements); + return map; + } + } + return obj; +} + +struct Call +{ + oop ast, function; +}; + +DECLARE_BUFFER(struct Call, CallArray); + +CallArray backtrace= BUFFER_INITIALISER; + +struct Call CallArray_pop(CallArray *oa) +{ assert(oa->position > 0); + return oa->contents[--oa->position]; +} + +void trace(oop ast, oop func) +{ + CallArray_append(&backtrace, (struct Call){ ast, func }); +} + +void untrace(oop ast) +{ + struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast); +} + +void printLocation(oop ast) +{ + fflush(stdout); + if (!is(Map, ast)) return; + char *fileName = get (map_get(ast, __file___symbol), String, value); + int lineNumber = getInteger(map_get(ast, __line___symbol) ); + fprintf(stderr, "%s:%i", fileName, lineNumber); +} + +void printlnLocation(oop ast) +{ + fflush(stdout); + if (!is(Map, ast)) return; + printLocation(ast); + fprintf(stderr, "\n"); +} + +void printBacktrace(oop top) +{ + fflush(stdout); + printLocation(top); + while (CallArray_position(&backtrace) > 0) { + struct Call call= CallArray_pop(&backtrace); + if (is(Map, call.ast) && Call_proto == map_get(call.ast, __proto___symbol)) { + oop name= get(call.function, Function, name); + if (null != name) { + printf(" in "); + if (get(call.function, Function, primitive)) printf("primitive "); + else printf("function "); + println(get(call.function, Function, name)); + } + } + else { + printf("\n"); + } + printLocation(call.ast); + } + printf("\n"); +} + +void runtimeError(char *fmt, ...) +{ + fflush(stdout); + va_list ap; + va_start(ap, fmt); + fprintf(stderr, "\n"); + vfprintf(stderr, fmt, ap); + fprintf(stderr, "\n"); + va_end(ap); + printBacktrace(mrAST); + exit(1); +} + +#define TYPESIG(L, R) L*NTYPES+R +#define CASE(L, R) case TYPESIG(L, R) + +oop addOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value)); + CASE(String , String ): return string_concat(lhs, rhs); + } + runtimeError("addition between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop subOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value)); + } + runtimeError("substraction between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop mulOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value)); + CASE(String , Integer): return string_mul(lhs, rhs); + CASE(Integer, String ): return string_mul(rhs, lhs); + } + runtimeError("multiplication between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop divOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs)); + CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value)); + CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs)); + CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value)); + } + runtimeError("division between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +oop modOperation(oop lhs, oop rhs) +{ + switch (TYPESIG(getType(lhs), getType(rhs))) { + CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs)); + CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value))); + } + runtimeError("modulo between two incompatible types"); + return NULL; // to prevent: control may reach end of non-void function +} + +#undef TYPESIG +#undef CASE + +#if 0 + +oop expandUnquotes(oop scope, oop obj) +{ + obj = clone(obj); + if (!is(Map, obj)) { + return obj; + } + if (map_get(obj, __proto___symbol) == Unquote_proto) { + return eval(scope, map_get(obj, rhs_symbol)); + } + for (size_t i= 0; i < map_size(obj); ++i) { + struct Pair *pair= &get(obj, Map, elements)[i]; + if (__proto___symbol != pair->key) { + pair->value= expandUnquotes(scope, pair->value); + } + } + return obj; +} + +#endif + +oop applyOperator(oop op, oop lhs, oop rhs) +{ + if (null != op) { assert(is(Symbol, op)); + switch (get(op, Symbol, prototype)) { + case t_Add: return addOperation(lhs, rhs); + case t_Sub: return subOperation(lhs, rhs); + case t_Mul: return mulOperation(lhs, rhs); + case t_Div: return divOperation(lhs, rhs); + case t_Mod: return modOperation(lhs, rhs); + case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs)); + case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs)); + case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs)); + case t_Shleft: return makeInteger(getInteger(lhs) << getInteger(rhs)); + case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs)); + default: { + fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype)); + exit(1); + } + } + } + return rhs; +} + +oop freeScopes= 0; // pool of free scopes + +oop fixScope(oop scope) // prevent this scope and its parents from being recycled +{ assert(is(Map, scope)); + oop tmp= scope; + while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) { + tmp->Map.flags |= MAP_ENCLOSED; + tmp= map_get(tmp, __proto___symbol); + } + return scope; +} + +oop newScope(oop parent) +{ + if (0 == freeScopes) freeScopes= makeMap(); + oop scope= freeScopes; assert(is(Map, scope)); + freeScopes= freeScopes->Map.pool; + scope->Map.size= 0; + map_set(scope, __proto___symbol, parent); + return scope; +} + +void delScope(oop scope) +{ assert(is(Map, scope)); + if (scope->Map.flags & MAP_ENCLOSED) { + printf("IGNORE %p\n", scope); + return; + } + scope->Map.pool= freeScopes; + freeScopes= scope; +} + +oop evalArgs(oop scope, oop args); + +oop apply(oop scope, oop this, oop func, oop args, oop ast) +{ + assert(is(Function, func)); + + if (NULL != get(func, Function, primitive)) { + return get(func, Function, primitive)(scope, args); + } + + oop param = get(func, Function, param); + oop localScope = newScope(get(func, Function, parentScope)); + map_zip(localScope, param, args); + map_set(localScope, this_symbol, this); + map_set(localScope, __arguments___symbol, args); + jbRecPush(); + trace(ast, func); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: { + untrace(ast); + delScope(localScope); + oop result = jbs->result; + jbRecPop(); + return result; + } + case j_break: { + delScope(localScope); + runtimeError("break outside of a loop or switch"); + } + case j_continue: { + delScope(localScope); + runtimeError("continue outside of a loop"); + } + case j_throw: { + untrace(ast); + delScope(localScope); + oop res= jbs->result; + jbRecPop(); + jbs->result= res; + siglongjmp(jbs->jb, j_throw); + } + } + oop result= eval(localScope, get(func, Function, body)); + untrace(ast); + delScope(localScope); + jbRecPop(); + return result; +} + +oop eval(oop scope, oop ast) +{ + if (opt_v > 3) { + printf("EVAL: "); + println(ast); + } + + switch(getType(ast)) { + case Undefined: + case Integer: + case Float: + case String: + case Function: + return ast; + case Symbol: + return getVariable(scope, ast); + case Map: + break; + } + + assert(is(Map, ast)); + + mrAST= ast; + + oop proto = map_get(ast, __proto___symbol); + if (proto == null) { + return ast; + } + // proto_number is the enum version of the proto symbol + proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype); + switch (proto_number) { + case t_UNDEFINED: { + assert(0); + return 0; + } + case t_Map: { + oop map= clone(map_get(ast, value_symbol)); + for (size_t i= 0; i < map_size(map); ++i) { + struct Pair *pair= &get(map, Map, elements)[i]; + pair->value= eval(scope, pair->value); + } + return map; + } +#if 0 + case t_Quasiquote: { + oop obj = map_get(ast, rhs_symbol); + return expandUnquotes(scope, obj); + } + case t_Unquote: { + runtimeError("@ outside of `"); + } +#endif + case t_Declaration: { + oop lhs = map_get(ast, lhs_symbol); + oop rhs = eval(scope, map_get(ast, rhs_symbol)); + return newVariable(scope, lhs, rhs); + } + case t_If: { + oop condition = map_get(ast, condition_symbol ); + oop consequent = map_get(ast, consequent_symbol); + oop alternate = map_get(ast, alternate_symbol ); + return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate); + } + case t_While: { + oop condition = map_get(ast, condition_symbol ); + oop body = map_get(ast, body_symbol); + oop result = null; + + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: + case j_throw: { + oop result = jbs->result; + jbRecPop(); + assert(jbs); + jbs->result = result; + siglongjmp(jbs->jb, jbt); + assert(0); + } + case j_break: { + jbRecPop(); + return null; + } + case j_continue: { + break; + } + } + + while (isTrue(eval(scope, condition))) result= eval(scope, body); + jbRecPop(); + return result; + } + case t_Do: { + oop body = map_get(ast, body_symbol); + oop condition = map_get(ast, condition_symbol ); + oop result = null; + + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: + case j_throw: { + oop result = jbs->result; + jbRecPop(); + assert(jbs); + jbs->result = result; + siglongjmp(jbs->jb, jbt); + assert(0); + } + case j_break: { + jbRecPop(); + return null; + } + case j_continue: { + goto restart_do; + } + } + + do { + result= eval(scope, body); + restart_do:; + } while (isTrue(eval(scope, condition))); + jbRecPop(); + return result; + } + case t_For: { + oop initialise = map_get(ast, initialise_symbol ); + oop condition = map_get(ast, condition_symbol ); + oop update = map_get(ast, update_symbol ); + oop body = map_get(ast, body_symbol); + oop result = null; + oop localScope = newScope(scope); + + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: + case j_throw: { + delScope(localScope); + oop result = jbs->result; + jbRecPop(); + assert(jbs); + jbs->result = result; + siglongjmp(jbs->jb, jbt); + assert(0); + } + case j_break: { + delScope(localScope); + jbRecPop(); + return result; + } + case j_continue: { + goto restart_for; + } + } + + for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) { + result= eval(localScope, body); + restart_for:; + } + delScope(localScope); + jbRecPop(); + return result; + } + case t_ForIn: { + oop expr = eval(scope, map_get(ast, expression_symbol)); if (!is(Map, expr)) return null; + oop name = map_get(ast, name_symbol ) ; + oop body = map_get(ast, body_symbol ) ; + oop result = null; + oop localScope = newScope(scope); + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: + case j_throw: { + delScope(localScope); + oop result = jbs->result; + jbRecPop(); + assert(jbs); + jbs->result = result; + siglongjmp(jbs->jb, jbt); + assert(0); + } + case j_break: { + delScope(localScope); + jbRecPop(); + return result; + } + case j_continue: { + goto restart_forin; + } + } + for (size_t i= 0; i < map_size(expr); ++i) { + map_set(localScope, name, get(expr, Map, elements)[i].key); + result= eval(localScope, body); + restart_forin:; + } + delScope(localScope); + jbRecPop(); + return result; + } + case t_Switch: { + oop expression = map_get(ast, expression_symbol ); + oop labels = map_get(ast, labels_symbol ); + oop statements = map_get(ast, statements_symbol ); + oop result = eval(scope, expression); + oop label = map_get(labels, result); + if (null == label) label= map_get(labels, __default___symbol); + if (null == label) return result; + assert(isInteger(label)); + int limit= map_size(statements); + + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: + case j_throw: { + oop result = jbs->result; + jbRecPop(); + assert(jbs); + jbs->result = result; + siglongjmp(jbs->jb, jbt); + assert(0); + } + case j_break: { + jbRecPop(); + return null; + } + case j_continue: { + jbRecPop(); + assert(jbs); + siglongjmp(jbs->jb, j_continue); + assert(0); + } + } + + for (int i= getInteger(label); i < limit; ++i) { + assert(map_hasIntegerKey(statements, i)); + result= eval(scope, get(statements, Map, elements)[i].value); + } + jbRecPop(); + return result; + } + case t_Assign: { + oop lhs = map_get(ast, lhs_symbol); + oop op = map_get(ast, operator_symbol); + oop rhs = eval(scope, map_get(ast, rhs_symbol)); + if (null != op) rhs= applyOperator(op, getVariable(scope, lhs), rhs); + setVariable(scope, lhs, rhs); + if (is(Function, rhs) && null == get(rhs, Function, name)) { + set(rhs, Function, name, lhs); + } + return rhs; + } + case t_Func: { + oop name = map_get(ast, name_symbol); + oop param = map_get(ast, param_symbol); + oop body = map_get(ast, body_symbol); + oop fixed = map_get(ast, fixed_symbol); + oop func = makeFunction(NULL, name, param, body, fixScope(scope), fixed); + if (opt_v > 4) { + printf("funcscope: "); + println(scope); + printf("globalScope: "); + println(scope); + } + if (name != null) newVariable(scope, name, func); + return func; + } + case t_Call: { + oop func = eval(scope, map_get(ast, func_symbol)); + if (!is(Function, func)) { + printf("\ncannot call %s\n", printString(func)); + printBacktrace(ast); + exit(1); + } + oop args = map_get(ast, args_symbol); + if (isFalse(get(func, Function, fixed))) { + args = evalArgs(scope, args); + } + return apply(scope, globals, func, args, ast); + } + case t_Invoke: { + oop this = eval(scope, map_get(ast, this_symbol)); + oop func = map_get(ast, name_symbol); assert(is(Symbol, func)); + func = getVariable(this, func); + if (!is(Function, func)) { + printf("\ncannot invoke %s\n", printString(func)); + printBacktrace(ast); + exit(1); + } + oop args = map_get(ast, args_symbol); + if (isFalse(get(func, Function, fixed))) { + args = evalArgs(scope, args); + } + return apply(scope, this, func, args, ast); + } + + case t_Return: { + assert(jbs); + jbs->result = eval(scope, map_get(ast, value_symbol)); + siglongjmp(jbs->jb, j_return); + } + case t_Break: { + assert(jbs); + siglongjmp(jbs->jb, j_break); + } + case t_Continue: { + assert(jbs); + siglongjmp(jbs->jb, j_continue); + } + case t_Throw: { + assert(jbs); + jbs->result = eval(scope, map_get(ast, rhs_symbol)); + siglongjmp(jbs->jb, j_throw); + } + case t_Try: { + oop try = map_get(ast, try_symbol); + oop exception = map_get(ast, exception_symbol); + oop catch = map_get(ast, catch_symbol); + oop finally = map_get(ast, finally_symbol); + + jbRecPush(); + int jbt = sigsetjmp(jbs->jb, 0); + if (0 == jbt) { + oop res = eval(scope, try); + jbRecPop(); + eval(scope, finally); + return res; + } + oop res= jbs->result; + jbRecPop(); + // something happend in the try block + if (j_throw == jbt) { + assert(jbs); + jbs->result= res; + + if (null == catch) { + return eval(scope, finally); + } + oop localScope= newScope(scope); + setVariable(localScope, exception, res); + + jbRecPush(); + jbt= sigsetjmp(jbs->jb, 0); + if (0 == jbt) { + eval(localScope, catch); + delScope(localScope); + jbRecPop(); + return eval(scope, finally); + } + delScope(localScope); + // something happend in the catch block + res= jbs->result; + jbRecPop(); + } + eval(scope, finally); + assert(jbs); + jbs->result= res; + siglongjmp(jbs->jb, jbt); + } + case t_Block: { + oop statements = map_get(ast, statements_symbol); + int i = 0; + oop index; + oop statement, res; + oop localScope = newScope(scope); + while ((index = makeInteger(i)), map_hasKey(statements, index)) { + statement = map_get(statements, index); + res = eval(localScope, statement); + i++; + } + delScope(localScope); + return res; + } + case t_GetVariable: { + return getVariable(scope, map_get(ast, key_symbol)); + } + case t_GetMember: { + oop map = eval(scope, map_get(ast, map_symbol)); + oop key = map_get(ast, key_symbol); + return getMember(map, key); + } + case t_SetMember: { + oop map = eval(scope, map_get(ast, map_symbol)); + oop key = map_get(ast, key_symbol); + oop op = map_get(ast, operator_symbol); + oop value = eval(scope, map_get(ast, value_symbol)); + if (null != op) value= applyOperator(op, getProperty(map, key), value); + if (is(Function, value) && null == get(value, Function, name)) { + set(value, Function, name, key); + } + return map_set(map, key, value); + } + case t_GetIndex: { + oop map = eval(scope, map_get(ast, map_symbol)); + oop key = eval(scope, map_get(ast, key_symbol)); + switch (getType(map)) { + case String: + if (getInteger(key) >= get(map, String, size)) { + runtimeError("GetIndex out of range on String"); + } + return makeInteger(unescape(get(map, String, value))[getInteger(key)]); + case Map: + return getVariable(map, key); + default: + runtimeError("GetIndex on non Map or String"); + } + } + case t_SetIndex: { + oop map = eval(scope, map_get(ast, map_symbol)); + oop key = eval(scope, map_get(ast, key_symbol)); + oop op = map_get(ast, operator_symbol); + oop value = eval(scope, map_get(ast, value_symbol)); + switch (getType(map)) { + case String: + if (getInteger(key) >= get(map, String, size)) { + runtimeError("SetIndex out of range on String"); + } + get(map, String, value)[getInteger(key)] = getInteger(value); + return value; + case Map: + if (null != op) value= applyOperator(op, map_get(map, key), value); + return map_set(map, key, value); + default: + runtimeError("SetIndex on non Map or String"); + } + + } + case t_Symbol: + case t_Integer: + case t_Float: + case t_String: { + return map_get(ast, value_symbol); + } + case t_Logor: { + oop lhs = map_get(ast, lhs_symbol); + oop rhs = map_get(ast, rhs_symbol); + if (isTrue(eval(scope, lhs))) return makeInteger(1); + if (isTrue(eval(scope, rhs))) return makeInteger(1); + return makeInteger(0); + } + case t_Logand: { + oop lhs = map_get(ast, lhs_symbol); + oop rhs = map_get(ast, rhs_symbol); + if (isFalse(eval(scope, lhs))) return makeInteger(0); + if (isFalse(eval(scope, rhs))) return makeInteger(0); + return makeInteger(1); + } +# define RELATION(NAME, OPERATOR) \ + case t_##NAME: { \ + oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ + oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ + return makeInteger(oopcmp(lhs, rhs) OPERATOR 0); \ + } +# define BINARY(NAME, OPERATOR) \ + case t_##NAME: { \ + oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ + oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ + return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \ + } +# define BINARYOP(NAME, FUNCPREFIX) \ + case t_##NAME: { \ + oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ + oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ + return FUNCPREFIX##Operation(lhs, rhs); \ + } + BINARY(Bitor, | ); + BINARY(Bitxor, ^ ); + BINARY(Bitand, & ); + RELATION(Equal, ==); + RELATION(Noteq, !=); + RELATION(Less, < ); + RELATION(Lesseq, <=); + RELATION(Greatereq, >=); + RELATION(Greater, > ); + BINARY(Shleft, <<); + BINARY(Shright, >>); + BINARYOP(Add, add); + BINARYOP(Mul, mul); + BINARYOP(Sub, sub); + BINARYOP(Div, div); + BINARYOP(Mod, mod); +# undef BINARYOP +# undef BINARY +# undef RELATION + case t_Not: { + oop rhs = eval(scope, map_get(ast, rhs_symbol)); + return makeInteger(isFalse(rhs)); + } +# define UNARY(NAME, OPERATOR) \ + case t_##NAME: { \ + oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ + return makeInteger(OPERATOR getInteger(rhs)); \ + } + UNARY(Neg, -); + UNARY(Com, ~); +# undef UNARY + case t_PreIncVariable: { + oop key= map_get(ast, key_symbol); + oop val= getVariable(scope, key); + val= makeInteger(getInteger(val) + 1); + return setVariable(scope, key, val); + } + case t_PreDecVariable: { + oop key= map_get(ast, key_symbol); + oop val= getVariable(scope, key); + val= makeInteger(getInteger(val) - 1); + return setVariable(scope, key, val); + } + case t_PreIncMember: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= map_get(ast, key_symbol); + oop val= map_get(map, key); + val= makeInteger(getInteger(val) + 1); + return map_set(map, key, val); + } + case t_PreDecMember: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= map_get(ast, key_symbol); + oop val= map_get(map, key); + val= makeInteger(getInteger(val) - 1); + return map_set(map, key, val); + } + case t_PreIncIndex: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= eval(scope, map_get(ast, key_symbol)); + oop val= map_get(map, key); + val= makeInteger(getInteger(val) + 1); + return map_set(map, key, val); + } + case t_PreDecIndex: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= eval(scope, map_get(ast, key_symbol)); + oop val= map_get(map, key); + val= makeInteger(getInteger(val) - 1); + return map_set(map, key, val); + } + case t_PostIncVariable: { + oop key= map_get(ast, key_symbol); + oop val= getVariable(scope, key); + oop inc= makeInteger(getInteger(val) + 1); + setVariable(scope, key, inc); + return val; + } + case t_PostDecVariable: { + oop key= map_get(ast, key_symbol); + oop val= getVariable(scope, key); + oop inc= makeInteger(getInteger(val) - 1); + setVariable(scope, key, inc); + return val; + } + case t_PostIncMember: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= map_get(ast, key_symbol); + oop val= map_get(map, key); + oop inc= makeInteger(getInteger(val) + 1); + map_set(map, key, inc); + return val; + } + case t_PostDecMember: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= map_get(ast, key_symbol); + oop val= map_get(map, key); + oop inc= makeInteger(getInteger(val) - 1); + map_set(map, key, inc); + return val; + } + case t_PostIncIndex: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= eval(scope, map_get(ast, key_symbol)); + oop val= map_get(map, key); + oop inc= makeInteger(getInteger(val) + 1); + map_set(map, key, inc); + return val; + } + case t_PostDecIndex: { + oop map= eval(scope, map_get(ast, map_symbol)); + oop key= eval(scope, map_get(ast, key_symbol)); + oop val= map_get(map, key); + oop inc= makeInteger(getInteger(val) - 1); + map_set(map, key, inc); + return val; + } + } + printf("EVAL "); + println(ast); + assert(0); + return null; +} + +oop prim_exit(oop scope, oop params) +{ + int status= 0; + if (map_hasIntegerKey(params, 0)) { + oop arg= get(params, Map, elements)[0].value; + if (isInteger(arg)) status= getInteger(arg); + } + exit(status); +} + +oop prim_keys(oop scope, oop params) +{ + if (map_hasIntegerKey(params, 0)) { + oop arg= get(params, Map, elements)[0].value; + if (is(Map, arg)) return map_keys(arg); + } + return null; +} + +oop prim_values(oop scope, oop params) +{ + if (map_hasIntegerKey(params, 0)) { + oop arg= get(params, Map, elements)[0].value; + if (is(Map, arg)) return map_values(arg); + } + return null; +} + +oop prim_length(oop scope, oop params) +{ + if (map_hasIntegerKey(params, 0)) { + oop arg= get(params, Map, elements)[0].value; + switch (getType(arg)) { + case String: return makeInteger(string_size(arg)); + case Symbol: return makeInteger(strlen(get(arg, Symbol, name))); + case Map: return makeInteger(map_size(arg)); + default: break; + } + } + return null; +} + +oop prim_apply(oop scope, oop params) { + oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value; + oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value; + return apply(scope, globals, func, args, mrAST); +} + +oop prim_invoke(oop scope, oop params) +{ + oop this= null; if (map_hasIntegerKey(params, 0)) this= get(params, Map, elements)[0].value; + oop func= null; if (map_hasIntegerKey(params, 1)) func= get(params, Map, elements)[1].value; + oop args= null; if (map_hasIntegerKey(params, 2)) args= get(params, Map, elements)[2].value; + return apply(scope, this, func, args, mrAST); +} + +oop prim_clone(oop scope, oop params) +{ + if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value); + return null; +} + +oop prim_print(oop scope, oop params) +{ + assert(is(Map, params)); + for (int i= 0; map_hasIntegerKey(params, i); ++i) { + print(get(params, Map, elements)[i].value); + } + return params; +} + +oop evalArgs(oop scope, oop args) +{ + int i = 0; + oop params = makeMap(); + oop index; + while ((index = makeInteger(i)), map_hasKey(args, index)) { + map_set(params, index, eval(scope, map_get(args, index))); + i++; + } + return params; +} + +oop AST= NULL; + +void readEvalPrint(oop scope, char *fileName) +{ + inputStackPush(fileName); + input_t *top= inputStack; + jbRecPush(); + jb_record *jtop= jbs; + int jbt= sigsetjmp(jbs->jb, 0); + + if (0 == jbt) { + while (yyparse()) { + if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber); + if (!yylval) { + fclose(inputStack->file); + if (top == inputStack) break; + inputStackPop(); + assert(inputStack); + continue; + } // EOF + if (opt_v > 1) println(yylval); + oop res = eval(scope, yylval); + if (opt_v > 0) println(res); + assert(jbs == jtop); + } + assert(inputStack); + inputStackPop(); + jbRecPop(); + return; + } + + assert(jbs == jtop); + oop res = jbs->result; + jbRecPop(); + switch (jbt) { + case j_return: runtimeError("return outside of a function"); + case j_break: runtimeError("break outside of a loop or switch"); + case j_continue: runtimeError("continue outside of a loop"); + case j_throw: runtimeError("unhandled exception: %s", printString(res)); + } +} + +oop prim_import(oop scope, oop params) +{ + if (map_hasIntegerKey(params, 0)) { + char *file= get(get(params, Map, elements)[0].value, String, value); + if (yyctx->__pos < yyctx->__limit) { + yyctx->__limit--; + ungetc(yyctx->__buf[yyctx->__limit], inputStack->file); + } + readEvalPrint(scope, file); + } + return null; +} + +oop prim_String(oop scope, oop params) +{ + if (!map_hasIntegerKey(params, 0)) return null; + return makeString(printString(get(params, Map, elements)[0].value)); +} + +oop prim_scope(oop scope, oop params) +{ + return fixScope(scope); +} + +#include + +oop prim_microseconds(oop scope, oop params) +{ + struct rusage ru; + getrusage(RUSAGE_SELF, &ru); + return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec); +} + + +int orow= 0; +int ocol= 0; + +void outputText(char *text) +{ + printf("%s", text); + ocol += strlen(text); +} + +void outputNode(oop node) +{ + if (!node) return; + switch (node->type) { + case Undefined: return; + case String: outputText(get(node, String, value)); return; + case Map: break; + default: + fprintf(stderr, "\noutputNode: unknown node type %i\n", node->type); + abort(); + } + assert(is(Map, node)); + oop proto= map_get(node, __proto___symbol); + if (null == proto) 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, name_symbol)); break; + case t_C_if: + outputNode(map_get(node, if_symbol)); + outputNode(map_get(node, lparen_symbol)); + outputNode(map_get(node, condition_symbol)); + outputNode(map_get(node, rparen_symbol)); + outputNode(map_get(node, consequent_symbol)); + outputNode(map_get(node, else_symbol)); // null if no else clause + outputNode(map_get(node, alternate_symbol)); // null if no else clause + break; + } +#if 0 + while (orow < node->row) { printf("\n"); ++orow; ocol= 0; } + while (ocol < node->col) { printf(" " ); ++ocol; } +#endif + outputNode(map_get(node, comment_symbol)); +} + + +int main(int argc, char **argv) +{ +# if (USE_GC) + GC_INIT(); +# endif + + symbol_table= makeMap(); + globals= makeMap(); + + map_set(globals, intern("exit" ), makeFunction(prim_exit, intern("exit" ), null, null, globals, null)); + map_set(globals, intern("keys" ), makeFunction(prim_keys, intern("keys" ), null, null, globals, null)); + map_set(globals, intern("values" ), makeFunction(prim_values, intern("values" ), null, null, globals, null)); + map_set(globals, intern("length" ), makeFunction(prim_length, intern("length" ), null, null, globals, null)); + map_set(globals, intern("print" ), makeFunction(prim_print, intern("print" ), null, null, globals, null)); + map_set(globals, intern("invoke" ), makeFunction(prim_invoke, intern("invoke" ), null, null, globals, null)); + map_set(globals, intern("apply" ), makeFunction(prim_apply, intern("apply" ), null, null, globals, null)); + map_set(globals, intern("clone" ), makeFunction(prim_clone, intern("clone" ), null, null, globals, null)); + map_set(globals, intern("import" ), makeFunction(prim_import, intern("import" ), null, null, globals, null)); + map_set(globals, intern("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null)); + map_set(globals, intern("String" ), makeFunction(prim_String , intern("String" ), null, null, globals, null)); + + map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), null, null, globals, null)); + + #define _DO(NAME) NAME##_symbol=intern(#NAME); + DO_SYMBOLS() + #undef _DO + + #define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME); + DO_PROTOS() + #undef _DO + + #define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol); + DO_PROTOS() + #undef _DO + + #define _DO(NAME) map_set(globals, NAME##_symbol, NAME##_proto); + DO_PROTOS() + #undef _DO + + AST = makeMap(); + map_set(globals, intern("AST"), AST); + #define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto); + DO_PROTOS() + #undef _DO + + fixScope(globals); + + /**/ + + inputStackPush(NULL); + while (yyparse()) { + outputNode(yylval); + } + + return 0; + + /**/ + + int repled = 0; + while (argc-- > 1) { + ++argv; + if (!strcmp(*argv, "-g")) ++opt_g; + else if (!strcmp(*argv, "-v")) ++opt_v; + else if (!strcmp(*argv, "-")) { + readEvalPrint(globals, NULL); + repled= 1; + } + else { + readEvalPrint(globals, *argv); + repled= 1; + } + } + if (!repled) { + readEvalPrint(globals, NULL); + } + + if (opt_g) { + if (nalloc < 1024) printf("[GC: %lli bytes allocated]\n", nalloc ); + else if (nalloc < 1024*1024) printf("[GC: %lli kB allocated]\n", nalloc / 1024 ); + else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n", (double)nalloc / ( 1024*1024)); + else printf("[GC: %.2f GB allocated]\n", (double)nalloc / (1024*1024*1024)); + } + + return 0; + + (void)yyAccept; +} + +// Local Variables: +// indent-tabs-mode: nil +// End: diff --git a/object.c b/object.c new file mode 100644 index 0000000..c5f6488 --- /dev/null +++ b/object.c @@ -0,0 +1,688 @@ +#include +#include +#include +#include +#include + +#define USE_TAG 1 +#define USE_GC 1 + +#if (USE_GC) +# include +#endif + +typedef long long int_t; +typedef long double flt_t; + +#define FMT_I "%lli" +#define FMT_F "%Lg" + +void *memcheck(void *ptr) +{ + if (NULL == ptr) { + fprintf(stderr, "Error: out of memory\n"); + exit(EX_OSERR); // this is as close as we have for 'resource unavailable' + } + return ptr; +} + +unsigned long long nalloc= 0; + +void *xmalloc(size_t n) +{ + nalloc += n; +#if (USE_GC) + void *mem= GC_malloc(n); + assert(mem); +#else + void *mem= memcheck(calloc(1, n)); +#endif + return mem; +} + +void *xrealloc(void *p, size_t n) +{ + nalloc += n; +#if (USE_GC) + void *mem= GC_realloc(p, n); + assert(mem); +#else + void *mem= memcheck(realloc(p, n)); +#endif + return mem; +} + +char *xstrdup(char *s) +{ +#if (USE_GC) + size_t len= strlen(s); + char *mem= GC_malloc_atomic(len + 1); + assert(mem); + memcpy(mem, s, len + 1); + nalloc += len; +#else + char *mem= memcheck(strdup(s)); +#endif + return mem; +} + +#define malloc(n) xmalloc(n) +#define realloc(o, n) xrealloc(o, n) +#define strdup(s) xstrdup(s) + +typedef enum { + Undefined, + Integer, + Float, + String, + Symbol, + Function, + Map +} type_t; + +#define NTYPES (Map + 1) + +union object; +typedef union object *oop; + +struct Undefined { + type_t type; +}; + +struct Integer { + type_t type; + int_t _value; +}; + +struct Float { + type_t type; + flt_t _value; +}; + +struct String { + type_t type; + char *value; + size_t size; +}; + +struct Symbol { + type_t type; + char *name; + #ifdef SYMBOL_PAYLOAD + SYMBOL_PAYLOAD + #endif //SYMBOL_PAYLOAD +}; + +typedef oop (*primitive_t)(oop scope, oop params); + +struct Function { + type_t type; + primitive_t primitive; + oop name; + oop body; + oop param; + oop parentScope; + oop fixed; +}; + +// usefull for map's elements +struct Pair { + oop key; + oop value; +}; + +enum { + MAP_ENCLOSED = 1 << 0, // set when map is used as a scope and closed over by a function +}; + +struct Map { + type_t type; + int flags; + struct Pair *elements; // even are keys, odd are values [ key val key val key val ] + size_t capacity; + union { + size_t size; // free Maps will be reset to 0 size on allocation + oop pool; // free list of Map objects + }; +}; + +union object { + type_t type; + struct Undefined Undefined; + struct Integer Integer; + struct Float Float; + struct String String; + struct Symbol Symbol; + struct Function Function; + struct Map Map; +}; + +union object _null = {.Undefined = {Undefined}}; +const oop null = &_null; + +int is(type_t type, oop obj); + +#if (USE_TAG) +int isTag(oop obj) +{ + return ((intptr_t)obj & 1); +} +#endif + +int isInteger(oop obj) +{ +#if (USE_TAG) + return ((intptr_t)obj & 1) || is(Integer, obj); +#else + return is(Integer, obj); +#endif +} + +#if (USE_TAG) +# define getType(PTR) (type_t)(((intptr_t)(PTR) & 1) ? Integer : (PTR)->type) +#else +type_t getType(oop ptr) +{ + assert(ptr); + return ptr->type; +} +#endif + +int is(type_t type, oop obj) +{ + return type == getType(obj); +} + +oop _checkType(oop ptr, type_t type, char *file, int line) +{ + assert(ptr); + if (getType(ptr) != type) { + fprintf(stderr, "\n%s:%i: expected %i got %i\n", file, line, type, ptr->type); + } + assert(getType(ptr) == type); + return ptr; +} + +// added parens around expansion to protect assignment +#define get(PTR, TYPE, FIELD) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD) +#define set(PTR, TYPE, FIELD, VALUE) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD = VALUE) + +#include "buffer.h" +DECLARE_STRING_BUFFER(char, StringBuffer); + +void print(oop ast); +void println(oop ast); +void printOn(StringBuffer *buf, oop obj, int indent); + +int_t getInteger(oop obj) +{ +#if (USE_TAG) + if (isTag(obj)) return (intptr_t)obj >> 1; +#endif + if (!isInteger(obj)) { + fprintf(stderr, "\ngetInteger call on non-integer\n"); + exit(1); + } + return get(obj, Integer, _value); +} + +#if (USE_TAG) +int isIntegerValue(int_t value) +{ + return (((intptr_t)value << 1) >> 1) == value; +// return -32 <= value && value < 32; +} +#endif + +oop makeInteger(int_t value) +{ +#if (USE_TAG) + if (isIntegerValue(value)) return (oop)(((intptr_t)value << 1) | 1); +#endif + oop newInt = malloc(sizeof(struct Integer)); + newInt->type = Integer; + newInt->Integer._value = value; + return newInt; +} + +oop makeFloat(flt_t value) +{ + oop newFloat= malloc(sizeof(struct Float)); + newFloat->type= Float; + newFloat->Float._value= value; + return newFloat; +} + +oop makeString(char *value) +{ + oop newString = malloc(sizeof(struct String)); + newString->type = String; + newString->String.value = strdup(value); + newString->String.size = strlen(value); + return newString; +} + +size_t string_size(oop s) +{ + return get(s, String, size); +} + +oop string_concat(oop str1, oop str2) +{ + size_t len = string_size(str1) + string_size(str2); + char *concat = malloc(sizeof(char) * len + 1); + memcpy(concat, get(str1, String, value), string_size(str1)); + memcpy(concat + string_size(str1), get(str2, String, value), string_size(str2)); + concat[len]= '\0'; + oop newString = malloc(sizeof(struct String)); + newString->type = String; + newString->String.value = concat; + newString->String.size = len; + return newString; +} + +oop string_mul(oop str, oop factor) +{ + ssize_t len = string_size(str) * getInteger(factor); + if (len < 0) len = 0; + char *concat = malloc(sizeof(char) * len + 1); + for (int i=0; i < getInteger(factor); ++i) { + memcpy(concat + (i * string_size(str)), get(str, String, value), string_size(str)); + } + concat[len]= '\0'; + oop newString = malloc(sizeof(struct String)); + newString->type = String; + newString->String.value = concat; + newString->String.size = len; + return newString; +} + +oop makeSymbol(char *name) +{ + oop newSymb = malloc(sizeof(struct Symbol)); + newSymb->type = Symbol; + newSymb->Symbol.name = strdup(name); + newSymb->Symbol.prototype = 0; + return newSymb; +} + +oop makeFunction(primitive_t primitive, oop name, oop param, oop body, oop parentScope, oop fixed) +{ + oop newFunc = malloc(sizeof(struct Function)); + newFunc->type = Function; + newFunc->Function.primitive = primitive; + newFunc->Function.name = name; + newFunc->Function.param = param; + newFunc->Function.body = body; + newFunc->Function.parentScope = parentScope; + newFunc->Function.fixed = fixed; + return newFunc; +} + +oop makeMap() +{ + oop newMap = malloc(sizeof(struct Map)); assert(0 == newMap->Map.flags); + newMap->type = Map; + return newMap; +} + +size_t map_size(oop map) +{ + assert(is(Map, map)); + return get(map, Map, size); +} + +bool map_hasIntegerKey(oop map, size_t index) +{ + if (index >= map_size(map)) return 0; + oop key= get(map, Map, elements)[index].key; + if (!isInteger(key)) return 0; + return index == getInteger(key); +} + +int oopcmp(oop a, oop b) +{ + type_t ta = getType(a), tb = getType(b); + if (ta == tb) { + switch (getType(a)) { + case Integer: { + int_t l= getInteger(a), r= getInteger(b); + if (l < r) return -1; + if (l > r) return 1; + return 0; + } + case Float: { + flt_t l= get(a, Float, _value), r= get(b, Float, _value); + if (l < r) return -1; + if (l > r) return 1; + return 0; + } + case String: + return strcmp(get(a, String, value), get(b, String, value)); + default: { + intptr_t l= (intptr_t)a, r= (intptr_t)b; + if (l < r) return -1; + if (l > r) return 1; + return 0; + } + } + } + return ta - tb; +} + +ssize_t map_search(oop map, oop key) +{ + assert(is(Map, map)); + assert(key); + + ssize_t r = map_size(map) - 1; + + if (isInteger(key)) { + ssize_t index = getInteger(key); + if (index <= r) { + oop probe = get(map, Map, elements)[index].key; + if (key == probe) return index; + } + } + + ssize_t l = 0; + while (l <= r) { + ssize_t mid = (l + r) / 2; + int cmpres = oopcmp(get(map, Map, elements)[mid].key, key); + if (cmpres > 0) r = mid - 1; + else if (cmpres < 0) l = mid + 1; + else return mid; // non-negative result => element found at this index + } + return -1 - l; // negative result => 'not found', reflected around -1 instead of 0 to allow 'not found' at index 0 +} + +bool map_hasKey(oop map, oop key) +{ + assert(is(Map, map)); + assert(key); + return map_search(map, key) >= 0; +} + +oop map_get(oop map, oop key) +{ + assert(is(Map, map)); + assert(key); + ssize_t pos = map_search(map, key); + if (pos < 0) return null; + return get(map, Map, elements)[pos].value; +} + +#define MAP_MIN_SIZE 4 +#define MAP_GROW_SIZE 2 + +oop map_insert(oop map, oop key, oop value, size_t pos) +{ + assert(is(Map, map)); + assert(key); + assert(value); + if (pos > map_size(map)) { // don't need to check for pos < 0 because size_t is unsigned + fprintf(stderr, "\nTrying to insert in a map out of bound\n"); + assert(-1); + } + + // check capacity and expand if needed + if (map_size(map) >= get(map, Map, capacity)) { + size_t newCapacity = get(map, Map, capacity) * MAP_GROW_SIZE; + if (newCapacity < MAP_MIN_SIZE) newCapacity= MAP_MIN_SIZE; + set(map, Map, elements, realloc(get(map, Map, elements), sizeof(struct Pair) * newCapacity)); + set(map, Map, capacity, newCapacity); + } + + // insert + memmove(get(map, Map, elements) + pos + 1, get(map, Map, elements) + pos, sizeof(struct Pair) * (map_size(map) - pos)); + // Maybe this syntax is not very nice and I should access the Pair stuff differently? + // I mean modifying something on a line that begin with "get"... :/ + get(map, Map, elements)[pos].value = value; + get(map, Map, elements)[pos].key = key; + set(map, Map, size, map_size(map) + 1); + + return value; +} + +oop map_set(oop map, oop key, oop value) +{ + assert(is(Map, map)); + assert(key); + assert(value); + ssize_t pos = map_search(map, key); + if (pos >= 0) { + get(map, Map, elements)[pos].value = value; + } else { + pos = -1 - pos; + map_insert(map, key, value, pos); + } + return value; +} + +oop map_del(oop map, oop key) +{ + assert(is(Map, map)); + assert(is(String, key)); + ssize_t pos = map_search(map, key); + if (pos < 0) return map; + if (pos < map_size(map) - 1) { + memmove(get(map, Map, elements) + pos, get(map, Map, elements) + pos + 1, sizeof(struct Pair) * (map_size(map) - pos)); + } + set(map, Map, size, map_size(map) - 1); + return map; +} + +oop map_append(oop map, oop value) +{ + return map_set(map, makeInteger(map_size(map)), value); +} + +bool isHidden(oop obj) { + if (is(Symbol, obj)) { + char *s = get(obj, Symbol, name); + size_t l = strlen(s); + // maybe 'l > 5' because of ____? + return (l > 4 && s[0] == '_' && s[1] == '_' && s[l-2] == '_' && s[l-1] == '_'); + } + return false; +} + +oop map_keys(oop map) +{ + assert(is(Map, map)); + oop keys = makeMap(); + for (size_t i = 0; i < get(map, Map, size); i++) { + if (!isHidden(get(map, Map, elements)[i].key)) { + map_append(keys, get(map, Map, elements)[i].key); + } + } + return keys; +} + +oop map_allKeys(oop map) +{ + assert(is(Map, map)); + oop keys = makeMap(); + for (size_t i = 0; i < get(map, Map, size); i++) { + map_append(keys, get(map, Map, elements)[i].key); + } + return keys; +} + +oop map_values(oop map) +{ + assert(is(Map, map)); + oop values = makeMap(); + for (size_t i = 0; i < get(map, Map, size); i++) { + if (!isHidden(get(map, Map, elements)[i].key)) { + map_append(values, get(map, Map, elements)[i].value); + } + } + return values; +} + +DECLARE_BUFFER(oop, OopStack); +OopStack printing = BUFFER_INITIALISER; + +#define OopStack_push(s, o) OopStack_append(s, o) +oop OopStack_pop(OopStack *s) +{ + if (s->position < 1) { + return null; + } + return s->contents[--(s->position)]; +} + +int OopStack_includes(OopStack *s, oop map) +{ + for (size_t i=0; i < s->position; ++i) { + if (s->contents[i] == map) { + return 1; + } + } + return 0; +} + +void indentOn(StringBuffer *buf, int indent) +{ + for (size_t i = 0; i < indent; i++) { + if (isatty(fileno(stdout))) { + StringBuffer_appendString(buf, "\033[90m|\033[0m"); + } else { + StringBuffer_appendString(buf, "|"); + } + StringBuffer_appendString(buf, " "); + } +} + +void map_printOn(StringBuffer *buf, oop map, int ident) +{ + assert(is(Map, map)); + if (ident == 0) { + StringBuffer_append(buf, '{'); + map_printOn(buf, map, ident + 1); + StringBuffer_append(buf, '}'); + return; + } + if (OopStack_includes(&printing, map)) { + StringBuffer_appendString(buf, ""); + return; + } + OopStack_push(&printing, map); + for (size_t i = 0; i < map_size(map); i++) { + StringBuffer_append(buf, '\n'); + indentOn(buf, ident); + // todo: a key could be a map itself + printOn(buf, get(map, Map, elements)[i].key, ident); + StringBuffer_appendString(buf, ": "); + oop rhs = get(map, Map, elements)[i].value; + if (getType(rhs) == Map) { + map_printOn(buf, rhs, ident + 1); + } else { + printOn(buf, rhs, ident); + } + if (i < map_size(map) - 1) StringBuffer_append(buf, ','); + if (ident == 1 && i == map_size(map) - 1) StringBuffer_append(buf, '\n'); + } + OopStack_pop(&printing); +} + +void printOn(StringBuffer *buf, oop obj, int indent) +{ + assert(obj); + switch (getType(obj)) { + case Undefined: { + StringBuffer_appendString(buf, "null"); + return; + } + case Integer: { + char tmp[44]; + int length = snprintf(tmp, sizeof(tmp), FMT_I, getInteger(obj)); + StringBuffer_appendAll(buf, tmp, length); + return; + } + case Float: { + char tmp[44]; + int length = snprintf(tmp, sizeof(tmp), FMT_F, get(obj, Float, _value)); + StringBuffer_appendAll(buf, tmp, length); + return; + } + case String: { + StringBuffer_appendAll(buf, get(obj, String, value), string_size(obj)); + return; + } + case Symbol: { + char *name= get(obj, Symbol, name); + StringBuffer_appendString(buf, name); + return; + } + case Function: { + if (get(obj, Function, primitive) == NULL) { + StringBuffer_appendString(buf, "Function:"); + } else { + StringBuffer_appendString(buf, "Primitive:"); + } + printOn(buf, get(obj, Function, name), indent); + StringBuffer_append(buf, '('); + printOn(buf, get(obj, Function, param), indent + 1); + if (is(Map, get(obj, Function, param)) && map_size(get(obj, Function, param)) > 0) { + StringBuffer_append(buf, '\n'); + indentOn(buf, indent); + } + StringBuffer_append(buf, ')'); + return; + } + case Map: { + map_printOn(buf, obj, indent); + return; + } + } + assert(0); +} + +char *printString(oop obj) +{ + static StringBuffer buf= BUFFER_INITIALISER; + StringBuffer_clear(&buf); + printOn(&buf, obj, 0); + return StringBuffer_contents(&buf); +} + +void print(oop obj) +{ + fputs(printString(obj), stdout); +} + +void println(oop ast) +{ + print(ast); + printf("\n"); +} + +oop symbol_table; + +ssize_t map_intern_search(oop map, char* ident) +{ + assert(is(Map, map)); + assert(ident); + ssize_t l = 0, r = map_size(map) - 1; + while (l <= r) { + ssize_t mid = (l + r) / 2; + int cmpres = strcmp(get(get(map, Map, elements)[mid].key, Symbol, name), ident); + if (cmpres > 0) r = mid - 1; + else if (cmpres < 0) l = mid + 1; + else return mid; // non-negative result => element found at this index + } + return -1 - l; // negative result => 'not found', reflected around -1 instead of 0 to allow 'not found' at index 0 +} + +oop intern(char *ident) +{ + assert(ident); + ssize_t pos = map_intern_search(symbol_table, ident); + if (pos >= 0) return get(symbol_table, Map, elements)[pos].key; + pos = -1 - pos; // 'un-negate' the result by reflecting it around X=-1 + oop symbol = makeSymbol(ident); + map_insert(symbol_table, symbol, null, pos); + return symbol; +}