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