piumarta
/
ccmeta
1
0
Vork 0
Code Kwesties 0 Pull-aanvragen 0 Publicaties 0 Wiki Activiteit
C compiler with embedded metalanguage.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
64 Commits
2 Branches
3.4 MiB
 
 
 
Tree: ad1111a9b6
Branches Labels
${ item.name }
Maak branch ${ searchTerm }
van 'ad1111a9b6'
${ noResults }
ccmeta/ccmeta.leg

4562 regels
155 KiB
Ruw Blame Geschiedenis

# ccmeta.leg -- metalanguage for C
#
# Copyright (c) 2016-2021 Ian Piumarta and other contributors (see AUTHORS)
# All rights reserved (see LICENSE)
#
# Last edited: 2021-08-16 18:55:57 by piumarta on DESKTOP-GMTB276
%{
/* compile: leg -o ccmeta.c ccmeta.leg
* cc -o ccmeta ccmeta.c -lgc -lm
*
* run: ./ccmeta < ccmeta-test.txt
*/
#include <stdarg.h>
#include <math.h>
#define DO_PROTOS() \
_DO(Undefined) _DO(Integer) _DO(Float) _DO(String) _DO(Symbol) _DO(Function) _DO(Map) \
_DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \
_DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \
_DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand) \
_DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) \
_DO(Shleft) _DO(Shright) \
_DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com) \
_DO(PreIncVariable) _DO(PreIncMember) _DO(PreIncIndex) \
_DO(PostIncVariable) _DO(PostIncMember) _DO(PostIncIndex) \
_DO(PreDecVariable) _DO(PreDecMember) _DO(PreDecIndex) \
_DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \
_DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \
_DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \
/* _DO(Quasiquote) _DO(Unquote) */ \
DO_C_PROTOS()
#define META_PROTO_MAX t_Try
#define DO_C_PROTOS() \
_DO(Comment) _DO(Token) \
_DO(C_declaration) _DO(C_string) \
_DO(C_if) _DO(C_int) _DO(C_float) _DO(C_char) _DO(C_id) _DO(C_while) _DO(C_do) _DO(C_for) \
_DO(C_binary) _DO(C_initializer) _DO(C_range) _DO(C_conditional) _DO(C_index) \
_DO(C_designation) _DO(C_attribution) _DO(C_deref) _DO(C_block) _DO(C_call) _DO(C_subexpr) \
_DO(C_array) _DO(C_parameter) _DO(C_typeOf) _DO(C_unary) _DO(C_prefix) _DO(C_alignOf) \
_DO(C_sizeOf) _DO(C_cast) _DO(C_attributeSpec) _DO(C_asm) _DO(C_asmExpr) _DO(C_asmExprArg) \
_DO(C_aggregate) _DO(C_attribute) _DO(C_postfix) _DO(C_compound) _DO(C_functionDef) \
_DO(C_exprStatement) _DO(C_switch) _DO(C_goto) _DO(C_continue) _DO(C_break) _DO(C_return) \
_DO(C_case) _DO(C_default) _DO(C_label) _DO(C_labelDeclaration) _DO(C_structSpec) \
_DO(C_structDeclarator) _DO(C_enumSpec) _DO(C_enum)
typedef enum {
t_UNDEFINED=0,
#define _DO(NAME) t_##NAME,
DO_PROTOS()
#undef _DO
} proto_t;
#define SYMBOL_PAYLOAD proto_t prototype; int is_C_keyword;
#define DELTA 3
#include "scope.c"
#include "object.c"
#define DO_C_KEYWORDS() \
_DO(__alignof__) _DO(__alignof) _DO(asm) _DO(__asm) _DO(__asm__) _DO(__attribute__) _DO(auto) \
_DO(_Bool) _DO(break) _DO(case) _DO(char) _DO(_Complex) _DO(const) _DO(__const) _DO(continue) \
_DO(default) _DO(do) _DO(double) _DO(else) _DO(enum) _DO(extern) _DO(float) _DO(for) _DO(goto) \
_DO(if) _DO(inline) _DO(int) _DO(long) _DO(register) _DO(restrict) _DO(return) _DO(short) \
_DO(signed) _DO(sizeof) _DO(static) _DO(struct) _DO(switch) _DO(typedef) _DO(typeof) \
_DO(__typeof__) _DO(union) _DO(unsigned) _DO(void) _DO(volatile) _DO(while)
#define DO_C_KEYWORDS_GNU() \
_DO(__complex__) _DO(__inline__) _DO(__imag__) _DO(__label__) _DO(__real__)
#include <setjmp.h>
enum jb_t {
j_return = 1,
j_break,
j_continue,
j_throw,
};
typedef struct jb_record
{
sigjmp_buf jb;
oop result;
struct jb_record *next;
} jb_record;
jb_record *jbs= NULL;
#define jbRecPush() \
struct jb_record jbrec; \
jbrec.next= jbs; \
jbs= &jbrec
#define jbRecPop() \
assert(jbs == &jbrec); \
jbs= jbrec.next
// this is the global scope
oop globals= 0;
#define DO_SYMBOLS() \
DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__) \
_DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate) \
_DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise) \
_DO(update) _DO(this) _DO(fixed) _DO(operator) _DO(map) _DO(func) \
_DO(try) _DO(catch) _DO(finally) _DO(exception) \
_DO(__line__) _DO(__file__) \
_DO(comment) \
_DO(text) _DO(ifTok) _DO(lparen) _DO(rparen) _DO(elseTok) _DO(identifier) _DO(semicolon) \
_DO(whileTok) \
_DO(doTok) _DO(forTok) _DO(initExpr) _DO(condExpr) _DO(incrExpr) _DO(firstSemi) _DO(secondSemi) \
_DO(binary) _DO(specifiers) _DO(declarators) \
_DO(rightCurly) _DO(leftCurly) _DO(initList) _DO(comma) _DO(constExpr1) _DO(constExpr2) \
_DO(ellipsis) _DO(logicalOr) _DO(question) _DO(colon) _DO(leftBracket) _DO(rightBracket) \
_DO(primaryExpr) _DO(typeQualList) _DO(star) _DO(bxor) _DO(paramTypeL) _DO(assignExpr) \
_DO(static) _DO(dynamic) _DO(typeName) _DO(sizeOfTok) _DO(alignOfTok) _DO(llparen) _DO(lrparen) \
_DO(rlparen) _DO(rrparen) _DO(attributeL) _DO(attributeTok) _DO(typeOfTok) _DO(asmTok) _DO(element) \
_DO(volatileTok) _DO(gotoTok) _DO(declarationL) _DO(compoundS) _DO(switchTok) _DO(continueTok) \
_DO(breakTok) _DO(returnTok) _DO(caseTok) _DO(defaultTok) _DO(attribute1) _DO(attribute2) \
_DO(structTok) _DO(enumList) _DO(enumTok)
#define _DO(NAME) oop NAME##_symbol;
DO_SYMBOLS()
#undef _DO
#define _DO(NAME) oop NAME##_proto;
DO_PROTOS()
#undef _DO
int opt_g= 0;
int opt_v= 0;
oop mrAST= &_null;
void printBacktrace(oop top);
void runtimeError(char *fmt, ...);
typedef struct input_t
{
oop name;
FILE *file;
struct input_t *next;
int lineNumber;
} input_t;
input_t *inputStack= NULL;
void inputStackPush(char *name) {
FILE *file = stdin;
if (NULL != name) {
file= fopen(name, "rb");
if (NULL == file) {
perror(name);
exit(1);
}
} else {
name= "<stdin>";
}
input_t *input = malloc(sizeof(input_t));
input->name= makeString(name);
input->lineNumber= 1;
input->file= file;
input->next= inputStack;
inputStack= input;
return;
}
input_t *inputStackPop(void) {
assert(inputStack);
input_t *first= inputStack;
inputStack= first->next;
return first;
}
int isFalse(oop obj)
{
return obj == null || (isInteger(obj) && (0 == getInteger(obj)));
}
int isTrue(oop obj)
{
return !isFalse(obj);
}
oop newObject(oop proto)
{
oop map = makeMap();
map_set(map, __proto___symbol, proto);
// set context (file and line) for runtime error msg
map_set(map, __line___symbol, makeInteger(inputStack->lineNumber));
map_set(map, __file___symbol, inputStack->name);
return map;
}
void printObjectName(oop object)
{
assert(is(Map, object));
oop name = map_get(object, __name___symbol);
if (name != null) {
println(name);
return;
}
oop proto = map_get(object, __proto___symbol);
if (proto != null) {
printObjectName(proto);
} else {
fprintf(stderr, "\nThis map has no name\n");
}
}
// this always creates the key in "object"
oop newVariable(oop object, oop key, oop value)
{
map_set(object, key, value);
return value;
}
// this looks in object and everything in the __proto__ chain until it finds the key;
// if the key is not found and it is #__proto__ then the Map prototype is returned
oop getVariable(oop object, oop key)
{
while (!map_hasKey(object, key)) {
object = map_get(object, __proto___symbol);
if (null == object) {
if (key == __proto___symbol)
return getVariable(globals, Map_symbol);
runtimeError("Undefined: %s", printString(key));
}
}
return map_get(object, key);
}
oop getMember(oop object, oop key)
{
while (!map_hasKey(object, key)) {
object = map_get(object, __proto___symbol);
if (null == object) {
return null;
}
}
return map_get(object, key);
}
oop newNullObject() {
return null;
}
/** C constructors used when a program is parsed to build an AST */
oop new_C_if(oop ifTok, oop lParen, oop condition, oop rParen, oop consequent, oop elseTok, oop alternate)
{
oop obj = newObject(C_if_proto);
map_set(obj, ifTok_symbol, ifTok);
map_set(obj, lparen_symbol, lParen);
map_set(obj, condition_symbol, condition);
map_set(obj, rparen_symbol, rParen);
map_set(obj, consequent_symbol, consequent);
map_set(obj, elseTok_symbol, elseTok);
map_set(obj, alternate_symbol, alternate);
return obj;
}
oop new_C_while(oop whileTok, oop lParen, oop expression, oop rParen, oop statement)
{
oop object = newObject(C_while_proto);
map_set(object, whileTok_symbol, whileTok);
map_set(object, lparen_symbol, lParen);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_do(oop doTok, oop statement, oop whileTok, oop lParen, oop expression, oop rParen, oop semicolon)
{
oop object = newObject(C_do_proto);
map_set(object, doTok_symbol, doTok);
map_set(object, statements_symbol, statement);
map_set(object, whileTok_symbol, whileTok);
map_set(object, lparen_symbol, lParen);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_for(oop forTok, oop lParen, oop initExpr, oop semicolon1, oop condExpr, oop semicolon2, oop incrExpr, oop rParen, oop statement)
{
oop object = newObject(C_for_proto);
map_set(object, forTok_symbol, forTok);
map_set(object, lparen_symbol, lParen);
map_set(object, initExpr_symbol, initExpr);
map_set(object, firstSemi_symbol, semicolon1);
map_set(object, condExpr_symbol, condExpr);
map_set(object, secondSemi_symbol, semicolon2);
map_set(object, incrExpr_symbol, incrExpr);
map_set(object, rparen_symbol, rParen);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_goto(oop gotoTok, oop star, oop id, oop semicolon) {
oop object = newObject(C_goto_proto);
map_set(object, gotoTok_symbol, gotoTok);
map_set(object, star_symbol, star);
map_set(object, name_symbol, id);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_initializer(oop leftCurly, oop initList, oop comma, oop rightCurly) {
oop object = newObject(C_initializer_proto);
map_set(object, leftCurly_symbol, leftCurly);
map_set(object, initList_symbol, initList);
map_set(object, comma_symbol, comma);
map_set(object, rightCurly_symbol, rightCurly);
return object;
}
oop new_C_range(oop constExpr1, oop ellipsis, oop constExpr2) {
oop object = newObject(C_range_proto);
map_set(object, constExpr1_symbol, constExpr1);
map_set(object, ellipsis_symbol, ellipsis);
map_set(object, constExpr2_symbol, constExpr2);
return object;
}
oop new_C_switch(oop switchTok, oop lParen, oop expression, oop rParen, oop statement) {
oop object = newObject(C_switch_proto);
map_set(object, switchTok_symbol, switchTok);
map_set(object, lparen_symbol, lParen);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_case (oop caseTok, oop expression, oop colon, oop statement) {
oop object = newObject(C_case_proto);
map_set(object, caseTok_symbol, caseTok);
map_set(object, expression_symbol, expression);
map_set(object, colon_symbol, colon);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_default(oop defaultTok, oop colon, oop statement) {
oop object = newObject(C_default_proto);
map_set(object, defaultTok_symbol, defaultTok);
map_set(object, colon_symbol, colon);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_attribution(oop specifier, oop declarator) {
oop object = newObject(C_attribution_proto);
map_set(object, specifiers_symbol, specifier);
map_set(object, declarators_symbol, declarator);
return object;
}
oop new_C_deref(oop star, oop typeQualiferL, oop declarator) {
oop object = newObject(C_deref_proto);
map_set(object, star_symbol, star);
map_set(object, typeQualList_symbol,typeQualiferL);
map_set(object, declarators_symbol, declarator);
return object;
}
oop new_C_functionDef(oop specifiers, oop declarator, oop declarationList, oop compoundStatement) {
oop object = newObject(C_functionDef_proto);
map_set(object, specifiers_symbol, specifiers);
map_set(object, declarators_symbol, declarator);
map_set(object, declarationL_symbol,declarationList);
map_set(object, compoundS_symbol, compoundStatement);
return object;
}
oop new_C_int(char *text) {
oop object = newObject(C_int_proto);
map_set(object, text_symbol, makeString(text));
return object;
}
oop new_C_float(char *text) {
oop object = newObject(C_float_proto);
map_set(object, text_symbol, makeString(text));
return object;
}
int digitValue(int c)
{
if (c < '0') return -1;
if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c)
if ('9' < c && c < 'A') return -1;
if ('Z' < c) return -1;
if (c >= 'A') c -= ('A' - 10); else c -= '0';
return c;
}
int isradix(int r, int c)
{
c= digitValue(c);
return 0 <= c && c < r;
}
char *unescape(char *s)
{
char *t= strdup(s);
int in= 0, out= 0, c= 0;
while (0 != (c= t[in++])) {
if ('\\' == c && 0 != (c= t[in])) {
++in;
switch (c) {
case 'a': c= '\a'; break;
case 'b': c= '\b'; break;
case 'e': c= '\e'; break;
case 'f': c= '\f'; break;
case 'n': c= '\n'; break;
case 'r': c= '\r'; break;
case 't': c= '\t'; break;
case 'v': c= '\v'; break;
case '0'...'7': {
c -= '0';
if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
break;
}
case 'x': {
c= 0;
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
break;
}
case 'u': {
c= 0;
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
break;
}
}
}
t[out++]= c;
}
t[out]= 0;
return t;
}
oop new_C_string(oop str) {
oop object = newObject(C_string_proto);
map_set(object, text_symbol, str);
return object;
}
oop new_C_char(char *s) {
oop object = newObject(C_char_proto);
map_set(object, value_symbol, makeString(s));
return object;
}
oop new_C_id(char* id) {
oop object = newObject(C_id_proto);
map_set(object, identifier_symbol, intern(id));
return object;
}
oop new_C_sizeOf(oop sizeOfTok, oop lParen, oop typeName, oop rParen) {
oop object = newObject(C_sizeOf_proto);
map_set(object, sizeOfTok_symbol, sizeOfTok);
map_set(object, lparen_symbol, lParen);
map_set(object, typeName_symbol, typeName);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_alignOf(oop alignOfTok, oop lParen, oop typeName, oop rParen) {
oop object = newObject(C_alignOf_proto);
map_set(object, alignOfTok_symbol, alignOfTok);
map_set(object, lparen_symbol, lParen);
map_set(object, typeName_symbol, typeName);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_prefix(oop operator, oop expression) {
oop object = newObject(C_prefix_proto);
map_set(object, operator_symbol, operator);
map_set(object, expression_symbol, expression);
return object;
}
oop new_C_postfix(oop expression, oop operator) {
oop object = newObject(C_postfix_proto);
map_set(object, expression_symbol, expression);
map_set(object, operator_symbol, operator);
return object;
}
oop new_C_unary(oop operator, oop expression) {
oop object = newObject(C_unary_proto);
map_set(object, operator_symbol, operator);
map_set(object, expression_symbol, expression);
return object;
}
oop new_C_binary(oop lhs, oop binary, oop rhs) {
oop object = newObject(C_binary_proto);
map_set(object, lhs_symbol, lhs);
map_set(object, binary_symbol, binary);
map_set(object, rhs_symbol, rhs);
return object;
}
oop new_C_compound(oop leftCurly, oop expression, oop rightCurly) {
oop object = newObject(C_compound_proto);
map_set(object, leftCurly_symbol, leftCurly);
map_set(object, expression_symbol, expression);
map_set(object, rightCurly_symbol, rightCurly);
return object;
}
oop new_C_subexpr (oop lParen, oop declarator, oop rParen) {
oop object = newObject(C_subexpr_proto);
map_set(object, lparen_symbol, lParen);
map_set(object, declarators_symbol, declarator);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_call(oop declarator, oop lParen, oop paramTypeL, oop rParen) {
oop object = newObject(C_call_proto);
map_set(object, declarators_symbol, declarator);
map_set(object, lparen_symbol, lParen);
map_set(object, paramTypeL_symbol, paramTypeL);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_array(oop declarator, oop lBracket, oop staticTok, oop typeQualiferL, oop symbol, oop assignExpr, oop rBracket) {
oop object = newObject(C_array_proto);
map_set(object, declarators_symbol, declarator);
map_set(object, leftBracket_symbol, lBracket);
map_set(object, static_symbol, staticTok);
map_set(object, typeQualList_symbol,typeQualiferL);
map_set(object, dynamic_symbol, symbol);
map_set(object, assignExpr_symbol, assignExpr);
map_set(object, rightBracket_symbol,rBracket);
return object;
}
oop new_C_block(oop bxor, oop typeQualiferL, oop declarator) {
oop object = newObject(C_block_proto);
map_set(object, bxor_symbol, bxor);
map_set(object, typeQualList_symbol,typeQualiferL);
map_set(object, declarators_symbol, declarator);
return object;
}
oop new_C_continue(oop continueTok, oop semicolon) {
oop object = newObject(C_continue_proto);
map_set(object, continueTok_symbol, continueTok);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_break(oop breakTok, oop semicolon) {
oop object = newObject(C_break_proto);
map_set(object, breakTok_symbol, breakTok);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_return(oop returnTok, oop expression, oop semicolon) {
oop object = newObject(C_return_proto);
map_set(object, returnTok_symbol, returnTok);
map_set(object, expression_symbol, expression);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_exprStatement(oop expression, oop semicolon) {
oop object = newObject(C_exprStatement_proto);
map_set(object, expression_symbol, expression);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_asm(oop asmTok, oop lParen, oop stringLiteral, oop rParen) {
oop object = newObject(C_asm_proto);
map_set(object, asmTok_symbol, asmTok);
map_set(object, lparen_symbol, lParen);
map_set(object, text_symbol, stringLiteral);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_asmExpr(oop asmTok, oop volatileTok, oop gotoTok, oop lParen, oop stringLiteral, oop list, oop rParen) {
oop object = newObject(C_asmExpr_proto);
map_set(object, asmTok_symbol, asmTok);
map_set(object, volatileTok_symbol, volatileTok);
map_set(object, gotoTok_symbol, gotoTok);
map_set(object, lparen_symbol, lParen);
map_set(object, text_symbol, stringLiteral);
map_set(object, element_symbol, list);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_asmExprArg(oop stringLiteral, oop lParen, oop expression, oop rParen) {
oop object = newObject(C_asmExprArg_proto);
map_set(object, text_symbol, stringLiteral);
map_set(object, lparen_symbol, lParen);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_declaration(oop specifiers, oop declarators, oop semicolon) {
oop object = newObject(C_declaration_proto);
map_set(object, specifiers_symbol, specifiers);
map_set(object, declarators_symbol, declarators);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_parameter(oop paramSpecifiers, oop declarator) {
oop object = newObject(C_parameter_proto);
map_set(object, specifiers_symbol, paramSpecifiers);
map_set(object, declarators_symbol, declarator);
return object;
}
OopStack listOfLists= BUFFER_INITIALISER;
oop currentList= 0;
void listBegin(void)
{
OopStack_push(&listOfLists, currentList);
currentList= makeMap();
}
void listAppend(oop obj)
{
assert(currentList);
map_append(currentList, obj);
}
void listAppend2(oop obj1, oop obj2) {
assert(currentList);
map_append(currentList, obj1);
map_append(currentList, obj2);
}
void listWith(oop obj) {
listBegin();
listAppend(obj);
}
oop listEnd(void)
{
assert(currentList);
oop list= currentList;
currentList= OopStack_pop(&listOfLists);
return list;
}
void List_addLast(oop list, oop obj) {
assert(list);
map_append(list, obj);
}
oop listEmpty(void)
{
return makeMap();
}
int typedeffing = 0;
void declarationTypedef(void) {
typedeffing++;
}
void C_declarationBegin(void) {
typedeffing = 0;
}
int C_declarationAbort(void) {
typedeffing = 0;
return 0;
}
void C_declarationEnd(void) {
typedeffing = 0;
}
void C_scopeBegin(void) {
pushScope();
}
int C_scopeAbort(void) {
popScope();
assert(actualScope);
return 0;
}
void C_scopeEnd(void) {
popScope();
assert(actualScope);
}
int declarationId(char *s) {
if (!typedeffing) return 0;
addId(s);
return 1;
}
int isTypedefName(char *s) {
if (!isTypedefed(s)) return 0;
return 1;
}
oop new_C_conditional(oop logicalOrExpression, oop question, oop expression, oop colon, oop conditionalExpression) {
oop object = newObject(C_conditional_proto);
map_set(object, logicalOr_symbol, logicalOrExpression);
map_set(object, question_symbol, question);
map_set(object, expression_symbol, expression);
map_set(object, colon_symbol, colon);
map_set(object, condExpr_symbol, conditionalExpression);
return object;
}
oop new_C_designation(oop id, oop colon) {
oop object = newObject(C_designation_proto);
map_set(object, identifier_symbol, id);
map_set(object, colon_symbol, colon);
return object;
}
oop new_C_index(oop primaryExpression, oop lBracket, oop expression, oop rBracket) {
oop object = newObject(C_index_proto);
map_set(object, primaryExpr_symbol, primaryExpression);
map_set(object, leftBracket_symbol, lBracket);
map_set(object, expression_symbol, expression);
map_set(object, rightBracket_symbol,rBracket);
return object;
}
oop new_C_typeOf(oop typeOf, oop lParen, oop typeName, oop expression, oop rParen) {
oop object = newObject(C_typeOf_proto);
map_set(object, typeOfTok_symbol, typeOf);
map_set(object, lparen_symbol, lParen);
map_set(object, typeName_symbol, typeName);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_cast(oop lParen, oop typeName, oop rParen, oop expression) {
oop object = newObject(C_cast_proto);
map_set(object, lparen_symbol, lParen);
map_set(object, typeName_symbol, typeName);
map_set(object, rparen_symbol, rParen);
map_set(object, expression_symbol, expression);
return object;
}
oop new_C_attributeSpec(oop attributeTok, oop llParen, oop lrParen, oop attributeList, oop rlParen, oop rrParen) {
oop object = newObject(C_attributeSpec_proto);
map_set(object, attributeTok_symbol,attributeTok);
map_set(object, llparen_symbol, llParen);
map_set(object, lrparen_symbol, lrParen);
map_set(object, attributeL_symbol, attributeList);
map_set(object, rlparen_symbol, rlParen);
map_set(object, rrparen_symbol, rrParen);
return object;
}
oop new_C_aggregate(oop lParen, oop typeName, oop rParen, oop leftCurly, oop initList, oop comma, oop rightCurly) {
oop object = newObject(C_aggregate_proto);
map_set(object, lparen_symbol, lParen);
map_set(object, typeName_symbol, typeName);
map_set(object, rparen_symbol, rParen);
map_set(object, leftCurly_symbol, leftCurly);
map_set(object, initList_symbol, initList);
map_set(object, comma_symbol, comma);
map_set(object, rightCurly_symbol, rightCurly);
return object;
}
oop new_C_attribute(oop name, oop lParen, oop expression, oop rParen) {
oop object = newObject(C_attribute_proto);
map_set(object, text_symbol, name);
map_set(object, lparen_symbol, lParen);
map_set(object, expression_symbol, expression);
map_set(object, rparen_symbol, rParen);
return object;
}
oop new_C_label(oop id, oop colon, oop attributeSpecifier, oop statement) {
oop object = newObject(C_label_proto);
map_set(object, name_symbol, id);
map_set(object, colon_symbol, colon);
map_set(object, attributeL_symbol, attributeSpecifier);
map_set(object, statements_symbol, statement);
return object;
}
oop new_C_labelDeclaration(oop labelTok, oop list, oop semicolon) {
oop object = newObject(C_labelDeclaration_proto);
map_set(object, labels_symbol, labelTok);
map_set(object, element_symbol, list);
map_set(object, semicolon_symbol, semicolon);
return object;
}
oop new_C_structSpec(oop structTok, oop attributeSpecifier1, oop id, oop leftCurly, oop declarationList, oop rightCurly, oop attributeSpecifier2) {
oop object = newObject(C_structSpec_proto);
map_set(object, structTok_symbol, structTok);
map_set(object, attribute1_symbol, attributeSpecifier1);
map_set(object, name_symbol, id);
map_set(object, leftCurly_symbol, leftCurly);
map_set(object, declarationL_symbol,declarationList);
map_set(object, rightCurly_symbol, rightCurly);
map_set(object, attribute2_symbol, attributeSpecifier2);
return object;
}
oop new_C_structDeclarator(oop declarator, oop colon, oop expression) {
oop object = newObject(C_structDeclarator_proto);
map_set(object, declarators_symbol, declarator);
map_set(object, colon_symbol, colon);
map_set(object, expression_symbol, expression);
return object;
}
oop new_C_enumSpec(oop enumTok, oop id, oop leftCurly, oop enumeratorList, oop rightCurly) {
oop object = newObject(C_enumSpec_proto);
map_set(object, enumTok_symbol, enumTok);
map_set(object, name_symbol, id);
map_set(object, leftCurly_symbol, leftCurly);
map_set(object, enumList_symbol, enumeratorList);
map_set(object, rightCurly_symbol, rightCurly);
return object;
}
oop new_C_enumerator(oop id, oop attributeSpecifier, oop expression) {
oop object = newObject(C_enum_proto);
map_set(object, name_symbol, id);
map_set(object, attributeL_symbol, attributeSpecifier);
map_set(object, expression_symbol, expression);
return object;
}
#define YY_INPUT(buf, result, max_size) \
{ \
int yyc= feof(inputStack->file) ? EOF : getc(inputStack->file); \
result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \
}
#define YYSTYPE oop
YYSTYPE yylval= 0;
int errorLine= 1;
void syntaxError(char *text)
{
fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text);
exit(1);
}
oop eval(oop scope, oop ast);
struct _yycontext;
int yyparsefrom(int (*yystart)(struct _yycontext *yy));
int irow= 0, icol= 0;
int gnu= 1;
int apl = 0; //TODO
char *errmsg= "no error";
void error(char *source)
{
fprintf(stderr, "\n%s near: %s\n", errmsg, source);
exit(1);
}
#define newBegin() newToken("{")
#define newEnd() newToken("}")
oop newToken(char *text)
{
oop obj = newObject(Token_proto);
map_set(obj, text_symbol, makeString(text));
icol += strlen(text);
return obj;
}
oop newComment(char *text)
{
oop obj = newObject(Comment_proto);
map_set(obj, text_symbol, makeString(text));
return obj;
}
void setComment(oop ast, oop comment)
{
map_set(ast, comment_symbol, comment);
}
/* Meta Functions */
oop setVariable(oop object, oop key, oop value)
{
oop obj= object;
while (!map_hasKey(obj, key)) {
obj= map_get(obj, __proto___symbol);
if (null == obj) {
return map_set(object, key, value);
}
}
return map_set(obj, key, value);
}
oop getProperty(oop object, oop key)
{
if (!map_hasKey(object, key)) {
runtimeError("Undefined: .%s", printString(key));
}
return map_get(object, key);
}
oop newMap(oop value)
{
oop map = newObject(Map_proto);
map_set(map, value_symbol, value);
return map;
}
oop newDeclaration(oop name, oop exp)
{
oop declaration = newObject(Declaration_proto);
map_set(declaration, lhs_symbol, name);
map_set(declaration, rhs_symbol, exp);
return declaration;
}
oop newIf(oop cond, oop cons, oop alt)
{
oop obj = newObject(If_proto);
map_set(obj, condition_symbol, cond);
map_set(obj, consequent_symbol, cons);
map_set(obj, alternate_symbol, alt);
return obj;
}
oop newWhile(oop cond, oop body)
{
oop obj = newObject(While_proto);
map_set(obj, condition_symbol, cond);
map_set(obj, body_symbol, body);
return obj;
}
oop newDo(oop body, oop cond)
{
oop obj= newObject(Do_proto);
map_set(obj, body_symbol, body);
map_set(obj, condition_symbol, cond);
return obj;
}
oop newFor(oop init, oop cond, oop step, oop body)
{
oop obj= newObject(For_proto);
map_set(obj, initialise_symbol, init);
map_set(obj, condition_symbol, cond);
map_set(obj, update_symbol, step);
map_set(obj, body_symbol, body);
return obj;
}
oop newForIn(oop name, oop expression, oop body)
{
oop obj= newObject(ForIn_proto);
map_set(obj, name_symbol, name);
map_set(obj, expression_symbol, expression);
map_set(obj, body_symbol, body);
return obj;
}
oop newSwitch(oop expression, oop labels, oop statements)
{
oop obj= newObject(Switch_proto);
map_set(obj, expression_symbol, expression);
map_set(obj, labels_symbol, labels);
map_set(obj, statements_symbol, statements);
return obj;
}
// take char *name or oop already interned?
oop newSymbol(oop name)
{
oop symbol = newObject(Symbol_proto);
// what is the less confusing, name or value? maybe another word like identifier?
map_set(symbol, value_symbol, name);
return symbol;
}
oop newInteger(oop value)
{
oop integer = newObject(Integer_proto);
map_set(integer, value_symbol, value);
return integer;
}
oop newFloat(oop value)
{
oop obj = newObject(Float_proto);
map_set(obj, value_symbol, value);
return obj;
}
oop newString(oop str)
{ assert(is(String, str));
oop string = newObject(String_proto);
map_set(string, value_symbol, str);
return string;
}
oop newPreIncrement(oop rhs)
{ assert(is(Map, rhs));
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
oop name= map_get(proto, __name___symbol); assert(null != name);
proto_t type= get(name, Symbol, prototype);
switch (type) {
case t_GetVariable: proto= PreIncVariable_proto; break;
case t_GetMember: proto= PreIncMember_proto; break;
case t_GetIndex: proto= PreIncIndex_proto; break;
default: {
printf("\nNon-lvalue after ++: ");
println(rhs);
exit(1);
}
}
map_set(rhs, __proto___symbol, proto);
return rhs;
}
oop newPostIncrement(oop rhs)
{ assert(is(Map, rhs));
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
oop name= map_get(proto, __name___symbol); assert(null != name);
proto_t type= get(name, Symbol, prototype);
switch (type) {
case t_GetVariable: proto= PostIncVariable_proto; break;
case t_GetMember: proto= PostIncMember_proto; break;
case t_GetIndex: proto= PostIncIndex_proto; break;
default: {
printf("\nNon-lvalue before ++: ");
println(rhs);
exit(1);
}
}
map_set(rhs, __proto___symbol, proto);
return rhs;
}
oop newPreDecrement(oop rhs)
{ assert(is(Map, rhs));
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
oop name= map_get(proto, __name___symbol); assert(null != name);
proto_t type= get(name, Symbol, prototype);
switch (type) {
case t_GetVariable: proto= PreDecVariable_proto; break;
case t_GetMember: proto= PreDecMember_proto; break;
case t_GetIndex: proto= PreDecIndex_proto; break;
default: {
printf("\nNon-lvalue after ++: ");
println(rhs);
exit(1);
}
}
map_set(rhs, __proto___symbol, proto);
return rhs;
}
oop newPostDecrement(oop rhs)
{ assert(is(Map, rhs));
oop proto= map_get(rhs, __proto___symbol); assert(null != proto);
oop name= map_get(proto, __name___symbol); assert(null != name);
proto_t type= get(name, Symbol, prototype);
switch (type) {
case t_GetVariable: proto= PostDecVariable_proto; break;
case t_GetMember: proto= PostDecMember_proto; break;
case t_GetIndex: proto= PostDecIndex_proto; break;
default: {
printf("\nNon-lvalue before ++: ");
println(rhs);
exit(1);
}
}
map_set(rhs, __proto___symbol, proto);
return rhs;
}
oop newUnary(oop proto, oop rhs)
{
oop obj = newObject(proto);
map_set(obj, rhs_symbol, rhs);
return obj;
}
oop newBinary(oop proto, oop lhs, oop rhs)
{
oop obj = newObject(proto);
map_set(obj, lhs_symbol, lhs);
map_set(obj, rhs_symbol, rhs);
return obj;
}
oop newAssign(oop proto, oop lhs, oop operator, oop rhs)
{
oop obj = newObject(proto);
map_set(obj, lhs_symbol, lhs);
map_set(obj, operator_symbol, operator);
map_set(obj, rhs_symbol, rhs);
return obj;
}
oop newSetMap(oop proto, oop map, oop key, oop operator, oop value)
{
oop obj = newObject(proto);
map_set(obj, map_symbol, map);
map_set(obj, key_symbol, key);
map_set(obj, operator_symbol, operator);
map_set(obj, value_symbol, value);
return obj;
}
oop newGetMap(oop proto, oop map, oop key)
{
oop obj = newObject(proto);
map_set(obj, map_symbol, map);
map_set(obj, key_symbol, key);
return obj;
}
oop newGetVariable(oop name)
{
oop id= newObject(GetVariable_proto);
map_set(id, key_symbol, name);
return id;
}
oop newFunc(oop name, oop param, oop body, oop fixed)
{
oop func = newObject(Func_proto);
map_set(func, name_symbol, name);
map_set(func, param_symbol, param);
map_set(func, body_symbol, body);
map_set(func, fixed_symbol, fixed);
return func;
}
oop apply(oop scope, oop this, oop func, oop args, oop ast);
oop getSyntaxId(int n, oop key)
{
oop val = map_get(globals, key);
if (!is(Function, val)) return null;
oop fix = get(val, Function, fixed);
if (!isInteger(fix)) return null;
if (n != getInteger(fix)) return null;
return val;
}
oop getSyntax(int n, oop func)
{
if (map_get(func, __proto___symbol) != GetVariable_proto) return null;
oop key = map_get(func, key_symbol);
return getSyntaxId(n, key);
}
oop newCall(oop func, oop args)
{
oop call = newObject(Call_proto);
map_set(call, func_symbol, func);
map_set(call, args_symbol, args);
return call;
}
oop newInvoke(oop this, oop name, oop args)
{
oop obj = newObject(Invoke_proto);
map_set(obj, this_symbol, this);
map_set(obj, name_symbol, name);
map_set(obj, args_symbol, args);
return obj;
}
oop newBlock(oop statements)
{
oop obj = newObject(Block_proto);
map_set(obj, statements_symbol, statements);
return obj;
}
oop newReturn(oop exp)
{
oop obj = newObject(Return_proto);
map_set(obj, value_symbol, exp);
return obj;
}
oop newBreak(void)
{
oop obj = newObject(Break_proto);
return obj;
}
oop newContinue(void)
{
oop obj = newObject(Continue_proto);
return obj;
}
oop newTry(oop try, oop exception, oop catch, oop finally)
{
oop obj = newObject(Try_proto);
map_set(obj, try_symbol, try);
map_set(obj, exception_symbol, exception);
map_set(obj, catch_symbol, catch);
map_set(obj, finally_symbol, finally);
return obj;
}
int toPrint = 0;
typedef enum {
META = 0,
C = 1,
} language;
language lang = C, printLang = C;
%}
#--------------------------------------------- C grammar -------------------------------------------------#
# yylval == null => "pseudo" op, e.g., change language -- ignored by REPL
# yylval == 0 => end of input file while in META mode only
start = META_AT META_LPAREN s:meta_exp META_RPAREN { yylval= s }
| META_AT META_LCB { yylval= null; lang= META }
| &{ lang == META } - s:meta { yylval= s }
| &{ lang == META } - META_RCB { yylval= null; lang= C }
| &{ lang == C } s:externalDeclaration { yylval= s }
error = EOL* < (!EOL .)* EOL* (!EOL .)* > &{ error(yytext), 1 }
### A.1.3 Identifiers
# 6.4.2.1
idOpt = id | {$$=newNullObject()}
id = <ID> { $$= new_C_id(yytext) } -
ID = <NAME> &{ !get(intern(yytext), Symbol, is_C_keyword) }
name = <NAME> { $$= new_C_id(yytext) } -
NAME = IDFIRST IDREST*
IDFIRST = [a-zA-Z_] | universalCharacterName | '$' &{gnu}
IDREST = IDFIRST | [0-9]
digit = [0-9]
### A.1.4 Universal character names
# 6.4.3
universalCharacterName = "\\u" hexQuad | "\\U" hexQuad hexQuad
hexQuad = hexadecimalDigit hexadecimalDigit hexadecimalDigit hexadecimalDigit
###
### A.1.5 Constants
# 6.4.4
constant = characterConstant
| floatingConstant
| integerConstant
# 6.4.4.1
integerConstant = < ( hexadecimalConstant
| octalConstant
| binaryConstant &{gnu}
| decimalConstant
) integerSuffix? > { $$ = new_C_int(yytext); } -
decimalConstant = [1-9][0-9]*
octalConstant = '0'[0-9]*
hexadecimalConstant = hexadecimalPrefix [a-fA-F0-9]+
binaryConstant = '0'[bB][01]+
hexadecimalPrefix = '0'[xX]
octalDigit = [0-7]
hexadecimalDigit = [0-9A-Fa-f]
integerSuffix = ( [uU][lL]?[lL]? | [lL][lL]?[uU]? ) ( imaginarySuffix &{gnu} )?
imaginarySuffix = [ij]
# 6.4.4.2
floatingConstant = <( decimalFloatingConstant | hexadecimalFloatingConstant )> { $$ = new_C_float(yytext); } -
decimalFloatingConstant = fractionalConstant exponentPart? floatingSuffix?
| digitSequence exponentPart floatingSuffix?
hexadecimalFloatingConstant = hexadecimalPrefix hexadecimalFractionalConstant binaryExponentPart floatingSuffix?
| hexadecimalPrefix hexadecimalDigitSequence binaryExponentPart floatingSuffix?
fractionalConstant = digitSequence '.' digitSequence?
| '.' digitSequence
exponentPart = [eE] [-+]? digitSequence
digitSequence = digit+
hexadecimalFractionalConstant = hexadecimalDigitSequence '.' hexadecimalDigitSequence?
| '.' hexadecimalDigitSequence
binaryExponentPart = [pP] [-+]? digitSequence
hexadecimalDigitSequence = hexadecimalDigit+
floatingSuffix = [fFlL] imaginarySuffix?
# 6.4.4.4
characterConstant = < "'" cCharSequence "'" > { $$ = new_C_char(yytext) } -
| < "L'" cCharSequence "'" > { $$ = new_C_char(yytext) } -
cCharSequence = ( escapeSequence | !EOL [^\'\\] )*
escapeSequence = simpleEscapeSequence
| octalEscapeSequence
| hexadecimalEscapeSequence
| universalCharacterName
| '\\' EOL
| '\\' Blank+ EOL &{gnu}
| '\\' . &{gnu}
simpleEscapeSequence = '\\'([\'\"?\\abfnrtv] | 'e' &{gnu})
octalEscapeSequence = '\\' octalDigit octalDigit? octalDigit?
hexadecimalEscapeSequence = '\\x' hexadecimalDigit+
### A.1.6 String literals
# 6.4.5
stringLiteral = { listBegin(); }
( s:stringLiteralPart { listAppend(s) }
)+ { $$= new_C_string(listEnd()) }
stringLiteralPart = < '"' sCharSequence '"' > { $$= new_C_char(yytext) } -
| < 'L''"' sCharSequence '"' > { $$= new_C_char(yytext) } -
sCharSequence = ( escapeSequence | !EOL [^\"\\] )*
### A.2.1 Expressions
# 6.5.1
primaryExpression = stringLiteral | constant | id
| l:LPAREN x:expression r:RPAREN { $$= new_C_subexpr(l, x, r) }
| l:LPAREN x:compoundStatement r:RPAREN &{gnu} { $$= new_C_subexpr(l, x, r) }
# 6.5.2
postfixExpression = o:LPAREN l:typeName p:RPAREN
a:LCURLY r:initializerList ( c:COMMA | {c=newNullObject()} ) b:RCURLY { $$= new_C_aggregate(o, l, p, a, r, c, b) }
| l:primaryExpression
( o:LBRACKET r:expression p:RBRACKET { l= new_C_index(l, o, r, p) }
| o:LPAREN r:argumentExpressionList p:RPAREN { l= new_C_call(l, o, r, p) }
| o:DOT r:id { l= new_C_binary(l, o, r) }
| o:PTR r:id { l= new_C_binary(l, o, r) }
| o:INC { l= new_C_postfix(l, o) }
| o:DEC { l= new_C_postfix(l, o) }
)* { $$= l }
argumentExpressionList = { listBegin() }
( x:assignmentExpression { listAppend(x) }
( c:COMMA x:assignmentExpression { listAppend2(c, x) }
)*
)? { $$= listEnd() }
# 6.5.3
unaryExpression = o:INC x:unaryExpression { $$= new_C_prefix(o, x) }
| o:DEC x:unaryExpression { $$= new_C_prefix(o, x) }
| o:unaryOperator x:castExpression { $$= new_C_unary(o, x) }
| s:SIZEOF ( l:LPAREN t:typeName r:RPAREN { $$= new_C_sizeOf(s, l, t, r) }
| x:unaryExpression { $$= new_C_sizeOf(s, newNullObject(), x, newNullObject()) }
)
| s:ALIGNOF ( l:LPAREN t:typeName r:RPAREN { $$= new_C_alignOf(s, l, t, r) }
| x:unaryExpression { $$= new_C_alignOf(s, newNullObject(), x, newNullObject()) }
) &{gnu}
| asmExpr &{gnu}
| postfixExpression
unaryOperator = BAND | STAR | PLUS | MINUS | BNOT | LNOT
| LAND &{gnu}
| REAL &{gnu}
| IMAG &{gnu}
# 6.5.4
castExpression = l:LPAREN t:typeName r:RPAREN x:castExpression { $$= new_C_cast(l, t, r, x) }
| unaryExpression
# 6.5.5
multiplicativeExpression = l:castExpression
( o:multiplicativeOperator r:castExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
multiplicativeOperator = STAR | DIV | MOD
# 6.5.6
additiveExpression = l:multiplicativeExpression
( o:additiveOperator r:multiplicativeExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
additiveOperator = PLUS | MINUS
# 6.5.7
shiftExpression = l:additiveExpression
( o:shiftOperator r:additiveExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
shiftOperator = LSHIFT | RSHIFT
# 6.5.8
relationalExpression = l:shiftExpression
( o:relationalOperator r:shiftExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
relationalOperator = LT | LTE | GT | GTE
# 6.5.9
equalityExpression = l:relationalExpression
( o:equalityOperator r:relationalExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
equalityOperator = EQUAL | NOT_EQUAL
# 6.5.10
andExpression = l:equalityExpression
( o:BAND r:equalityExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
# 6.5.11
exclusiveOrExpression = l:andExpression
( o:BXOR r:andExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
# 6.5.12
inclusiveOrExpression = l:exclusiveOrExpression
( o:BOR r:exclusiveOrExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
# 6.5.13
logicalAndExpression = l:inclusiveOrExpression
( o:LAND r:inclusiveOrExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
# 6.5.14
logicalOrExpression = l:logicalAndExpression
( o:LOR r:logicalAndExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
# 6.5.15
conditionalExpression = l:logicalOrExpression
( q:QUESTION m:expression c:COLON r:conditionalExpression { $$= new_C_conditional(l, q, m, c, r) }
| q:QUESTION c:COLON r:conditionalExpression &{gnu} { $$= new_C_conditional(l, q, newNullObject(), c, r) }
| { $$= l }
)
# 6.5.16
assignmentExpressionOpt = assignmentExpression | {$$=newNullObject()}
assignmentExpression = l:unaryExpression o:assignmentOperator r:assignmentExpression { $$= new_C_binary(l, o, r) }
| conditionalExpression
assignmentOperator = ASSIGN
| STAR_ASSIGN | DIV_ASSIGN | MOD_ASSIGN | PLUS_ASSIGN | MINUS_ASSIGN
| LSHIFT_ASSIGN | RSHIFT_ASSIGN | BAND_ASSIGN | BXOR_ASSIGN | BOR_ASSIGN
# 6.5.17
expression = l:assignmentExpression
( o:COMMA r:assignmentExpression { l= new_C_binary(l, o, r) }
)* { $$= l }
expressionOpt = expression | { $$= newNullObject() }
constantExpression = conditionalExpression
### A.2.2 Declarations
# 6.7
declaration = @{ C_declarationBegin() }
( s:declarationSpecifiers
d:initDeclaratorListOpt
t:SEMI { $$= new_C_declaration(s, d, t) }
@{ C_declarationEnd() }
|
&{ C_declarationAbort() }
)
declarationSpecifiers = @{ int specified= 0 } { listBegin() }
( s:storageClassSpecifier { listAppend(s) }
| s:typeSpecifier @{ specified++ } { listAppend(s) }
# Any list of specifiers and qualifiers at the start of a declaration may contain attribute specifiers
| s:attributeSpecifier &{gnu} { listAppend(s) }
| s:typedefName &{ !specified++ } { listAppend(s) }
| s:typeQualifier { listAppend(s) }
| s:functionSpecifier { listAppend(s) }
)+ { $$= listEnd() }
| &{gnu} { $$= listEmpty() }
initDeclaratorListOpt = initDeclaratorList | { $$= listEmpty() }
initDeclaratorList = d:initDeclarator { listWith(d) }
( c:COMMA d:initDeclarator { listAppend2(c, d) }
)* { $$= listEnd() }
initDeclarator = d:declarator
( a:ASSIGN i:initializer &{ !typedeffing } { d= new_C_binary(d, a, i) }
)? { $$= d }
# 6.7.1
storageClassSpecifier = TYPEDEF @{ declarationTypedef() }
| AUTO
| parameterStorageClassSpecifier
| functionStorageClassSpecifier
parameterStorageClassSpecifier = REGISTER
functionStorageClassSpecifier = EXTERN | STATIC
# 6.7.2
typeSpecifier = VOID | CHAR | SHORT | INT | LONG | FLOAT | DOUBLE | SIGNED | UNSIGNED | BOOL | COMPLEX
| ( BUILTIN_VA_LIST | _FLOAT128 )
| structOrUnionSpecifier
| enumSpecifier
# 6.7.2.1
structOrUnionSpecifier = s:structOrUnion
# An attribute specifier list may appear as part of a struct, union or enum specifier. It may go
# either immediately after the struct, union or enum keyword...
( a:attributeSpecifiers &{gnu} | {a=newNullObject()} )
( i:idOpt ( @{ C_scopeBegin() }
l:LCURLY d:structDeclarationList r:RCURLY
@{ C_scopeEnd() }
| &{ C_scopeAbort() }
)
# ..., or after the closing brace.
( b:attributeSpecifiers &{gnu} | {b=newNullObject()} )
| i:id {l=d=r=b=newNullObject()}
) { $$= new_C_structSpec(s, a, i, l, d, r, b) }
structOrUnion = STRUCT | UNION
structDeclarationList = d:structDeclaration { listWith(d) }
( d:structDeclaration { listAppend(d) }
)* { $$= listEnd() }
| &{gnu} { $$= newNullObject() }
structDeclaration = s:specifierQualifierList d:structDeclaratorList t:SEMI
( &SEMI { listWith(t) }
( t:SEMI { listAppend(t) }
)* &{gnu} { t= listEnd() }
)? { $$= new_C_declaration(s, d, t) }
specifierQualifierList = @{ int specified= 0 } { listBegin() }
( ( t:typeSpecifier @{ specified++ }
| t:typedefName &{ !specified++ }
| t:typeQualifier
) { listAppend(t) }
)+ { $$= listEnd() }
structDeclaratorList = d:structDeclarator { listWith(d) }
( c:COMMA d:structDeclarator { listAppend2(c, d) }
)* { $$= listEnd() }
| &{gnu} { $$= newNullObject() }
structDeclarator = ( c:COLON e:constantExpression { d= new_C_structDeclarator(newNullObject(), c, e) }
| d:declarator ( c:COLON e:constantExpression | {c=e=newNullObject()} ) { d= new_C_structDeclarator(d, c, e) }
)
# An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier
( a:attributeSpecifiers { d= new_C_attribution(d, a) }
)? { $$= d }
# 6.7.2.2
enumSpecifier = e:ENUM
( i:idOpt l:LCURLY m:enumeratorList r:RCURLY { $$= new_C_enumSpec(e, i, l, m, r) }
| i:id { $$= new_C_enumSpec(e, i, newNullObject(), newNullObject(), newNullObject()) }
)
enumeratorList = e:enumerator { listWith(e) }
( c:COMMA e:enumerator { listAppend(c); listAppend(e) }
)*
( c:COMMA { listAppend(c) }
)? { $$= listEnd() }
enumerator = i:id
# an attribute specifier list may appear as part of an enumerator. The attribute goes after the
# enumeration constant, before =, if present.
( a:attributeSpecifier &{gnu} { i= new_C_attribution(i, a) }
)*
( a:ASSIGN e:constantExpression | {a=e=newNullObject()} ) { $$= new_C_enumerator(i, a, e) }
# 6.7.3
typeQualifier = CONST | RESTRICT | VOLATILE
| __RESTRICT
# 6.7.4
functionSpecifier = INLINE
| __INLINE
# 6.7.5
declarator = # An attribute specifier list may appear immediately before a declarator
a:attributeSpecifier d:declarator &{gnu} { $$= new_C_attribution(a, d) }
| p:STAR q:typeQualifierList d:declarator { $$= new_C_deref(p, q, d) }
| p:BXOR q:typeQualifierList d:declarator &{apl} { $$= new_C_block(p, q, d) }
| ( d:directDeclarator
# An attribute specifier list may appear immediately before the comma, = or semicolon terminating the declaration of an identifier
( &{gnu} a:attributeSpecifier { d= new_C_attribution(d, a) }
# an asm (or __asm__) keyword may appear after the declarator
| &{gnu} a:asm { d= new_C_attribution(d, a) }
)*
) { $$= d }
directDeclarator = ( l:LPAREN d:declarator r:RPAREN { d= new_C_subexpr(l, d, r) }
| &( <ID> @{ declarationId(yytext) } )
d:id
) ( @{ C_scopeBegin() }
( l:LPAREN p:parameterTypeList r:RPAREN { d= new_C_call (d, l, p, r) }
@{ C_scopeEnd() }
| l:LPAREN p:identifierListOpt r:RPAREN { d= new_C_call (d, l, p, r) }
@{ C_scopeEnd() }
| l:LBRACKET ( s:STATIC q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpression
| {s=newNullObject()} q:typeQualifierList t:STATIC e:assignmentExpressionOpt
| {s=newNullObject()} q:typeQualifierListOpt t:STAR {e=newNullObject()}
| {s=newNullObject()} q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpressionOpt ) r:RBRACKET { d= new_C_array(d, l, s, q, t, e, r) }
@{ C_scopeEnd() }
| &{ C_scopeAbort() }
)
)* { $$= d }
typeQualifierListOpt = typeQualifierList | {$$=newNullObject()}
typeQualifierList = { listBegin() }
( t:typeQualifier { listAppend(t) }
)* { $$= listEnd() }
parameterTypeListOpt = parameterTypeList | {$$=newNullObject()}
parameterTypeList = p:parameterList
( c:COMMA v:ELLIPSIS { List_addLast(p, c); List_addLast(p, v) }
)? { $$= p }
parameterList = p:parameterDeclaration { listWith(p) }
( ( c:COMMA | c:SEMI &{gnu} ) { listAppend(c) }
p:parameterDeclaration { listAppend(p) }
)* { $$= listEnd() }
parameterDeclaration = s:parameterDeclarationSpecifiers
( d:declarator | d:abstractDeclaratorOpt ) { $$= new_C_parameter(s, d) }
parameterDeclarationSpecifiers
= @{ int specified= 0 } { listBegin() }
( s:parameterStorageClassSpecifier { listAppend(s) }
| s:typeSpecifier @{ specified++ } { listAppend(s) }
| s:typedefName &{ !specified++ } { listAppend(s) }
| s:typeQualifier { listAppend(s) }
| s:functionSpecifier { listAppend(s) }
)+ { $$= listEnd() }
identifierListOpt = identifierList | {$$=newNullObject()}
identifierList = i:id { listWith(i) }
( c:COMMA i:id { listAppend2(c, i) }
)* { $$= listEnd() }
# 6.7.6
typeName = s:specifierQualifierList d:abstractDeclaratorOpt { $$= new_C_declaration(s, d, newNullObject()) }
abstractDeclaratorOpt = abstractDeclarator | {$$=newNullObject()}
abstractDeclarator = p:STAR q:typeQualifierList d:abstractDeclaratorOpt { $$= new_C_deref(p, q, d) }
| p:BXOR q:typeQualifierList d:abstractDeclaratorOpt &{apl} { $$= new_C_block(p, q, d) }
| directAbstractDeclarator
directAbstractDeclarator= @{int nonEmpty= 0}
( l:LPAREN d:abstractDeclarator r:RPAREN @{++nonEmpty} { d= new_C_subexpr(l, d, r) }
| {d=newNullObject()}
) ( l:LPAREN p:parameterTypeListOpt r:RPAREN @{++nonEmpty} { d= new_C_call (d, l, p, r) }
| l:LBRACKET
( s:STATIC q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpression
| {s=newNullObject()} q:typeQualifierList t:STATIC e:assignmentExpressionOpt
| {s=newNullObject()} q:typeQualifierListOpt t:STAR {e=newNullObject()}
| {s=newNullObject()} q:typeQualifierListOpt {t=newNullObject()} e:assignmentExpressionOpt
) r:RBRACKET @{++nonEmpty} { d= new_C_array(d, l, s, q, t, e, r) }
)* &{nonEmpty} { $$= d }
# 6.7.7
typedefName = <ID> &{ isTypedefName(yytext) } { $$= new_C_id(yytext) } -
| t:TYPEOF l:LPAREN
( x:expression r:RPAREN { $$= new_C_typeOf(t, l, newNullObject(), x, r) }
| x:typeName r:RPAREN { $$= new_C_typeOf(t, l, x, newNullObject(), r) }
) &{gnu}
# 6.7.8
initializer = l:LCURLY i:initializerList ( c:COMMA | {c=newNullObject()} ) r:RCURLY { $$= new_C_initializer(l, i, c, r) }
| assignmentExpression
initializerList = { listBegin() }
( d:designation { listAppend(d) }
)? i:initializer { listAppend(i) }
( c:COMMA { listAppend(c) }
( d:designation { listAppend(d) }
)? i:initializer { listAppend(i) }
)* { $$= listEnd() }
| &{gnu} { $$= newNullObject() }
designation = ( d:designatorList ( a:ASSIGN | {a=newNullObject()} &{gnu} )
| d:id a:COLON &{gnu}
) { $$= new_C_designation(d, a) }
designatorList = { listBegin() }
( l:LBRACKET x:constantExpression r:RBRACKET { listAppend(new_C_index(newNullObject(), l, x, r)) }
| l:LBRACKET x:constantRange r:RBRACKET &{gnu} { listAppend(new_C_index(newNullObject(), l, x, r)) }
| l:DOT x:id { listAppend(new_C_binary(newNullObject(), l, x)) }
)+ { $$= listEnd() }
### A.2.3 Statements
# 6.8
statement = expressionStatement
| labeledStatement
| compoundStatement
| selectionStatement
| iterationStatement
| jumpStatement
# 6.8.1
labeledStatement = i:id c:COLON
# an attribute specifier list may appear after the colon following a label, other than a case or default label
( a:attributeSpecifiers &{gnu} | {a=newNullObject()} )
s:statement { $$= new_C_label(i, c, a, s) }
| c:CASE x:constantExpression d:COLON s:statement { $$= new_C_case(c, x, d, s) }
| c:CASE x:constantRange d:COLON s:statement &{gnu} { $$= new_C_case(c, x, d, s) }
| d:DEFAULT c:COLON s:statement { $$= new_C_default(d, c, s) }
# 6.8.2
compoundStatement = @{ C_scopeBegin() }
l:LCURLY { listBegin() }
( x:localLabelDeclaration &{gnu} { listAppend(x) }
)*
( x:declaration { listAppend(x) }
| x:statement { listAppend(x) }
| x:functionDefinition &{gnu} { listAppend(x) }
| !'}' &{ errmsg= "statement expected" } error
)* { x= listEnd() }
r:RCURLY { $$= new_C_compound(l, x, r) }
@{ C_scopeEnd() }
| &{ C_scopeAbort() }
# 6.8.3
expressionStatement = SEMI
| x:expression s:SEMI { $$= new_C_exprStatement(x, s) }
# 6.8.4
selectionStatement = i:IF l:LPAREN x:expression r:RPAREN s:statement
( e:ELSE t:statement | {e=t=newNullObject()} ) { $$= new_C_if(i, l, x, r, s, e, t) }
| s:SWITCH l:LPAREN x:expression r:RPAREN t:statement { $$= new_C_switch(s, l, x, r, t) }
# 6.8.5
iterationStatement = w:WHILE l:LPAREN x:expression r:RPAREN s:statement { $$= new_C_while(w, l, x, r, s) }
| d:DO s:statement w:WHILE l:LPAREN x:expression r:RPAREN t:SEMI { $$= new_C_do(d, s, w, l, x, r, t) }
| f:FOR l:LPAREN a:expressionOpt t:SEMI b:expressionOpt u:SEMI
c:expressionOpt r:RPAREN s:statement { $$= new_C_for(f, l, a, t, b, u, c, r, s) }
| f:FOR l:LPAREN a:declaration b:expressionOpt u:SEMI
c:expressionOpt r:RPAREN s:statement { $$= new_C_for(f, l, a, newNullObject(), b, u, c, r, s) }
# 6.8.6
jumpStatement = g:GOTO i:id t:SEMI { $$= new_C_goto(g, newNullObject(), i, t) }
| c:CONTINUE t:SEMI { $$= new_C_continue(c, t) }
| b:BREAK t:SEMI { $$= new_C_break(b, t) }
| r:RETURN x:expressionOpt t:SEMI { $$= new_C_return(r, x, t) }
| g:GOTO s:STAR x:expression t:SEMI &{gnu} { $$= new_C_goto(g, s, x, t) }
### A.2.4 External definitions
# 6.9
## translationUnit = externalDeclaration+
externalDeclaration = <Space+> { yylval = newComment(yytext); }
| ( SEMI &{gnu}
| declaration
| functionDefinition
| &. &{ errmsg= "declaration expected" } error
) { yylval= $$; }
functionDefinition = @{ C_declarationBegin() }
( s:functionDeclarationSpecifiers | &{gnu} {s=newNullObject()} )
d:declarator
l:declarationListOpt
c:compoundStatement { $$= new_C_functionDef(s, d, l, c) }
@{ C_declarationEnd() }
| &{ C_declarationAbort() }
functionDeclarationSpecifiers
= @{ int specified= 0 } { listBegin() }
( s:functionStorageClassSpecifier { listAppend(s) }
| s:typeSpecifier @{ ++specified } { listAppend(s) }
| &{ !specified } s:typedefName @{ ++specified } { listAppend(s) }
| s:typeQualifier { listAppend(s) }
| s:functionSpecifier { listAppend(s) }
)+ { $$= listEnd() }
declarationListOpt = declarationList | {$$=newNullObject()}
declarationList = d:declaration { listWith(d); }
( d:declaration { listAppend(d) }
)* { $$= listEnd() }
### GNU C extensions
# An attribute specifier is of the form __attribute__ ((attribute-list)). An attribute list is a
# possibly empty comma-separated sequence of attributes
attributeSpecifier = a:ATTRIBUTE ll:LPAREN lr:LPAREN { listBegin() }
( b:attribute { listAppend(b) }
)? ( c:COMMA { listAppend(c) }
( b:attribute { listAppend(b) }
)? )* rl:RPAREN rr:RPAREN { $$= new_C_attributeSpec(a, ll, lr, listEnd(), rl, rr) }
attributeSpecifiers = &ATTRIBUTE { listBegin() }
a:attributeSpecifier { listAppend(a) }
( a:attributeSpecifier { listAppend(a) }
)* { $$= listEnd() }
# where each attribute is one of the following:
# Empty. Empty attributes are ignored.
# An attribute name (which may be an identifier such as unused, or a reserved word such as const).
# An attribute name followed by a parenthesized list of parameters for the attribute. These parameters take one of the following forms:
# An identifier. For example, mode attributes use this form.
# An identifier followed by a comma and a non-empty comma-separated list of expressions. For example, format attributes use this form.
# A possibly empty comma-separated list of expressions. For example, format_arg attributes use this
# form with the list being a single integer constant expression, and alias attributes use
# this form with the list being a single string constant.
attribute = n:name ( l:LPAREN { listBegin() }
( p:expression { listAppend(p) }
( p:COMMA { listAppend(p) }
p:expression { listAppend(p) }
)*
)?
r:RPAREN { p= listEnd() }
| {l=p=r=newNullObject()}
) { $$= new_C_attribute(n, l, p, r) }
constantRange = a:constantExpression e:ELLIPSIS b:constantExpression { $$= new_C_range(a, e, b) }
localLabelDeclaration = l:LABEL &{gnu} { listBegin() }
i:id { listAppend(i) }
( c:COMMA i:id { listAppend2(c, i) }
)*
( c:COMMA { listAppend(c) }
)?
s:SEMI { $$= new_C_labelDeclaration(l, listEnd(), s) }
asm = a:ASM l:LPAREN s:stringLiteral r:RPAREN { $$= new_C_asm(a, l, s, r) }
asmExpr = a:ASM ( v:VOLATILE | {v=newNullObject()} ) ( g:GOTO | {g=newNullObject()} )
l:LPAREN s:stringLiteral { listBegin() }
( c:COLON { listAppend(c) }
( p:asmExprArgs { listAppend(p) }
)?
( c:COLON { listAppend(c) }
( p:asmExprArgs { listAppend(p) }
)?
( c:COLON { listAppend(c) }
( p:stringLiteralList { listAppend(p) }
)?
( c:COLON { listAppend(c) }
( p:ids { listAppend(p) }
)?
)?
)?
)?
)?
r:RPAREN { $$= new_C_asmExpr(a, v, g, l, s, listEnd(), r) }
asmExprArgs = a:asmExprArg { listWith(a) }
( c:COMMA a:asmExprArg { listAppend2(c, a) }
)* { $$= listEnd() }
asmExprArg = s:stringLiteral ( l:LPAREN e:expression r:RPAREN | {l=e=r=newNullObject()} ){ $$= new_C_asmExprArg(s, l, e, r) }
stringLiteralList = s:stringLiteral { listWith(s) }
( c:COMMA s:stringLiteral { listAppend2(c, s) }
)* { $$= listEnd() }
ids = i:id { listWith(i) }
( c:COMMA i:id { listAppend2(c, i) }
)* { $$= listEnd() }
- = < Space* > { if (yyleng && $$) setComment($$, newComment(yytext)) }
Space = Blank | Comment | EOL | Directive
| "__extension__" &{gnu} { icol += 13 }
Blank = ( [\003-\010] | '\013' | '\f' | [\016-\037] | [\177-\377] | ' ' ) { ++icol }
| '\t' { icol= (icol + 8) & ~7 }
EOL = ( "\r\n" | '\n' | '\r' ) { ++irow; icol= 0 }
Comment = "/*" ( !"*/" (EOL | Any) )* "*/"
| "//" ( ![\n\r] Any )* EOL
Directive = "#" (!EOL .)*
Any = . { ++icol }
###
ASSIGN = '=' !'=' { $$= newToken("=" ) } -
COLON = ':' { $$= newToken(":" ) } -
COMMA = ',' { $$= newToken("," ) } -
QUESTION = '?' { $$= newToken("?" ) } -
SEMI = ';' { $$= newToken(";" ) } -
PTR = "->" { $$= newToken("->" ) } -
DOT = '.' !'.' { $$= newToken("." ) } -
ELLIPSIS = '...' { $$= newToken("..." ) } -
LPAREN = '(' { $$= newToken("(" ) } -
RPAREN = ')' { $$= newToken(")" ) } -
LBRACKET = '[' { $$= newToken("[" ) } -
RBRACKET = ']' { $$= newToken("]" ) } -
LCURLY = '{' { $$= newBegin( ) } -
RCURLY = '}' { $$= newEnd ( ) } -
EQUAL = "==" { $$= newToken("==" ) } -
NOT_EQUAL = "!=" { $$= newToken("!=" ) } -
LTE = "<=" { $$= newToken("<=" ) } -
LT = "<" !'=' { $$= newToken("<" ) } -
GTE = ">=" { $$= newToken(">=" ) } -
GT = ">" !'=' { $$= newToken(">" ) } -
DIV = '/' ![=*] { $$= newToken("/" ) } -
DIV_ASSIGN = "/=" { $$= newToken("/=" ) } -
PLUS = '+' ![+=] { $$= newToken("+" ) } -
PLUS_ASSIGN = "+=" { $$= newToken("+=" ) } -
INC = "++" { $$= newToken("++" ) } -
MINUS = '-' ![-=] { $$= newToken("-" ) } -
MINUS_ASSIGN = "-=" { $$= newToken("-=" ) } -
DEC = "--" { $$= newToken("--" ) } -
STAR = '*' !'=' { $$= newToken("*" ) } -
STAR_ASSIGN = "*=" { $$= newToken("*=" ) } -
MOD = '%' !'=' { $$= newToken("%" ) } -
MOD_ASSIGN = "%=" { $$= newToken("%=" ) } -
RSHIFT = ">>" !'=' { $$= newToken(">>" ) } -
RSHIFT_ASSIGN = ">>=" { $$= newToken(">>=" ) } -
LSHIFT = "<<" !'=' { $$= newToken("<<" ) } -
LSHIFT_ASSIGN = "<<=" { $$= newToken("<<=" ) } -
LAND = "&&" { $$= newToken("&&" ) } -
LNOT = '!' !'=' { $$= newToken("!" ) } -
LOR = "||" { $$= newToken("||" ) } -
BAND = '&' ![&=] { $$= newToken("&" ) } -
BAND_ASSIGN = "&=" { $$= newToken("&=" ) } -
BNOT = '~' { $$= newToken("~" ) } -
BOR = '|' ![|=] { $$= newToken("|" ) } -
BOR_ASSIGN = "|=" { $$= newToken("|=" ) } -
BXOR = '^' !'=' { $$= newToken("^" ) } -
BXOR_ASSIGN = "^=" { $$= newToken("^=" ) } -
ALIGNOF = '__alignof__' !IDREST { $$= newToken("__alignof__" ) } -
| '__alignof' !IDREST { $$= newToken("__alignof" ) } -
ASM = 'asm' !IDREST { $$= newToken("asm" ) } -
| '__asm' !IDREST { $$= newToken("__asm" ) } -
| '__asm__' !IDREST { $$= newToken("__asm__" ) } -
ATTRIBUTE = '__attribute__' !IDREST { $$= newToken("__attribute__") } -
AUTO = 'auto' !IDREST { $$= newToken("auto" ) } -
BOOL = '_Bool' !IDREST { $$= newToken("_Bool" ) } -
BREAK = 'break' !IDREST { $$= newToken("break" ) } -
CASE = 'case' !IDREST { $$= newToken("case" ) } -
CHAR = 'char' !IDREST { $$= newToken("char" ) } -
COMPLEX = '_Complex' !IDREST { $$= newToken("_Complex" ) } -
| '__complex__' !IDREST &{gnu} { $$= newToken("__complex__" ) } -
CONST = 'const' !IDREST { $$= newToken("const" ) } -
| '__const' !IDREST { $$= newToken("__const" ) } -
CONTINUE = 'continue' !IDREST { $$= newToken("continue" ) } -
DEFAULT = 'default' !IDREST { $$= newToken("default" ) } -
DO = 'do' !IDREST { $$= newToken("do" ) } -
DOUBLE = 'double' !IDREST { $$= newToken("double" ) } -
ELSE = 'else' !IDREST { $$= newToken("else" ) } -
ENUM = 'enum' !IDREST { $$= newToken("enum" ) } -
EXTERN = 'extern' !IDREST { $$= newToken("extern" ) } -
FLOAT = 'float' !IDREST { $$= newToken("float" ) } -
FOR = 'for' !IDREST { $$= newToken("for" ) } -
GOTO = 'goto' !IDREST { $$= newToken("goto" ) } -
IF = 'if' !IDREST { $$= newToken("if" ) } -
INLINE = 'inline' !IDREST { $$= newToken("inline" ) } -
| '__inline__' !IDREST &{gnu} { $$= newToken("__inline__" ) } -
INT = 'int' !IDREST { $$= newToken("int" ) } -
LONG = 'long' !IDREST { $$= newToken("long" ) } -
REGISTER = 'register' !IDREST { $$= newToken("register" ) } -
RESTRICT = 'restrict' !IDREST { $$= newToken("restrict" ) } -
RETURN = 'return' !IDREST { $$= newToken("return" ) } -
SHORT = 'short' !IDREST { $$= newToken("short" ) } -
SIGNED = 'signed' !IDREST { $$= newToken("signed" ) } -
SIZEOF = 'sizeof' !IDREST { $$= newToken("sizeof" ) } -
STATIC = 'static' !IDREST { $$= newToken("static" ) } -
STRUCT = 'struct' !IDREST { $$= newToken("struct" ) } -
SWITCH = 'switch' !IDREST { $$= newToken("switch" ) } -
TYPEDEF = 'typedef' !IDREST { $$= newToken("typedef" ) } -
TYPEOF = 'typeof' !IDREST { $$= newToken("typeof" ) } -
| '__typeof__' !IDREST { $$= newToken("__typeof__" ) } -
UNION = 'union' !IDREST { $$= newToken("union" ) } -
UNSIGNED = 'unsigned' !IDREST { $$= newToken("unsigned" ) } -
VOID = 'void' !IDREST { $$= newToken("void" ) } -
VOLATILE = 'volatile' !IDREST { $$= newToken("volatile" ) } -
WHILE = 'while' !IDREST { $$= newToken("while" ) } -
IMAG = '__imag__' !IDREST &{gnu} { $$= newToken("__imag__" ) } -
LABEL = '__label__' !IDREST &{gnu} { $$= newToken("__label__") } -
REAL = '__real__' !IDREST &{gnu} { $$= newToken("__real__" ) } -
BUILTIN_VA_LIST = '__builtin_va_list' !IDREST &{gnu} { $$= newToken("__builtin_va_list" ) } -
__RESTRICT = '__restrict' !IDREST &{gnu} { $$= newToken("__restrict" ) } -
__INLINE = '__inline' !IDREST &{gnu} { $$= newToken("__inline" ) } -
_FLOAT128 = '_Float128' !IDREST &{gnu} { $$= newToken("_Float128" ) } -
#--------------------------------------------- Meta grammar ----------------------------------------------#
# the semicolon has to be explicit with no space eaten afterwards to prevent the
# input buffer from moving past it before redirecting input from the imported file
meta = META_IMPORT s:META_STRING ";" { $$ = null; inputStackPush(get(s, String, value)) }
| s:meta_stmt { $$ = s }
| !. { $$ = 0 } # signal end of current input file
meta_stmt = s:meta_block { $$ = s }
| META_SEMICOLON { $$ = null }
| l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, null) }
| META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt META_ELSE f:meta_stmt { $$ = newIf(c, t, f ) }
| META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt { $$ = newIf(c, t, null) }
| META_WHILE META_LPAREN c:meta_exp META_RPAREN s:meta_stmt { $$ = newWhile(c, s) }
| META_DO s:meta_stmt META_WHILE META_LPAREN c:meta_exp META_RPAREN { $$ = newDo(s, c) }
| META_FOR META_LPAREN i:meta_ident META_IN e:meta_exp META_RPAREN s:meta_stmt { $$ = newForIn(i, e, s) }
| META_FOR META_LPAREN i:meta_stmt c:meta_stmt u:meta_exp META_RPAREN s:meta_stmt { $$ = newFor(i, c, u, s) }
| s:meta_switch { $$ = s }
| META_RETURN e:meta_exp { $$ = newReturn(e) }
| META_RETURN { $$ = newReturn(null) }
| META_BREAK { $$ = newBreak() }
| META_CONTINUE { $$ = newContinue() }
| META_THROW e:meta_exp { $$ = newUnary(Throw_proto, e) }
| t:meta_try { $$ = t }
| e:meta_exp META_SEMICOLON { $$ = e }
meta_block = META_LCB m:meta_makeMap
( s:meta_stmt { map_append(m, s) }
) *
( s:meta_exp { map_append(m, s) }
) ?
META_RCB { $$ = newBlock(m) }
meta_exp = META_VAR l:meta_ident META_ASSIGN e:meta_exp { $$ = newDeclaration(l, e) }
# | META_SYNTAX l:META_IDENT p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(l, p, e, makeInteger(2))) }
# | META_SYNTAX p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(null, p, e, makeInteger(2))) }
# | META_SYNTAX l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, makeInteger(1)) }
# | META_SYNTAX p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, makeInteger(1)) }
| l:META_IDENT o:meta_assignOp e:meta_exp { $$ = newAssign(Assign_proto, l, o, e) }
| l:meta_postfix META_DOT i:META_IDENT o:meta_assignOp e:meta_exp { $$ = newSetMap(SetMember_proto, l, i, o, e) }
| l:meta_postfix META_LBRAC i:meta_exp META_RBRAC o:meta_assignOp e:meta_exp { $$ = newSetMap(SetIndex_proto, l, i, o, e) }
| l:meta_syntax2 a:meta_argumentList s:meta_block { $$ = (map_append(a, s), apply(globals, globals, l, a, a)) }
| c:meta_cond { $$ = c }
meta_ident = l:META_IDENT { $$ = l }
# | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) }
meta_syntax2 = < [a-zA-Z_][a-zA-Z0-9_]* >
&{ null != getSyntaxId(2, intern(yytext)) } - { $$ = getSyntaxId(2, intern(yytext)) }
meta_try = META_TRY t:meta_stmt i:meta_null c:meta_null f:meta_null
( META_CATCH META_LPAREN i:META_IDENT META_RPAREN c:meta_stmt ) ?
( META_FINALLY f:meta_stmt ) ? { $$ = newTry(t, i, c, f) }
meta_null = { $$ = null }
meta_assignOp = META_ASSIGN { $$= null }
| META_ASSIGNADD { $$= Add_symbol }
| META_ASSIGNSUB { $$= Sub_symbol }
| META_ASSIGNMUL { $$= Mul_symbol }
| META_ASSIGNDIV { $$= Div_symbol }
| META_ASSIGNMOD { $$= Mod_symbol }
| META_ASSIGNBITOR { $$= Bitor_symbol }
| META_ASSIGNBITXOR { $$= Bitxor_symbol }
| META_ASSIGNBITAND { $$= Bitand_symbol }
| META_ASSIGNSHLEFT { $$= Shleft_symbol }
| META_ASSIGNSHRIGHT { $$= Shright_symbol }
meta_switch = META_SWITCH META_LPAREN e:meta_exp META_RPAREN
META_LCB statements:meta_makeMap labels:meta_makeMap
( META_CASE l:meta_exp META_COLON { map_set(labels, eval(globals, l), makeInteger(map_size(statements))) }
| META_DEFAULT META_COLON { map_set(labels, __default___symbol, makeInteger(map_size(statements))) }
| s:meta_stmt { map_append(statements, s) }
)*
META_RCB { $$= newSwitch(e, labels, statements) }
meta_cond = c:meta_logor META_QUERY t:meta_exp META_COLON f:meta_cond { $$ = newIf(c, t, f) }
| meta_logor
meta_logor = l:meta_logand
( META_LOGOR r:meta_logand { l = newBinary(Logor_proto, l, r) }
)* { $$ = l }
meta_logand = l:meta_bitor
( META_LOGAND r:meta_bitor { l = newBinary(Logand_proto, l, r) }
)* { $$ = l }
meta_bitor = l:meta_bitxor
( META_BITOR r:meta_bitxor { l = newBinary(Bitor_proto, l, r) }
)* { $$ = l }
meta_bitxor = l:meta_bitand
( META_BITXOR r:meta_bitand { l = newBinary(Bitxor_proto, l, r) }
)* { $$ = l }
meta_bitand = l:meta_eq
( META_BITAND r:meta_eq { l = newBinary(Bitand_proto, l, r) }
)* { $$ = l }
meta_eq = l:meta_ineq
( META_EQUAL r:meta_ineq { l = newBinary(Equal_proto, l, r) }
| META_NOTEQ r:meta_ineq { l = newBinary(Noteq_proto, l, r) }
)* { $$ = l }
meta_ineq = l:meta_shift
( META_LESS r:meta_shift { l = newBinary(Less_proto, l, r) }
| META_LESSEQ r:meta_shift { l = newBinary(Lesseq_proto, l, r) }
| META_GREATEREQ r:meta_shift { l = newBinary(Greatereq_proto, l, r) }
| META_GREATER r:meta_shift { l = newBinary(Greater_proto, l, r) }
)* { $$ = l }
meta_shift = l:meta_sum
( META_SHLEFT r:meta_sum { l = newBinary(Shleft_proto, l, r) }
| META_SHRIGHT r:meta_sum { l = newBinary(Shright_proto, l, r) }
)* { $$ = l }
meta_sum = l:meta_prod
( META_PLUS r:meta_prod { l = newBinary(Add_proto, l, r) }
| META_MINUS r:meta_prod { l = newBinary(Sub_proto, l, r) }
)* { $$ = l }
meta_prod = l:meta_prefix
( META_MULTI r:meta_prefix { l = newBinary(Mul_proto, l, r) }
| META_DIVIDE r:meta_prefix { l = newBinary(Div_proto, l, r) }
| META_MODULO r:meta_prefix { l = newBinary(Mod_proto, l, r) }
)* { $$ = l }
meta_prefix = META_PLUS n:meta_prefix { $$= n }
| META_NEGATE n:meta_prefix { $$= newUnary(Neg_proto, n) }
| META_TILDE n:meta_prefix { $$= newUnary(Com_proto, n) }
| META_PLING n:meta_prefix { $$= newUnary(Not_proto, n) }
| META_PLUSPLUS n:meta_prefix { $$= newPreIncrement(n) }
| META_MINUSMINUS n:meta_prefix { $$= newPreDecrement(n) }
# | META_BACKTICK n:meta_prefix { $$ = newUnary(Quasiquote_proto, n) }
# | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) }
| n:meta_postfix { $$= n }
meta_postfix = i:meta_value ( META_DOT s:META_IDENT a:meta_argumentList { i = newInvoke(i, s, a) }
| META_DOT s:META_IDENT !meta_assignOp { i = newGetMap(GetMember_proto, i, s) }
| META_LBRAC p:meta_exp META_RBRAC !meta_assignOp { i = newGetMap(GetIndex_proto, i, p) }
| a:meta_argumentList { i = (null != getSyntax(1, i)) ? apply(globals, globals, getSyntax(1, i), a, i) : newCall(i, a) }
| META_PLUSPLUS { i = newPostIncrement(i) }
| META_MINUSMINUS { i = newPostDecrement(i) }
) * { $$ = i }
meta_paramList = META_LPAREN m:meta_makeMap
( i:META_IDENT { map_append(m, i) }
( META_COMMA i:META_IDENT { map_append(m, i) }
) *
) ?
META_RPAREN { $$ = m }
meta_argumentList = META_LPAREN m:meta_makeMap
( e:meta_exp { map_append(m, e) }
( META_COMMA e:meta_exp { map_append(m, e) }
) *
) ?
META_RPAREN { $$ = m }
meta_value = n:META_FLOAT { $$ = newFloat(n) }
| n:meta_integer { $$ = newInteger(n) }
| s:meta_string { $$ = newString(s) }
| s:meta_symbol { $$ = s }
| m:meta_map { $$ = newMap(m) }
| META_NULL { $$ = null }
| i:META_IDENT { $$ = newGetVariable(i) }
| p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, null) }
| META_LPAREN ( i:meta_block | i:meta_exp ) META_RPAREN { $$ = i }
meta_string = s:META_STRING - { $$ = s }
META_STRING = META_DQUOTE < (!META_DQUOTE meta_char)* > META_DQUOTE { $$ = makeString(unescape(yytext)) }
meta_char = '\\' . | .
meta_symbol = META_HASH ( i:META_IDENT { $$ = newSymbol(i) }
| i:meta_string { $$ = newSymbol(intern(get(i, String, value))) }
)
meta_map = META_LCB m:meta_makeMap
( k:meta_key META_COLON v:meta_exp { map_set(m, k, v) }
( META_COMMA k:meta_key META_COLON v:meta_exp { map_set(m, k, v) }
) *
) ?
META_RCB { $$ = m }
| META_LBRAC m:meta_makeMap
( v:meta_exp { map_append(m, v) }
( META_COMMA v:meta_exp { map_append(m, v) }
) *
) ?
META_RBRAC { $$ = m }
meta_makeMap = { $$ = makeMap() }
meta_key = META_IDENT | meta_integer
meta_keyword = META_SWITCH | META_CASE | META_DEFAULT | META_DO | META_FOR | META_IN | META_WHILE | META_IF | META_ELSE | META_NULL | META_RETURN | META_BREAK | META_CONTINUE
| META_THROW | META_TRY | META_CATCH | META_FINALLY
# | META_SYNTAX
META_IDENT = !meta_keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) }
meta_integer = i:META_INTEGER { $$ = i }
| '-' i:meta_integer { $$ = makeInteger(-getInteger(i)) }
META_INTEGER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) }
| '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) }
| '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) }
| < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) }
| META_SQUOTE < (!META_SQUOTE meta_char) > META_SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) }
META_FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) }
| < [-+]* [0-9]* '.' [0-9]+ ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) }
| < [-+]* [0-9]+ ('e'[-+]*[0-9]+) > - { $$ = makeFloat(strtold(yytext, 0)) }
#META_FUN = 'fun' ![a-zA-Z0-9_] -
#META_SYNTAX = 'syntax' ![a-zA-Z0-9_] -
META_VAR = 'var' ![a-zA-Z0-9_] -
META_SWITCH = 'switch' ![a-zA-Z0-9_] -
META_CASE = 'case' ![a-zA-Z0-9_] -
META_DEFAULT = 'default' ![a-zA-Z0-9_] -
META_DO = 'do' ![a-zA-Z0-9_] -
META_FOR = 'for' ![a-zA-Z0-9_] -
META_IN = 'in' ![a-zA-Z0-9_] -
META_WHILE = 'while' ![a-zA-Z0-9_] -
META_IF = 'if' ![a-zA-Z0-9_] -
META_ELSE = 'else' ![a-zA-Z0-9_] -
META_NULL = 'null' ![a-zA-Z0-9_] -
META_RETURN = 'return' ![a-zA-Z0-9_] -
META_BREAK = 'break' ![a-zA-Z0-9_] -
META_CONTINUE = 'continue' ![a-zA-Z0-9_] -
META_THROW = 'throw' ![a-zA-Z0-9_] -
META_TRY = 'try' ![a-zA-Z0-9_] -
META_CATCH = 'catch' ![a-zA-Z0-9_] -
META_FINALLY = 'finally' ![a-zA-Z0-9_] -
META_IMPORT = 'import' ![a-zA-Z0-9_] -
META_HASH = '#' -
META_LOGOR = '||' -
META_LOGAND = '&&' -
META_BITOR = '|' ![|=] -
META_BITXOR = '^' ![=] -
META_BITAND = '&' ![&=] -
META_EQUAL = '==' -
META_NOTEQ = '!=' -
META_LESS = '<' ![<=] -
META_LESSEQ = '<=' -
META_GREATEREQ = '>=' -
META_GREATER = '>' ![>=] -
META_SHLEFT = '<<' ![=] -
META_SHRIGHT = '>>' ![=] -
META_PLUS = '+' ![+=] -
META_MINUS = '-' ![-=] -
META_NEGATE = '-' ![-=0-9.] -
META_PLUSPLUS = '++' -
META_MINUSMINUS = '--' -
META_TILDE = '~' -
META_PLING = '!' ![=] -
META_MULTI = '*' ![=] -
META_DIVIDE = '/' ![/=] -
META_MODULO = '%' ![=] -
META_ASSIGN = '=' ![=] -
META_ASSIGNADD = '+=' -
META_ASSIGNSUB = '-=' -
META_ASSIGNMUL = '*=' -
META_ASSIGNDIV = '/=' -
META_ASSIGNMOD = '%=' -
META_ASSIGNBITOR = '|=' -
META_ASSIGNBITXOR = '^=' -
META_ASSIGNBITAND = '&=' -
META_ASSIGNSHLEFT = '<<=' -
META_ASSIGNSHRIGHT = '>>=' -
META_QUERY = '?' -
META_COLON = ':' -
META_SEMICOLON = ';' -
META_COMMA = ',' -
META_DOT = '.' -
#META_BACKTICK = '`' -
META_AT = '@' -
META_LCB = '{' -
META_RCB = '}' -
META_LBRAC = '[' -
META_RBRAC = ']' -
META_LPAREN = '(' -
META_RPAREN = ')' -
META_DQUOTE = '"'
META_SQUOTE = "'"
%%
;
oop map_zip(oop map, oop keys, oop values)
{
assert(is(Map, map));
assert(is(Map, keys));
assert(is(Map, values));
size_t sk= map_size(keys), sv= map_size(values);
if (sk < sv) sk= sv;
for (size_t i= 0; i < sk; ++i) {
oop key = i < sk && map_hasIntegerKey(keys, i) ? get(keys, Map, elements)[i].value : makeInteger(i);
oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null;
map_set(map, key, value);
}
return map;
}
oop clone(oop obj)
{
switch(getType(obj)) {
case Undefined:
case Integer:
case Float:
case Function:
case Symbol:
return obj;
case String:
return makeString(get(obj, String, value));
case Map: {
struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity));
memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity));
oop map= malloc(sizeof(*obj));
memcpy(map, obj, sizeof(*obj));
set(map, Map, elements, elements);
return map;
}
}
return obj;
}
struct Call
{
oop ast, function;
};
DECLARE_BUFFER(struct Call, CallArray);
CallArray backtrace= BUFFER_INITIALISER;
struct Call CallArray_pop(CallArray *oa)
{ assert(oa->position > 0);
return oa->contents[--oa->position];
}
void trace(oop ast, oop func)
{
CallArray_append(&backtrace, (struct Call){ ast, func });
}
void untrace(oop ast)
{
struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast);
}
void printLocation(oop ast)
{
fflush(stdout);
if (!is(Map, ast)) return;
char *fileName = get (map_get(ast, __file___symbol), String, value);
int lineNumber = getInteger(map_get(ast, __line___symbol) );
fprintf(stderr, "%s:%i", fileName, lineNumber);
}
void printlnLocation(oop ast)
{
fflush(stdout);
if (!is(Map, ast)) return;
printLocation(ast);
fprintf(stderr, "\n");
}
void printBacktrace(oop top)
{
fflush(stdout);
printLocation(top);
while (CallArray_position(&backtrace) > 0) {
struct Call call= CallArray_pop(&backtrace);
if (is(Map, call.ast) && Call_proto == map_get(call.ast, __proto___symbol)) {
oop name= get(call.function, Function, name);
if (null != name) {
printf(" in ");
if (get(call.function, Function, primitive)) printf("primitive ");
else printf("function ");
println(get(call.function, Function, name));
}
}
else {
printf("\n");
}
printLocation(call.ast);
}
printf("\n");
}
void runtimeError(char *fmt, ...)
{
fflush(stdout);
va_list ap;
va_start(ap, fmt);
fprintf(stderr, "\n");
vfprintf(stderr, fmt, ap);
fprintf(stderr, "\n");
va_end(ap);
printBacktrace(mrAST);
exit(1);
}
#define TYPESIG(L, R) L*NTYPES+R
#define CASE(L, R) case TYPESIG(L, R)
oop addOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value));
CASE(String , String ): return string_concat(lhs, rhs);
}
runtimeError("addition between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop subOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value));
}
runtimeError("substraction between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop mulOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value));
CASE(String , Integer): return string_mul(lhs, rhs);
CASE(Integer, String ): return string_mul(rhs, lhs);
}
runtimeError("multiplication between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop divOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs));
CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value));
CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs));
CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value));
}
runtimeError("division between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
oop modOperation(oop lhs, oop rhs)
{
switch (TYPESIG(getType(lhs), getType(rhs))) {
CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs));
CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value)));
}
runtimeError("modulo between two incompatible types");
return NULL; // to prevent: control may reach end of non-void function
}
#undef TYPESIG
#undef CASE
#if 0
oop expandUnquotes(oop scope, oop obj)
{
obj = clone(obj);
if (!is(Map, obj)) {
return obj;
}
if (map_get(obj, __proto___symbol) == Unquote_proto) {
return eval(scope, map_get(obj, rhs_symbol));
}
for (size_t i= 0; i < map_size(obj); ++i) {
struct Pair *pair= &get(obj, Map, elements)[i];
if (__proto___symbol != pair->key) {
pair->value= expandUnquotes(scope, pair->value);
}
}
return obj;
}
#endif
oop applyOperator(oop op, oop lhs, oop rhs)
{
if (null != op) { assert(is(Symbol, op));
switch (get(op, Symbol, prototype)) {
case t_Add: return addOperation(lhs, rhs);
case t_Sub: return subOperation(lhs, rhs);
case t_Mul: return mulOperation(lhs, rhs);
case t_Div: return divOperation(lhs, rhs);
case t_Mod: return modOperation(lhs, rhs);
case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs));
case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs));
case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs));
case t_Shleft: return makeInteger(getInteger(lhs) << getInteger(rhs));
case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs));
default: {
fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype));
exit(1);
}
}
}
return rhs;
}
oop freeScopes= 0; // pool of free scopes
oop fixScope(oop scope) // prevent this scope and its parents from being recycled
{ assert(is(Map, scope));
oop tmp= scope;
while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) {
tmp->Map.flags |= MAP_ENCLOSED;
tmp= map_get(tmp, __proto___symbol);
}
return scope;
}
oop newScope(oop parent)
{
if (0 == freeScopes) freeScopes= makeMap();
oop scope= freeScopes; assert(is(Map, scope));
freeScopes= freeScopes->Map.pool;
scope->Map.size= 0;
map_set(scope, __proto___symbol, parent);
return scope;
}
void delScope(oop scope)
{ assert(is(Map, scope));
if (scope->Map.flags & MAP_ENCLOSED) {
printf("IGNORE %p\n", scope);
return;
}
scope->Map.pool= freeScopes;
freeScopes= scope;
}
oop evalArgs(oop scope, oop args);
oop apply(oop scope, oop this, oop func, oop args, oop ast)
{
assert(is(Function, func));
if (NULL != get(func, Function, primitive)) {
return get(func, Function, primitive)(scope, args);
}
oop param = get(func, Function, param);
oop localScope = newScope(get(func, Function, parentScope));
map_zip(localScope, param, args);
map_set(localScope, this_symbol, this);
map_set(localScope, __arguments___symbol, args);
jbRecPush();
trace(ast, func);
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return: {
untrace(ast);
delScope(localScope);
oop result = jbs->result;
jbRecPop();
return result;
}
case j_break: {
delScope(localScope);
runtimeError("break outside of a loop or switch");
}
case j_continue: {
delScope(localScope);
runtimeError("continue outside of a loop");
}
case j_throw: {
untrace(ast);
delScope(localScope);
oop res= jbs->result;
jbRecPop();
jbs->result= res;
siglongjmp(jbs->jb, j_throw);
}
}
oop result= eval(localScope, get(func, Function, body));
untrace(ast);
delScope(localScope);
jbRecPop();
return result;
}
oop eval(oop scope, oop ast)
{
if (opt_v > 3) {
printf("EVAL: ");
println(ast);
}
switch(getType(ast)) {
case Undefined:
case Integer:
case Float:
case String:
case Function:
return ast;
case Symbol:
return getVariable(scope, ast);
case Map:
break;
}
assert(is(Map, ast));
mrAST= ast;
oop proto = map_get(ast, __proto___symbol);
if (proto == null) {
return ast;
}
// proto_number is the enum version of the proto symbol
proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype);
switch (proto_number) {
case t_UNDEFINED: {
assert(0);
return 0;
}
case t_Map: {
oop map= clone(map_get(ast, value_symbol));
for (size_t i= 0; i < map_size(map); ++i) {
struct Pair *pair= &get(map, Map, elements)[i];
pair->value= eval(scope, pair->value);
}
return map;
}
#if 0
case t_Quasiquote: {
oop obj = map_get(ast, rhs_symbol);
return expandUnquotes(scope, obj);
}
case t_Unquote: {
runtimeError("@ outside of `");
}
#endif
case t_Declaration: {
oop lhs = map_get(ast, lhs_symbol);
oop rhs = eval(scope, map_get(ast, rhs_symbol));
return newVariable(scope, lhs, rhs);
}
case t_If: {
oop condition = map_get(ast, condition_symbol );
oop consequent = map_get(ast, consequent_symbol);
oop alternate = map_get(ast, alternate_symbol );
return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate);
}
case t_While: {
oop condition = map_get(ast, condition_symbol );
oop body = map_get(ast, body_symbol);
oop result = null;
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
jbRecPop();
return null;
}
case j_continue: {
break;
}
}
while (isTrue(eval(scope, condition))) result= eval(scope, body);
jbRecPop();
return result;
}
case t_Do: {
oop body = map_get(ast, body_symbol);
oop condition = map_get(ast, condition_symbol );
oop result = null;
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
jbRecPop();
return null;
}
case j_continue: {
goto restart_do;
}
}
do {
result= eval(scope, body);
restart_do:;
} while (isTrue(eval(scope, condition)));
jbRecPop();
return result;
}
case t_For: {
oop initialise = map_get(ast, initialise_symbol );
oop condition = map_get(ast, condition_symbol );
oop update = map_get(ast, update_symbol );
oop body = map_get(ast, body_symbol);
oop result = null;
oop localScope = newScope(scope);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
delScope(localScope);
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
delScope(localScope);
jbRecPop();
return result;
}
case j_continue: {
goto restart_for;
}
}
for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) {
result= eval(localScope, body);
restart_for:;
}
delScope(localScope);
jbRecPop();
return result;
}
case t_ForIn: {
oop expr = eval(scope, map_get(ast, expression_symbol)); if (!is(Map, expr)) return null;
oop name = map_get(ast, name_symbol ) ;
oop body = map_get(ast, body_symbol ) ;
oop result = null;
oop localScope = newScope(scope);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
delScope(localScope);
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
delScope(localScope);
jbRecPop();
return result;
}
case j_continue: {
goto restart_forin;
}
}
for (size_t i= 0; i < map_size(expr); ++i) {
map_set(localScope, name, get(expr, Map, elements)[i].key);
result= eval(localScope, body);
restart_forin:;
}
delScope(localScope);
jbRecPop();
return result;
}
case t_Switch: {
oop expression = map_get(ast, expression_symbol );
oop labels = map_get(ast, labels_symbol );
oop statements = map_get(ast, statements_symbol );
oop result = eval(scope, expression);
oop label = map_get(labels, result);
if (null == label) label= map_get(labels, __default___symbol);
if (null == label) return result;
assert(isInteger(label));
int limit= map_size(statements);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
switch (jbt) {
case j_return:
case j_throw: {
oop result = jbs->result;
jbRecPop();
assert(jbs);
jbs->result = result;
siglongjmp(jbs->jb, jbt);
assert(0);
}
case j_break: {
jbRecPop();
return null;
}
case j_continue: {
jbRecPop();
assert(jbs);
siglongjmp(jbs->jb, j_continue);
assert(0);
}
}
for (int i= getInteger(label); i < limit; ++i) {
assert(map_hasIntegerKey(statements, i));
result= eval(scope, get(statements, Map, elements)[i].value);
}
jbRecPop();
return result;
}
case t_Assign: {
oop lhs = map_get(ast, lhs_symbol);
oop op = map_get(ast, operator_symbol);
oop rhs = eval(scope, map_get(ast, rhs_symbol));
if (null != op) rhs= applyOperator(op, getVariable(scope, lhs), rhs);
setVariable(scope, lhs, rhs);
if (is(Function, rhs) && null == get(rhs, Function, name)) {
set(rhs, Function, name, lhs);
}
return rhs;
}
case t_Func: {
oop name = map_get(ast, name_symbol);
oop param = map_get(ast, param_symbol);
oop body = map_get(ast, body_symbol);
oop fixed = map_get(ast, fixed_symbol);
oop func = makeFunction(NULL, name, param, body, fixScope(scope), fixed);
if (opt_v > 4) {
printf("funcscope: ");
println(scope);
printf("globalScope: ");
println(scope);
}
if (name != null) newVariable(scope, name, func);
return func;
}
case t_Call: {
oop func = eval(scope, map_get(ast, func_symbol));
if (!is(Function, func)) {
printf("\ncannot call %s\n", printString(func));
printBacktrace(ast);
exit(1);
}
oop args = map_get(ast, args_symbol);
if (isFalse(get(func, Function, fixed))) {
args = evalArgs(scope, args);
}
return apply(scope, globals, func, args, ast);
}
case t_Invoke: {
oop this = eval(scope, map_get(ast, this_symbol));
oop func = map_get(ast, name_symbol); assert(is(Symbol, func));
func = getVariable(this, func);
if (!is(Function, func)) {
printf("\ncannot invoke %s\n", printString(func));
printBacktrace(ast);
exit(1);
}
oop args = map_get(ast, args_symbol);
if (isFalse(get(func, Function, fixed))) {
args = evalArgs(scope, args);
}
return apply(scope, this, func, args, ast);
}
case t_Return: {
assert(jbs);
jbs->result = eval(scope, map_get(ast, value_symbol));
siglongjmp(jbs->jb, j_return);
}
case t_Break: {
assert(jbs);
siglongjmp(jbs->jb, j_break);
}
case t_Continue: {
assert(jbs);
siglongjmp(jbs->jb, j_continue);
}
case t_Throw: {
assert(jbs);
jbs->result = eval(scope, map_get(ast, rhs_symbol));
siglongjmp(jbs->jb, j_throw);
}
case t_Try: {
oop try = map_get(ast, try_symbol);
oop exception = map_get(ast, exception_symbol);
oop catch = map_get(ast, catch_symbol);
oop finally = map_get(ast, finally_symbol);
jbRecPush();
int jbt = sigsetjmp(jbs->jb, 0);
if (0 == jbt) {
oop res = eval(scope, try);
jbRecPop();
eval(scope, finally);
return res;
}
oop res= jbs->result;
jbRecPop();
// something happend in the try block
if (j_throw == jbt) {
assert(jbs);
jbs->result= res;
if (null == catch) {
return eval(scope, finally);
}
oop localScope= newScope(scope);
setVariable(localScope, exception, res);
jbRecPush();
jbt= sigsetjmp(jbs->jb, 0);
if (0 == jbt) {
eval(localScope, catch);
delScope(localScope);
jbRecPop();
return eval(scope, finally);
}
delScope(localScope);
// something happend in the catch block
res= jbs->result;
jbRecPop();
}
eval(scope, finally);
assert(jbs);
jbs->result= res;
siglongjmp(jbs->jb, jbt);
}
case t_Block: {
oop statements = map_get(ast, statements_symbol);
int i = 0;
oop index;
oop statement, res;
oop localScope = newScope(scope);
while ((index = makeInteger(i)), map_hasKey(statements, index)) {
statement = map_get(statements, index);
res = eval(localScope, statement);
i++;
}
delScope(localScope);
return res;
}
case t_GetVariable: {
return getVariable(scope, map_get(ast, key_symbol));
}
case t_GetMember: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = map_get(ast, key_symbol);
return getMember(map, key);
}
case t_SetMember: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = map_get(ast, key_symbol);
oop op = map_get(ast, operator_symbol);
oop value = eval(scope, map_get(ast, value_symbol));
if (null != op) value= applyOperator(op, getProperty(map, key), value);
if (is(Function, value) && null == get(value, Function, name)) {
set(value, Function, name, key);
}
return map_set(map, key, value);
}
case t_GetIndex: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = eval(scope, map_get(ast, key_symbol));
switch (getType(map)) {
case String:
if (getInteger(key) >= get(map, String, size)) {
runtimeError("GetIndex out of range on String");
}
return makeInteger(unescape(get(map, String, value))[getInteger(key)]);
case Map:
return getVariable(map, key);
default:
runtimeError("GetIndex on non Map or String");
}
}
case t_SetIndex: {
oop map = eval(scope, map_get(ast, map_symbol));
oop key = eval(scope, map_get(ast, key_symbol));
oop op = map_get(ast, operator_symbol);
oop value = eval(scope, map_get(ast, value_symbol));
switch (getType(map)) {
case String:
if (getInteger(key) >= get(map, String, size)) {
runtimeError("SetIndex out of range on String");
}
get(map, String, value)[getInteger(key)] = getInteger(value);
return value;
case Map:
if (null != op) value= applyOperator(op, map_get(map, key), value);
return map_set(map, key, value);
default:
runtimeError("SetIndex on non Map or String");
}
}
case t_Symbol:
case t_Integer:
case t_Float:
case t_String: {
return map_get(ast, value_symbol);
}
case t_Logor: {
oop lhs = map_get(ast, lhs_symbol);
oop rhs = map_get(ast, rhs_symbol);
if (isTrue(eval(scope, lhs))) return makeInteger(1);
if (isTrue(eval(scope, rhs))) return makeInteger(1);
return makeInteger(0);
}
case t_Logand: {
oop lhs = map_get(ast, lhs_symbol);
oop rhs = map_get(ast, rhs_symbol);
if (isFalse(eval(scope, lhs))) return makeInteger(0);
if (isFalse(eval(scope, rhs))) return makeInteger(0);
return makeInteger(1);
}
# define RELATION(NAME, OPERATOR) \
case t_##NAME: { \
oop lhs = eval(scope, map_get(ast, lhs_symbol)); \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
return makeInteger(oopcmp(lhs, rhs) OPERATOR 0); \
}
# define BINARY(NAME, OPERATOR) \
case t_##NAME: { \
oop lhs = eval(scope, map_get(ast, lhs_symbol)); \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \
}
# define BINARYOP(NAME, FUNCPREFIX) \
case t_##NAME: { \
oop lhs = eval(scope, map_get(ast, lhs_symbol)); \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
return FUNCPREFIX##Operation(lhs, rhs); \
}
BINARY(Bitor, | );
BINARY(Bitxor, ^ );
BINARY(Bitand, & );
RELATION(Equal, ==);
RELATION(Noteq, !=);
RELATION(Less, < );
RELATION(Lesseq, <=);
RELATION(Greatereq, >=);
RELATION(Greater, > );
BINARY(Shleft, <<);
BINARY(Shright, >>);
BINARYOP(Add, add);
BINARYOP(Mul, mul);
BINARYOP(Sub, sub);
BINARYOP(Div, div);
BINARYOP(Mod, mod);
# undef BINARYOP
# undef BINARY
# undef RELATION
case t_Not: {
oop rhs = eval(scope, map_get(ast, rhs_symbol));
return makeInteger(isFalse(rhs));
}
# define UNARY(NAME, OPERATOR) \
case t_##NAME: { \
oop rhs = eval(scope, map_get(ast, rhs_symbol)); \
return makeInteger(OPERATOR getInteger(rhs)); \
}
UNARY(Neg, -);
UNARY(Com, ~);
# undef UNARY
case t_PreIncVariable: {
oop key= map_get(ast, key_symbol);
oop val= getVariable(scope, key);
val= makeInteger(getInteger(val) + 1);
return setVariable(scope, key, val);
}
case t_PreDecVariable: {
oop key= map_get(ast, key_symbol);
oop val= getVariable(scope, key);
val= makeInteger(getInteger(val) - 1);
return setVariable(scope, key, val);
}
case t_PreIncMember: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= map_get(ast, key_symbol);
oop val= map_get(map, key);
val= makeInteger(getInteger(val) + 1);
return map_set(map, key, val);
}
case t_PreDecMember: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= map_get(ast, key_symbol);
oop val= map_get(map, key);
val= makeInteger(getInteger(val) - 1);
return map_set(map, key, val);
}
case t_PreIncIndex: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= eval(scope, map_get(ast, key_symbol));
oop val= map_get(map, key);
val= makeInteger(getInteger(val) + 1);
return map_set(map, key, val);
}
case t_PreDecIndex: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= eval(scope, map_get(ast, key_symbol));
oop val= map_get(map, key);
val= makeInteger(getInteger(val) - 1);
return map_set(map, key, val);
}
case t_PostIncVariable: {
oop key= map_get(ast, key_symbol);
oop val= getVariable(scope, key);
oop inc= makeInteger(getInteger(val) + 1);
setVariable(scope, key, inc);
return val;
}
case t_PostDecVariable: {
oop key= map_get(ast, key_symbol);
oop val= getVariable(scope, key);
oop inc= makeInteger(getInteger(val) - 1);
setVariable(scope, key, inc);
return val;
}
case t_PostIncMember: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= map_get(ast, key_symbol);
oop val= map_get(map, key);
oop inc= makeInteger(getInteger(val) + 1);
map_set(map, key, inc);
return val;
}
case t_PostDecMember: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= map_get(ast, key_symbol);
oop val= map_get(map, key);
oop inc= makeInteger(getInteger(val) - 1);
map_set(map, key, inc);
return val;
}
case t_PostIncIndex: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= eval(scope, map_get(ast, key_symbol));
oop val= map_get(map, key);
oop inc= makeInteger(getInteger(val) + 1);
map_set(map, key, inc);
return val;
}
case t_PostDecIndex: {
oop map= eval(scope, map_get(ast, map_symbol));
oop key= eval(scope, map_get(ast, key_symbol));
oop val= map_get(map, key);
oop inc= makeInteger(getInteger(val) - 1);
map_set(map, key, inc);
return val;
}
#define _DO(NAME) case t_##NAME:
DO_C_PROTOS();
break;
#undef _DO
}
printf("EVAL ");
println(ast);
assert(0);
return null;
}
oop prim_exit(oop scope, oop params)
{
int status= 0;
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
if (isInteger(arg)) status= getInteger(arg);
}
exit(status);
}
oop prim_keys(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
if (is(Map, arg)) return map_keys(arg);
}
return null;
}
oop prim_values(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
if (is(Map, arg)) return map_values(arg);
}
return null;
}
oop prim_length(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
oop arg= get(params, Map, elements)[0].value;
switch (getType(arg)) {
case String: return makeInteger(string_size(arg));
case Symbol: return makeInteger(strlen(get(arg, Symbol, name)));
case Map: return makeInteger(map_size(arg));
default: break;
}
}
return null;
}
oop prim_apply(oop scope, oop params) {
oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value;
oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value;
return apply(scope, globals, func, args, mrAST);
}
oop prim_invoke(oop scope, oop params)
{
oop this= null; if (map_hasIntegerKey(params, 0)) this= get(params, Map, elements)[0].value;
oop func= null; if (map_hasIntegerKey(params, 1)) func= get(params, Map, elements)[1].value;
oop args= null; if (map_hasIntegerKey(params, 2)) args= get(params, Map, elements)[2].value;
return apply(scope, this, func, args, mrAST);
}
oop prim_clone(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value);
return null;
}
oop prim_print(oop scope, oop params)
{
assert(is(Map, params));
for (int i= 0; map_hasIntegerKey(params, i); ++i) {
print(get(params, Map, elements)[i].value);
}
return params;
}
oop evalArgs(oop scope, oop args)
{
int i = 0;
oop params = makeMap();
oop index;
while ((index = makeInteger(i)), map_hasKey(args, index)) {
map_set(params, index, eval(scope, map_get(args, index)));
i++;
}
return params;
}
oop AST= NULL;
oop outputProgram= 0;
void outputNode(oop node);
void printTree(oop element, language id);
void readEvalPrint(oop scope, char *fileName)
{
inputStackPush(fileName);
input_t *top= inputStack;
jbRecPush();
jb_record *jtop= jbs;
int jbt= sigsetjmp(jbs->jb, 0);
if (0 == jbt) {
while (yyparse()) {
if (!yylval) { // EOF
fclose(inputStack->file);
if (top == inputStack) break;
inputStackPop();
assert(inputStack);
continue;
}
assert(yylval);
if (null == yylval) { // change of language or input file
continue;
}
oop proto = map_get(yylval, __proto___symbol);
if (proto == null) {
printf("no prototype associated with ");
println(yylval);
fflush(stdout);
fprintf(stderr, "aborting\n");
exit(1);
}
// proto_number is the enum version of the proto symbol
proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype);
if (proto_number > META_PROTO_MAX) {
if (opt_v > 1) println(yylval);
map_append(outputProgram, yylval);
continue;
}
if (toPrint) {
printLang = META;
printTree(yylval, printLang);
} else {
if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber);
if (opt_v > 1) println(yylval);
oop res = eval(scope, yylval);
if (opt_v > 0) println(res);
assert(jbs == jtop);
}
}
assert(inputStack);
inputStackPop();
jbRecPop();
return;
}
assert(jbs == jtop);
oop res = jbs->result;
jbRecPop();
switch (jbt) {
case j_return: runtimeError("return outside of a function");
case j_break: runtimeError("break outside of a loop or switch");
case j_continue: runtimeError("continue outside of a loop");
case j_throw: runtimeError("unhandled exception: %s", printString(res));
}
}
oop prim_import(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) {
char *file= get(get(params, Map, elements)[0].value, String, value);
if (yyctx->__pos < yyctx->__limit) {
yyctx->__limit--;
ungetc(yyctx->__buf[yyctx->__limit], inputStack->file);
}
readEvalPrint(scope, file);
}
return null;
}
oop prim_String(oop scope, oop params)
{
if (!map_hasIntegerKey(params, 0)) return null;
return makeString(printString(get(params, Map, elements)[0].value));
}
oop prim_scope(oop scope, oop params)
{
return fixScope(scope);
}
#include <sys/resource.h>
oop prim_microseconds(oop scope, oop params)
{
struct rusage ru;
getrusage(RUSAGE_SELF, &ru);
return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec);
}
int orow= 0;
int ocol= 0;
void outputText(char *text)
{
printf("%s", text);
ocol += strlen(text);
}
void outputNode(oop node)
{
if (!node) return;
switch (getType(node)) {
case Undefined:
return;
case String:
outputText(get(node, String, value));
return;
case Map:
break;
case Symbol:
outputText(get(node, Symbol, name));
return;
default:
fprintf(stderr, "\noutputNode: unknown node type %i\n", getType(node));
abort();
}
assert(is(Map, node));
oop proto= map_get(node, __proto___symbol);
if (null == proto) { // assume this is just a list of nodes
size_t size= map_size(node);
for (size_t i= 0; i < size; ++i) {
if (!map_hasIntegerKey(node, i)) break;
outputNode(get(node, Map, elements)[i].value);
}
return;
}
// proto_number is the enum version of the proto symbol
proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype);
switch (proto_number) {
case t_Comment:
outputNode(map_get(node, text_symbol));
break;
case t_Token:
outputNode(map_get(node, text_symbol));
break;
case t_C_int:
outputNode(map_get(node, text_symbol));
break;
case t_C_float:
outputNode(map_get(node, text_symbol));
break;
case t_C_string:
outputNode(map_get(node, text_symbol));
break;
case t_C_char:
outputNode(map_get(node, value_symbol));
break;
case t_C_id:
outputNode(map_get(node, identifier_symbol));
break;
case t_C_if:
outputNode(map_get(node, ifTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, condition_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, consequent_symbol));
outputNode(map_get(node, elseTok_symbol)); // null if no else clause
outputNode(map_get(node, alternate_symbol)); // null if no else clause
break;
case t_C_while:
outputNode(map_get(node, whileTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_do:
outputNode(map_get(node, doTok_symbol));
outputNode(map_get(node, statements_symbol));
outputNode(map_get(node, whileTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_for:
outputNode(map_get(node, forTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, initExpr_symbol));
outputNode(map_get(node, firstSemi_symbol));
outputNode(map_get(node, condExpr_symbol));
outputNode(map_get(node, secondSemi_symbol));
outputNode(map_get(node, incrExpr_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_goto:
outputNode(map_get(node, gotoTok_symbol));
outputNode(map_get(node, star_symbol));
outputNode(map_get(node, name_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_initializer:
outputNode(map_get(node, leftCurly_symbol));
outputNode(map_get(node, initList_symbol));
outputNode(map_get(node, comma_symbol));
outputNode(map_get(node, rightCurly_symbol));
break;
case t_C_range:
outputNode(map_get(node, constExpr1_symbol));
outputNode(map_get(node, ellipsis_symbol));
outputNode(map_get(node, constExpr2_symbol));
break;
case t_C_switch:
outputNode(map_get(node, switchTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_case:
outputNode(map_get(node, caseTok_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, colon_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_default:
outputNode(map_get(node, defaultTok_symbol));
outputNode(map_get(node, colon_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_attribution:
outputNode(map_get(node, specifiers_symbol));
outputNode(map_get(node, declarators_symbol));
break;
case t_C_deref:
outputNode(map_get(node, star_symbol));
outputNode(map_get(node, typeQualList_symbol));
outputNode(map_get(node, declarators_symbol));
break;
case t_C_functionDef:
outputNode(map_get(node, specifiers_symbol));
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, declarationL_symbol));
outputNode(map_get(node, compoundS_symbol));
break;
case t_C_sizeOf:
outputNode(map_get(node, sizeOfTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, typeName_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_alignOf:
outputNode(map_get(node, alignOfTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, typeName_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_prefix:
outputNode(map_get(node, operator_symbol));
outputNode(map_get(node, expression_symbol));
break;
case t_C_postfix:
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, operator_symbol));
break;
case t_C_unary:
outputNode(map_get(node, operator_symbol));
outputNode(map_get(node, expression_symbol));
break;
case t_C_binary:
outputNode(map_get(node, lhs_symbol));
outputNode(map_get(node, binary_symbol));
outputNode(map_get(node, rhs_symbol));
break;
case t_C_compound:
outputNode(map_get(node, leftCurly_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rightCurly_symbol));
break;
case t_C_subexpr:
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_call:
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, paramTypeL_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_array:
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, leftBracket_symbol));
outputNode(map_get(node, static_symbol));
outputNode(map_get(node, typeQualList_symbol));
outputNode(map_get(node, dynamic_symbol));
outputNode(map_get(node, assignExpr_symbol));
outputNode(map_get(node, rightBracket_symbol));
break;
case t_C_block:
outputNode(map_get(node, bxor_symbol));
outputNode(map_get(node, typeQualList_symbol));
outputNode(map_get(node, declarators_symbol));
break;
case t_C_continue:
outputNode(map_get(node, continueTok_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_break:
outputNode(map_get(node, breakTok_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_return:
outputNode(map_get(node, returnTok_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_exprStatement:
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_asm:
outputNode(map_get(node, asmTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, text_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_asmExpr:
outputNode(map_get(node, asmTok_symbol));
outputNode(map_get(node, volatileTok_symbol));
outputNode(map_get(node, gotoTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, text_symbol));
outputNode(map_get(node, element_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_asmExprArg:
outputNode(map_get(node, text_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_declaration:
outputNode(map_get(node, specifiers_symbol));
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_parameter:
outputNode(map_get(node, specifiers_symbol));
outputNode(map_get(node, declarators_symbol));
break;
case t_C_conditional:
outputNode(map_get(node, logicalOr_symbol));
outputNode(map_get(node, question_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, colon_symbol));
outputNode(map_get(node, condExpr_symbol));
break;
case t_C_designation:
outputNode(map_get(node, identifier_symbol));
outputNode(map_get(node, colon_symbol));
break;
case t_C_index:
outputNode(map_get(node, primaryExpr_symbol));
outputNode(map_get(node, leftBracket_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rightBracket_symbol));
break;
case t_C_typeOf:
outputNode(map_get(node, typeOfTok_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, typeName_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_cast:
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, typeName_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, expression_symbol));
break;
case t_C_attributeSpec:
outputNode(map_get(node, attributeTok_symbol));
outputNode(map_get(node, llparen_symbol));
outputNode(map_get(node, lrparen_symbol));
outputNode(map_get(node, attributeL_symbol));
outputNode(map_get(node, rlparen_symbol));
outputNode(map_get(node, rrparen_symbol));
break;
case t_C_aggregate:
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, typeName_symbol));
outputNode(map_get(node, rparen_symbol));
outputNode(map_get(node, leftCurly_symbol));
outputNode(map_get(node, initList_symbol));
outputNode(map_get(node, comma_symbol));
outputNode(map_get(node, rightCurly_symbol));
break;
case t_C_attribute:
outputNode(map_get(node, text_symbol));
outputNode(map_get(node, lparen_symbol));
outputNode(map_get(node, expression_symbol));
outputNode(map_get(node, rparen_symbol));
break;
case t_C_label:
outputNode(map_get(node, name_symbol));
outputNode(map_get(node, colon_symbol));
outputNode(map_get(node, attributeL_symbol));
outputNode(map_get(node, statements_symbol));
break;
case t_C_labelDeclaration:
outputNode(map_get(node, labels_symbol));
outputNode(map_get(node, element_symbol));
outputNode(map_get(node, semicolon_symbol));
break;
case t_C_structSpec:
outputNode(map_get(node, structTok_symbol));
outputNode(map_get(node, attribute1_symbol));
outputNode(map_get(node, name_symbol));
outputNode(map_get(node, leftCurly_symbol));
outputNode(map_get(node, declarationL_symbol));
outputNode(map_get(node, rightCurly_symbol));
outputNode(map_get(node, attribute2_symbol));
break;
case t_C_structDeclarator:
outputNode(map_get(node, declarators_symbol));
outputNode(map_get(node, colon_symbol));
outputNode(map_get(node, expression_symbol));
break;
case t_C_enumSpec:
outputNode(map_get(node, enumTok_symbol));
outputNode(map_get(node, name_symbol));
outputNode(map_get(node, leftCurly_symbol));
outputNode(map_get(node, enumList_symbol));
outputNode(map_get(node, rightCurly_symbol));
break;
case t_C_enum:
outputNode(map_get(node, name_symbol));
outputNode(map_get(node, attributeL_symbol));
outputNode(map_get(node, expression_symbol));
break;
default:
printf("I cannot print a node with proto_number %i\n", proto_number);
exit(0);
}
#if 0
while (orow < node->row) { printf("\n"); ++orow; ocol= 0; }
while (ocol < node->col) { printf(" " ); ++ocol; }
#endif
outputNode(map_get(node, comment_symbol));
}
void outputValue(oop node) {
if (!node) return;
switch (getType(node)) {
case Undefined:
return;
case String:
printf("<%s>\n", (get(node, String, value)));
return;
case Map:
break;
case Symbol:
printf("<%s>\n", get(node, Symbol, name));
return;
case Integer:
printf("<%lli>\n", getInteger(node));
return;
case Float:
printf("<%Lf>\n", getFloat(node));
return;
default:
fprintf(stderr, "\noutputNode: unknown node type %i\n", getType(node));
abort();
}
}
void printSpace(int depth) {
for (int i = 0 ; i < depth ; i++) {
printf(" ");
}
}
void outputTree(oop node, int depth)
{
if(node == null) {
printSpace(depth);
printf("<null>\n");
return;
}
assert(is(Map, node));
oop proto= map_get(node, __proto___symbol);
if (null == proto) { // assume this is just a list of nodes
size_t size= map_size(node);
for (size_t i= 0; i < size; ++i) {
if (!map_hasIntegerKey(node, i)) break;
outputTree(get(node, Map, elements)[i].value, depth);
}
return;
}
// proto_number is the enum version of the proto symbol
proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype);
printSpace(depth);
switch (proto_number) {
#define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME);
#define OUT(NAME) printSpace(depth+DELTA); outputValue(map_get(node, text_symbol));
CASE(Comment)
OUT(Comment);
break;
CASE(Token)
OUT(Token);
break;
#undef CASE
#undef OUT
/** C terminal nodes */
#define CASE(NAME) case t_C_##NAME:printf("%s:\n", #NAME);
#define OUT(NAME) printSpace(depth+DELTA) ; outputValue(map_get(node, NAME##_symbol));
CASE(int)
OUT(text);
break;
CASE(float)
OUT(text);
break;
CASE(string)
OUT(text);
break;
CASE(char)
OUT(value);
break;
CASE(id)
OUT(identifier);
break;
#undef CASE
/** Meta terminal nodes */
#define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME);
CASE(Symbol)
OUT(value);
break;
CASE(Integer)
OUT(value);
break;
CASE(Float)
OUT(value);
break;
CASE(String)
OUT(value);
break;
#undef CASE
#undef OUT
/** C nodes */
#define CASE(NAME) case t_C_##NAME:printf("%s:\n", #NAME);
#define OUT(NAME) printSpace(depth+DELTA); printf("(%s)\n", #NAME); outputTree(map_get(node, NAME##_symbol), depth+2*DELTA);
CASE(if)
OUT(ifTok);
OUT(lparen);
OUT(condition);
OUT(rparen);
OUT(consequent);
OUT(elseTok);
OUT(alternate);
break;
CASE(while)
OUT(whileTok);
OUT(lparen);
OUT(expression);
OUT(rparen);
OUT(statements)
break;
CASE(do)
OUT(doTok);
OUT(statements);
OUT(whileTok);
OUT(lparen);
OUT(expression);
OUT(rparen);
OUT(semicolon);
break;
CASE(for)
OUT(forTok);
OUT(lparen);
OUT(initExpr);
OUT(firstSemi);
OUT(condExpr);
OUT(secondSemi);
OUT(incrExpr);
OUT(rparen);
OUT(statements);
break;
CASE(goto)
OUT(gotoTok);
OUT(star);
OUT(name);
OUT(semicolon);
break;
CASE(initializer)
OUT(leftCurly);
OUT(initList);
OUT(comma);
OUT(rightCurly);
break;
CASE(range)
OUT(constExpr1);
OUT(ellipsis);
OUT(constExpr2);
break;
CASE(switch)
OUT(switchTok);
OUT(lparen);
OUT(expression);
OUT(rparen);
OUT(statements);
break;
CASE(case)
OUT(caseTok);
OUT(expression);
OUT(colon);
OUT(statements);
break;
CASE(default)
OUT(defaultTok);
OUT(colon);
OUT(statements);
break;
CASE(attribution)
OUT(specifiers);
OUT(declarators);
break;
CASE(deref)
OUT(star);
OUT(typeQualList);
OUT(declarators);
break;
CASE(functionDef)
OUT(specifiers);
OUT(declarators);
OUT(declarationL);
OUT(compoundS);
break;
CASE(sizeOf)
OUT(sizeOfTok);
OUT(lparen);
OUT(typeName);
OUT(rparen);
break;
CASE(alignOf)
OUT(alignOfTok);
OUT(lparen);
OUT(typeName);
OUT(rparen);
break;
CASE(prefix)
OUT(operator);
OUT(expression);
break;
CASE(postfix)
OUT(expression);
OUT(operator);
break;
CASE(unary)
OUT(operator);
OUT(expression);
break;
CASE(binary)
OUT(lhs);
OUT(binary);
OUT(rhs);
break;
CASE(compound)
OUT(leftCurly);
OUT(expression);
OUT(rightCurly);
break;
CASE(subexpr)
OUT(lparen);
OUT(declarators);
OUT(rparen);
break;
CASE(call)
OUT(declarators);
OUT(lparen);
OUT(paramTypeL);
OUT(rparen);
break;
CASE(array)
OUT(declarators);
OUT(leftBracket);
OUT(static);
OUT(typeQualList);
OUT(dynamic);
OUT(assignExpr);
OUT(rightBracket);
break;
CASE(block)
OUT(bxor);
OUT(typeQualList);
OUT(declarators);
break;
CASE(continue)
OUT(continueTok);
OUT(semicolon);
break;
CASE(break)
OUT(breakTok);
OUT(semicolon);
break;
CASE(return)
OUT(returnTok);
OUT(expression);
OUT(semicolon);
break;
CASE(exprStatement)
OUT(expression);
OUT(semicolon);
break;
CASE(asm)
OUT(asmTok);
OUT(lparen);
OUT(text);
OUT(rparen);
break;
CASE(asmExpr)
OUT(asmTok);
OUT(volatileTok);
OUT(gotoTok);
OUT(lparen);
OUT(text);
OUT(element);
OUT(rparen);
break;
CASE(asmExprArg)
OUT(text);
OUT(lparen);
OUT(expression);
OUT(rparen);
break;
CASE(declaration)
OUT(specifiers);
OUT(declarators);
OUT(semicolon);
break;
CASE(parameter)
OUT(specifiers);
OUT(declarators);
break;
CASE(conditional)
OUT(logicalOr);
OUT(question);
OUT(expression);
OUT(colon);
OUT(condExpr);
break;
CASE(designation)
OUT(identifier);
OUT(colon);
break;
CASE(index)
OUT(primaryExpr);
OUT(leftBracket);
OUT(expression);
OUT(rightBracket);
break;
CASE(typeOf)
OUT(typeOfTok);
OUT(lparen);
OUT(typeName);
OUT(expression);
OUT(rparen);
break;
CASE(cast)
OUT(lparen);
OUT(typeName);
OUT(rparen);
OUT(expression);
break;
CASE(attributeSpec)
OUT(attributeTok);
OUT(llparen);
OUT(lrparen);
OUT(attributeL);
OUT(rlparen);
OUT(rrparen);
break;
CASE(aggregate)
OUT(lparen);
OUT(typeName);
OUT(rparen);
OUT(leftCurly);
OUT(initList);
OUT(comma);
OUT(rightCurly);
break;
CASE(attribute)
OUT(text);
OUT(lparen);
OUT(expression);
OUT(rparen);
break;
CASE(label)
OUT(name);
OUT(colon);
OUT(attributeL);
OUT(statements);
break;
CASE(labelDeclaration)
OUT(labels);
OUT(element);
OUT(semicolon);
break;
CASE(structSpec)
OUT(structTok);
OUT(attribute1);
OUT(name);
OUT(leftCurly);
OUT(declarationL);
OUT(rightCurly);
OUT(attribute2);
break;
CASE(structDeclarator)
OUT(declarators);
OUT(colon);
OUT(expression);
break;
CASE(enumSpec)
OUT(enumTok);
OUT(name);
OUT(leftCurly);
OUT(enumList);
OUT(rightCurly);
break;
CASE(enum)
OUT(name);
OUT(attributeL);
OUT(expression);
break;
#undef CASE
/** Meta nodes */
#define CASE(NAME) case t_##NAME:printf("%s:\n", #NAME);
CASE(Map)
OUT(value);
break;
CASE(Declaration)
OUT(lhs);
OUT(rhs);
break;
CASE(If)
OUT(condition);
OUT(consequent);
OUT(alternate);
break;
CASE(While)
OUT(condition);
OUT(body);
break;
CASE(Do)
OUT(body);
OUT(condition);
break;
CASE(For)
OUT(initialise);
OUT(condition);
OUT(update);
OUT(body);
break;
CASE(ForIn)
OUT(name);
OUT(expression);
OUT(body);
break;
CASE(Switch)
OUT(expression);
OUT(labels);
OUT(statements);
break;
CASE(Func)
OUT(name);
OUT(param);
OUT(body);
OUT(fixed);
break;
CASE(Call)
OUT(func);
OUT(args);
break;
CASE(Invoke)
OUT(this);
OUT(name);
OUT(args);
break;
CASE(Block)
OUT(statements);
break;
CASE(Break)
break;
CASE(Try)
OUT(try);
OUT(exception);
OUT(catch);
OUT(finally);
break;
CASE(Return)
OUT(value);
break;
CASE(Logor)
OUT(lhs);
OUT(rhs);
break;
CASE(Logand)
OUT(lhs);
OUT(rhs);
break;
CASE(Continue)
break;
CASE(Bitand)
OUT(lhs);
OUT(rhs);
break;
CASE(Bitor)
OUT(lhs);
OUT(rhs);
break;
CASE(Bitxor)
OUT(lhs);
OUT(rhs);
break;
CASE(Equal)
OUT(lhs);
OUT(rhs);
break;
CASE(Noteq)
OUT(lhs);
OUT(rhs);
break;
CASE(Less)
OUT(lhs);
OUT(rhs);
break;
CASE(Lesseq)
OUT(lhs);
OUT(rhs);
break;
CASE(Greatereq)
OUT(lhs);
OUT(rhs);
break;
CASE(Greater)
OUT(lhs);
OUT(rhs);
break;
CASE(Shleft)
OUT(lhs);
OUT(rhs);
break;
CASE(Shright)
OUT(lhs);
OUT(rhs);
break;
CASE(Add)
OUT(lhs);
OUT(rhs);
break;
CASE(Sub)
OUT(lhs);
OUT(rhs);
break;
CASE(Mul)
OUT(lhs);
OUT(rhs);
break;
CASE(Div)
OUT(lhs);
OUT(rhs);
break;
CASE(Mod)
OUT(lhs);
OUT(rhs);
break;
CASE(Throw)
OUT(rhs);
break;
CASE(Neg)
OUT(rhs);
break;
CASE(Com)
OUT(rhs);
break;
CASE(Not)
OUT(rhs);
break;
CASE(PreIncVariable)
OUT(rhs);
break;
CASE(PreIncMember)
OUT(rhs);
break;
CASE(PreIncIndex)
OUT(rhs);
break;
CASE(PostIncVariable)
OUT(rhs);
break;
CASE(PostIncMember)
OUT(rhs);
break;
CASE(PostIncIndex)
OUT(rhs);
break;
CASE(PreDecVariable)
OUT(rhs);
break;
CASE(PreDecMember)
OUT(rhs);
break;
CASE(PreDecIndex)
OUT(rhs);
break;
CASE(PostDecVariable)
OUT(rhs);
break;
CASE(PostDecMember)
OUT(rhs);
break;
CASE(PostDecIndex)
OUT(rhs);
break;
/** TODO
* CASE(Quasiquote)
* PRINT(Quasiquote);
* OUT(rhs);
* break;
* CASE(Unquote)
* PRINT(Unquote);
* OUT(rhs);
* break;
*/
/** Unknown node */
default:
printf("I cannot print a node with proto_number %i\n", proto_number);
exit(0);
}
#undef PRINT
#undef CASE
#undef OUT
}
void printTree(oop element, language id) {
if (id == C) printf("-- C program --\n");
else if (id == META) printf("-- Meta program --\n");
else fprintf(stderr, "Wrong language in printTree()");
outputTree(element, 3);
printf("\n");
}
int main(int argc, char **argv)
{
# if (USE_GC)
GC_INIT();
# endif
symbol_table= makeMap();
globals= makeMap();
outputProgram= makeMap();
map_set(globals, intern("exit" ), makeFunction(prim_exit, intern("exit" ), null, null, globals, null));
map_set(globals, intern("keys" ), makeFunction(prim_keys, intern("keys" ), null, null, globals, null));
map_set(globals, intern("values" ), makeFunction(prim_values, intern("values" ), null, null, globals, null));
map_set(globals, intern("length" ), makeFunction(prim_length, intern("length" ), null, null, globals, null));
map_set(globals, intern("print" ), makeFunction(prim_print, intern("print" ), null, null, globals, null));
map_set(globals, intern("invoke" ), makeFunction(prim_invoke, intern("invoke" ), null, null, globals, null));
map_set(globals, intern("apply" ), makeFunction(prim_apply, intern("apply" ), null, null, globals, null));
map_set(globals, intern("clone" ), makeFunction(prim_clone, intern("clone" ), null, null, globals, null));
map_set(globals, intern("import" ), makeFunction(prim_import, intern("import" ), null, null, globals, null));
map_set(globals, intern("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null));
map_set(globals, intern("String" ), makeFunction(prim_String , intern("String" ), null, null, globals, null));
map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), null, null, globals, null));
#define _DO(NAME) NAME##_symbol=intern(#NAME);
DO_SYMBOLS()
#undef _DO
#define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME);
DO_PROTOS()
#undef _DO
#define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol);
DO_PROTOS()
#undef _DO
#define _DO(NAME) map_set(globals, NAME##_symbol, NAME##_proto);
DO_PROTOS()
#undef _DO
AST = makeMap();
map_set(globals, intern("AST"), AST);
#define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto);
DO_PROTOS()
#undef _DO
fixScope(globals);
/* File scope */
pushScope();
#define _DO(NAME) set(intern(#NAME), Symbol, is_C_keyword, 1);
DO_C_KEYWORDS()
if(gnu) {
DO_C_KEYWORDS_GNU();
}
#undef _DO
int repled = 0;
/* Checking arguments */
while (argc-- > 1) {
++argv;
if (!strcmp(*argv, "-g")) ++opt_g;
else if (!strcmp(*argv, "-v")) ++opt_v;
else if (!strcmp(*argv, "-t")) toPrint = 1;
else if (!strcmp(*argv, "-")) {
readEvalPrint(globals, NULL);
repled= 1;
}
else {
readEvalPrint(globals, *argv);
repled= 1;
}
}
if (!repled) {
readEvalPrint(globals, NULL);
}
printLang = C;
for (size_t i= 0; i < map_size(outputProgram); ++i) {
oop element= get(outputProgram, Map, elements)[i].value;
if (toPrint) printTree(element, printLang);
else outputNode(element);
}
if (opt_g) {
if (nalloc < 1024) printf("[GC: %lli bytes allocated]\n", nalloc );
else if (nalloc < 1024*1024) printf("[GC: %lli kB allocated]\n", nalloc / 1024 );
else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n", (double)nalloc / ( 1024*1024));
else printf("[GC: %.2f GB allocated]\n", (double)nalloc / (1024*1024*1024));
}
popScope();
assert(!actualScope);
return 0;
(void)yyAccept;
}
// Local Variables:
// indent-tabs-mode: nil
// End: