diff --git a/main.leg b/main.leg index 3bea2bd..58fd890 100644 --- a/main.leg +++ b/main.leg @@ -1,6 +1,6 @@ # main.leg -- C parser + interpreter # -# Last edited: 2025-01-21 11:58:53 by piumarta on zora +# Last edited: 2025-01-22 11:03:33 by piumarta on zora %{ ; @@ -13,6 +13,8 @@ #include #include +#define TRACE printf("TRACE %s:%d:%s\n", __FILE__, __LINE__, __PRETTY_FUNCTION__); + void fatal(char *fmt, ...) { va_list ap; @@ -490,6 +492,16 @@ oop Array_set(oop array, int index, oop element) return elements[index] = element; } +int Array_equal(oop array, oop brray) +{ + if (Array_size(array) != Array_size(brray)) return 0; + Array_do(array, a) { + oop b = get(brray, Array,elements)[do_index]; + if (a != b) return 0; + } + return 1; +} + struct keyval { oop key, val; }; oop newMap(void) @@ -567,6 +579,7 @@ CTOR0(Continue); CTOR0(Break); void println(oop obj); +char *toString(oop obj); oop newTbase(char *name, int size) { @@ -617,11 +630,28 @@ oop newTstruct(oop tag, oop members) return obj; } +oop vars2types(oop vars) +{ + oop types = newArray(); + Array_do(vars, var) + Array_append(types, get(var, Variable,type)); + return types; +} + oop newTfunction(oop result, oop parameters) { + static oop functions = 0; + if (!functions) functions = newArray(); + Array_do(functions, t) { + oop tres = get(t, Tfunction,result); + oop tpar = get(t, Tfunction,parameters); + if (result == tres && Array_equal(parameters, tpar)) + return t; // uniqe types allow comparison by identity + } oop obj = new(Tfunction); obj->Tfunction.result = result; obj->Tfunction.parameters = parameters; + Array_append(functions, obj); return obj; } @@ -669,6 +699,18 @@ oop Scope_lookup(oop name) return 0; // NOTE: 0 means undefined (rather than nil, which means uninitialised) } +oop Scope_redefine(oop name, oop value) +{ + int n = get(scopes, Array,size); + oop *elts = get(scopes, Array,elements); + while (n--) { + oop scope = elts[n]; + int i = Scope_find(scope, name); + if (i >= 0) return get(get(scope, Scope,values), Array,elements)[i] = value; + } + return 0; // NOTE: 0 means undefined (rather than nil, which means uninitialised) +} + CTOR2(TypeName, name, type); CTOR3(Variable, name, type, value); CTOR3(Constant, name, type, value); @@ -725,16 +767,12 @@ oop makeType(oop base, oop type) case Tfunction: return newTfunction(base, get(type, Tfunction,parameters)); default: break; } - printf("cannot make type from delcaration: "); - println(base); - println(type); - exit(1); + fatal("cannot make type from delcaration: %s %s", toString(base), toString(type)); return 0; } oop makeName(oop decl) { - // printf("MAKE NAME "); println(decl); switch (getType(decl)) { case Undefined: case Symbol: return decl; @@ -744,9 +782,7 @@ oop makeName(oop decl) case Tfunction: return makeName(get(decl, Tfunction,result)); default: break; } - printf("cannot make name from delcaration: "); - println(decl); - exit(1); + fatal("cannot make name from delcaration: %s", toString(decl)); return 0; } @@ -806,11 +842,29 @@ void declareStringOn(oop type, oop name, oop str) String_append(str, ']'); break; } + case Tfunction: { + declareStringOn(get(type, Tfunction,result), name, str); + String_append(str, '('); + Array_do(get(type, Tfunction,parameters), parameter) { + if (do_index) String_appendAll(str, ", ", 2); + toStringOn(parameter, str); + } + String_append(str, ')'); + break; + } default: fatal("cannot convert to declaration: %s", getTypeName(type)); } } +char *declareString(oop type, oop name) +{ + oop str = newString(); + declareStringOn(type, name, str); + String_append(str, 0); + return get(str, String,elements); +} + oop toStringOn(oop obj, oop str) { int n = 0; @@ -1226,7 +1280,7 @@ decltor = STAR d:decltor { $$ = newTpointer(d) } ddector = ( LPAREN d:decltor RPAREN | d:idopt ) ( LBRAK e:expropt RBRAK { d = newTarray(d, e) } - | p:params { d = newTfunction(d, p) } + | p:params { d = newTfunction(d, vars2types(p)) } )* { $$ = d } params = LPAREN a:mkArray @@ -1236,7 +1290,7 @@ params = LPAREN a:mkArray | e:error { expected(e, "parameter declaration") } ) -pdecl = t:tname d:decltor { $$ = newVarDecls(t, d) } +pdecl = t:tname d:decltor { $$ = newVariable(makeName(d), makeType(t, d), nil) } initor = agrinit | expr @@ -1245,7 +1299,8 @@ agrinit = LBRACE i:mkArray ( COMMA j:initor { Array_append(i, j) } )* COMMA? )? RBRACE { $$ = i } -fundefn = t:tname d:funid p:params b:block { $$ = newFunction(d, t, p, b) } +fundefn = t:tname d:funid + p:params b:block { $$ = newFunction(makeName(d), makeType(t, d), p, b) } funid = STAR d:funid { $$ = newUnary(DEREF, d) } | LPAREN d:funid RPAREN { $$ = d } @@ -1540,13 +1595,46 @@ oop apply(oop function, oop arguments, oop env) void define(oop name, oop value) { oop scope = Array_last(scopes); - int index = Scope_find(scope, name); - if (index >= 0) fatal("name '%s' redefined\n", get(name, Symbol,name)); + int index = Scope_find(scope, name); // searches active scope only + if (index >= 0) { + oop old = Scope_lookup(name); assert(old); + switch (getType(old)) { + case Variable: { + oop oldtype = get(old, Variable,type); + if (is(Tfunction, oldtype)) { + switch (getType(value)) { + case Variable: { + oop valtype = get(value, Variable,type); + if (oldtype == valtype) return; // function declaration + printf("FUNCTION FORWARD TYPE MISMATCH 1\n"); + break; + } + case Function: { // replace forard declaration with actual function + Scope_redefine(name, value); + return; + } + default: + break; + } + } + break; + } + case Function: { + if (is(Variable, value)) { + oop oldtype = get(old, Function,type); + oop valtype = get(old, Variable,type); + if (oldtype == valtype) return; // compatible redeclaration + printf("FUNCTION FORWARD TYPE MISMATCH 2\n"); + } + break; + } + default: + break; + } + fatal("name '%s' redefined\n", get(name, Symbol,name)); + } Array_append(get(scope, Scope,names ), name ); Array_append(get(scope, Scope,values), value); - // printf("NAME = " ); println(name); - // printf("VALU = " ); println(value); - // printf(" => "); println(scope); } void defineTypeName(oop name, oop type) @@ -2282,7 +2370,6 @@ oop compile(oop exp) // 6*7 oop typeCheck(oop exp, oop fntype) { - // printf("TYPE CHECK "); println(exp); switch (getType(exp)) { case Integer: return t_int; case Float: return t_float; @@ -2309,14 +2396,10 @@ oop typeCheck(oop exp, oop fntype) oop parameters = get(exp, Function,parameters); oop body = get(exp, Function,body ); oop ptypes = newArray(); - Array_do(parameters, vdecls) { - oop vars = get(vdecls, VarDecls,variables); assert(1 == Array_size(vars)); - oop var = Array_get(vars, 0); - Array_set(parameters, do_index, var); + Array_do(parameters, var) { oop type = get(var, Variable,type); - if (t_void == type) - if (do_index || do_size > 1) - fatal("illegal void parameter"); + if (t_void == type && (do_index || do_size > 1)) + fatal("illegal void parameter"); Array_append(ptypes, type); } if (1 == Array_size(ptypes) && Array_last(ptypes) == t_void) { @@ -2377,7 +2460,15 @@ oop typeCheck(oop exp, oop fntype) oop varname = get(var, Variable,name); oop vartype = get(var, Variable,type); oop varval = get(var, Variable,value); - oop old = Scope_lookup(varname); + if (is(Tfunction, vartype)) { + oop ptypes = get(vartype, Tfunction,parameters); + if (1 == Array_size(ptypes) && t_void == Array_last(ptypes)) { + Array_popLast(ptypes); + // make unique + vartype = newTfunction(get(vartype, Tfunction,result), ptypes); + } + } + oop old = Scope_lookup(varname); if (old) { // declared oop oldtype = nil; switch (getType(old)) { @@ -2395,12 +2486,13 @@ oop typeCheck(oop exp, oop fntype) case Function: oldtype = get(old, Function,type); break; case Primitive: oldtype = get(old, Primitive,type); break; default: - printf("cannot find type of declaration: "); - println(old); - exit(1); + fatal("cannot find type of declaration: %s", toString(old)); } if (vartype == oldtype) continue; - fatal("identifier '%s' redefined as different type", toString(varname)); + fatal("identifier '%s' redefined as different type: %s -> %s", + toString(varname), + declareString(oldtype, varname), + declareString(vartype, varname)); } if (!isNil(varval)) { oop initype = typeCheck(varval, fntype); @@ -2415,9 +2507,7 @@ oop typeCheck(oop exp, oop fntype) default: break; } - printf("\ncannot typeCheck %s: ", getTypeName(exp)); - println(exp); - exit(1); + fatal("cannot typeCheck: %s", toString(exp)); return 0; }