@ -30,11 +30,12 @@
_DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \
_DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex) \
_DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \
_DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex) \
_DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \
_DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \
_DO(Quote) /* _DO(Quasiquote) _DO(Unquote) */ \
_DO(Quote) _DO(Quasiquote) /* _DO(Unquote) */ \
DO_C_PROTOS()
DO_C_PROTOS()
#define META_PROTO_MAX t_Try
#define META_PROTO_MAX t_Try
// C protos must begin with Comment because it is a sentinel
#define DO_C_PROTOS() \
#define DO_C_PROTOS() \
_DO(Comment) _DO(Token) \
_DO(Comment) _DO(Token) \
_DO(C_declaration) _DO(C_stringLiteral) \
_DO(C_declaration) _DO(C_stringLiteral) \
@ -1347,7 +1348,7 @@ oop ensure(int id, oop s)
{
{
if (is(Map, s)) {
if (is(Map, s)) {
oop protoSymbol = map_get(s, __proto___symbol);
oop protoSymbol = map_get(s, __proto___symbol);
// int protoNumber = get(map_get(protoSymbol , __name___symbol), Symbol, prototype);
// int protoNumber = get(map_get(map_get(s, __proto___symbol) , __name___symbol), Symbol, prototype);
switch(id) {
switch(id) {
case t_C_id: {
case t_C_id: {
if (map_get(protoSymbol, __name___symbol) != map_get(C_id_proto, __name___symbol)) { // map_get for tree copy because __name__ : C_id != __name__ : C_id
if (map_get(protoSymbol, __name___symbol) != map_get(C_id_proto, __name___symbol)) { // map_get for tree copy because __name__ : C_id != __name__ : C_id
@ -1360,8 +1361,87 @@ oop ensure(int id, oop s)
return s;
return s;
}
}
%}
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;
}
oop treeCopy(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, size));
memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, size));
oop map= malloc(sizeof(*obj));
memcpy(map, obj, sizeof(*obj));
for (int i = 0; i<get(obj, Map, size); i++) {
elements[i].value = treeCopy(elements[i].value);
}
set(map, Map, elements, elements);
return map;
}
}
return obj;
}
oop treeCopyUnquoting(oop scope, 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, size));
memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, size));
oop map= malloc(sizeof(*obj));
memcpy(map, obj, sizeof(*obj));
for (int i = 0; i<get(obj, Map, size); i++) {
int firstCond = is(Map, elements[i].value) && map_get(elements[i].value, __proto___symbol) != null;
if (firstCond && get(map_get(map_get(elements[i].value, __proto___symbol), __name___symbol), Symbol, prototype) < t_Comment) {
elements[i].value = eval(scope, treeCopyUnquoting(scope, elements[i].value));
} else {
elements[i].value = treeCopyUnquoting(scope, elements[i].value);
}
}
set(map, Map, elements, elements);
return map;
}
}
return obj;
}
%}
#--------------------------------------------- C grammar -------------------------------------------------#
#--------------------------------------------- C grammar -------------------------------------------------#
@ -1385,7 +1465,7 @@ id = { $$= new_C_id(yytex
metaId = META_AT META_LPAREN m:meta_exp META_RPAREN { $$= m}
metaId = META_AT META_LPAREN m:meta_exp META_RPAREN { $$= m}
mmetaId = META_AT META_AT META_LPAREN m:meta_exp META_RPAREN { $$= m}
mmetaId = META_AT META_AT META_LPAREN m:meta_exp META_RPAREN { $$= m }
ID = <NAME> &{ !is_C_keyword(yytext) }
ID = <NAME> &{ !is_C_keyword(yytext) }
@ -2453,15 +2533,15 @@ META_FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > { $$= make
#--------------------------------------------- Meta operator ----------------------------------------------#
#--------------------------------------------- Meta operator ----------------------------------------------#
MO_OPERATION = META_BACKTICK ( MO_INITIALIZER i:initializer { $$= newUnary(Quote_proto, i) }
| MO_CONSTANT c:constant { $$= newUnary(Quote_proto, c) }
| MO_STATEMENT s:statement { $$= newUnary(Quote_proto, s) }
| MO_INTEGER i:integerConstant { $$= newUnary(Quote_proto, i) }
| MO_DECLARATION d:declaration { $$= newUnary(Quote_proto, d) }
| MO_STRING s:stringLiteral { $$= newUnary(Quote_proto, s) }
| MO_FUN f:functionDefinition { $$= newUnary(Quote_proto, f) }
| MO_ED e:externalDeclaration { $$= newUnary(Quote_proto, e) }
| MO_EXPRESSION e:expression { $$= newUnary(Quote_proto, e) }
MO_OPERATION = META_BACKTICK ( MO_INITIALIZER i:initializer { $$= newUnary(Quasiqu ote_proto, i) }
| MO_CONSTANT c:constant { $$= newUnary(Quasiqu ote_proto, c) }
| MO_STATEMENT s:statement { $$= newUnary(Quasiqu ote_proto, s) }
| MO_INTEGER i:integerConstant { $$= newUnary(Quasiqu ote_proto, i) }
| MO_DECLARATION d:declaration { $$= newUnary(Quasiqu ote_proto, d) }
| MO_STRING s:stringLiteral { $$= newUnary(Quasiqu ote_proto, s) }
| MO_FUN f:functionDefinition { $$= newUnary(Quasiqu ote_proto, f) }
| MO_ED e:externalDeclaration { $$= newUnary(Quasiqu ote_proto, e) }
| MO_EXPRESSION e:expression { $$= newUnary(Quasiqu ote_proto, e) }
)
)
MO_INITIALIZER = 'initializer' ![(a-zA-Z0-9_] --
MO_INITIALIZER = 'initializer' ![(a-zA-Z0-9_] --
@ -2601,29 +2681,6 @@ oop map_zip(oop map, oop keys, oop values)
return map;
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
struct Call
{
{
oop ast, function;
oop ast, function;
@ -2838,7 +2895,7 @@ oop newScope(oop parent)
void delScope(oop scope)
void delScope(oop scope)
{ assert(is(Map, scope));
{ assert(is(Map, scope));
if (scope->Map.flags & MAP_ENCLOSED) {
if (scope->Map.flags & MAP_ENCLOSED) {
printf("IGNORE %p\n", scope);
// printf("IGNORE %p\n", scope);
return;
return;
}
}
scope->Map.pool= freeScopes;
scope->Map.pool= freeScopes;
@ -2866,28 +2923,29 @@ oop apply(oop scope, oop this, oop func, oop args, oop ast)
switch (jbt) {
switch (jbt) {
case j_return: {
case j_return: {
untrace(ast);
untrace(ast);
delScope(localScope);
delScope(localScope);
oop result = jbs->result;
oop result = jbs->result;
jbRecPop();
jbRecPop();
return result;
return result;
}
}
case j_break: {
case j_break: {
delScope(localScope);
delScope(localScope);
runtimeError("break outside of a loop or switch");
runtimeError("break outside of a loop or switch");
}
}
case j_continue: {
case j_continue: {
delScope(localScope);
delScope(localScope);
runtimeError("continue outside of a loop");
runtimeError("continue outside of a loop");
}
}
case j_throw: {
case j_throw: {
untrace(ast);
untrace(ast);
delScope(localScope);
delScope(localScope);
oop res= jbs->result;
oop res= jbs->result;
jbRecPop();
jbRecPop();
jbs->result= res;
jbs->result= res;
siglongjmp(jbs->jb, j_throw);
siglongjmp(jbs->jb, j_throw);
}
}
}
}
// oop tmpresult = treeCopyUnquoting(get(func, Function, body), localScope); // eval inside the quasiquote thing
oop result= eval(localScope, get(func, Function, body));
oop result= eval(localScope, get(func, Function, body));
untrace(ast);
untrace(ast);
delScope(localScope);
delScope(localScope);
@ -2942,11 +3000,11 @@ oop eval(oop scope, oop ast)
oop obj = map_get(ast, rhs_symbol);
oop obj = map_get(ast, rhs_symbol);
return obj;
return obj;
}
}
#if 0
case t_Quasiquote: {
case t_Quasiquote: {
oop obj = map_get(ast, rhs_symbol);
oop obj = map_get(ast, rhs_symbol);
return expandUnquotes (scope, obj);
return treeCopyUnquoting (scope, obj);
}
}
#if 0
case t_Unquote: {
case t_Unquote: {
runtimeError("@ outside of `");
runtimeError("@ outside of `");
}
}
@ -3587,6 +3645,12 @@ oop prim_clone(oop scope, oop params)
return null;
return null;
}
}
oop prim_treeCopy(oop scope, oop params)
{
if (map_hasIntegerKey(params, 0)) return treeCopy(get(params, Map, elements)[0].value);
return null;
}
oop prim_print(oop scope, oop params)
oop prim_print(oop scope, oop params)
{
{
assert(is(Map, params));
assert(is(Map, params));
@ -4061,6 +4125,7 @@ void outputNode(oop node)
break;
break;
default:
default:
if (proto_number < t_C_declaration) {
if (proto_number < t_C_declaration) {
println(node);
outputNode(eval(globals, node));
outputNode(eval(globals, node));
break;
break;
}
}
@ -4736,9 +4801,11 @@ int main(int argc, char **argv)
map_set(globals, intern("invoke" ), makeFunction(prim_invoke, intern("invoke" ), 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("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("clone" ), makeFunction(prim_clone, intern("clone" ), null, null, globals, null));
map_set(globals, intern("treeCopy" ), makeFunction(prim_treeCopy, intern("treeCopy" ), null, null, globals, null));
map_set(globals, intern("import" ), makeFunction(prim_import, intern("import" ), 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("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("string" ), makeFunction(prim_String , intern("string" ), null, null, globals, null));
map_set(globals, intern("scope" ), makeFunction(prim_scope, intern("scope" ), null, null, globals, null));
map_set(globals, intern("scope" ), makeFunction(prim_scope, intern("scope" ), null, null, globals, null));