From 46c4a94f5a90f5eda9cd5f2c0c3fdbc3a10668ea Mon Sep 17 00:00:00 2001 From: Ian Piumarta Date: Mon, 20 Jan 2025 18:05:52 +0900 Subject: [PATCH] handle function parameters/arguments --- main.leg | 765 ++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 561 insertions(+), 204 deletions(-) diff --git a/main.leg b/main.leg index 0fa7d61..6943b12 100644 --- a/main.leg +++ b/main.leg @@ -1,7 +1,12 @@ +# main.leg -- C parser + interpreter +# +# Last edited: 2025-01-20 17:35:37 by piumarta on zora + %{ ; #include #include +#include #include #include #include @@ -53,9 +58,9 @@ typedef union Object Object, *oop; _(Undefined) _(Input) _(Integer) _(Float) _(Symbol) _(Pair) _(String) _(Array) \ _(Closure) _(Call) \ _(Block) _(Unary) _(Binary) _(Cast) _(While) _(For) _(If) _(Return) _(Continue) _(Break) \ - _(Type) _(Struct) \ - _(VarDecls) _(FunDefn) \ - _(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) + _(Tbase) _(Tpointer) _(Tarray) _(Tstruct) _(Tfunction) \ + _(Scope) _(TypeName) _(Variable) _(Constant) _(Function) _(Primitive) \ + _(VarDecls) typedef enum { @@ -95,53 +100,56 @@ struct For { type_t _type; oop initialiser, condition, update, body; }; struct If { type_t _type; oop condition, consequent, alternate; }; struct Return { type_t _type; oop value; }; struct Continue { type_t _type; }; -struct Break { type_t _type; oop value; }; - -struct Type { type_t _type; char *name; }; -struct Struct { type_t _type; oop tag, members; }; +struct Break { type_t _type; }; -struct VarDecls { type_t _type; oop type, declarations, variables; }; -struct FunDefn { type_t _type; oop type, name, parameters, body; }; +struct Tbase { type_t _type; char *name; int size; }; +struct Tpointer { type_t _type; oop target; }; +struct Tarray { type_t _type; oop target; oop size; }; +struct Tstruct { type_t _type; oop tag, members; }; +struct Tfunction { type_t _type; oop result, parameters; }; struct Scope { type_t _type; oop names, types, values; }; struct TypeName { type_t _type; oop name, type; }; struct Variable { type_t _type; oop name, type, value; }; struct Constant { type_t _type; oop name, type, value; }; struct Function { type_t _type; oop name, type, parameters, body, *code; }; -struct Primitive { type_t _type; oop name; prim_t function; }; +struct Primitive { type_t _type; oop name, type; prim_t function; }; +struct VarDecls { type_t _type; oop type, declarations, variables; }; union Object { - type_t _type; - struct Input Input; - struct Integer Integer; - struct Float Float; - struct Symbol Symbol; - struct Pair Pair; - struct String String; - struct Array Array; - struct Primitive Primitive; - struct Closure Closure; - struct Call Call; - struct Block Block; - struct Unary Unary; - struct Binary Binary; - struct Cast Cast; - struct For For; - struct While While; - struct If If; - struct Return Return; - struct Continue Continue; - struct Break Break; - struct Type Type; - struct Struct Struct; - struct VarDecls VarDecls; - struct FunDefn FunDefn; - struct Scope Scope; - struct TypeName TypeName; - struct Variable Variable; - struct Constant Constant; - struct Function Function; + type_t _type; + struct Input Input; + struct Integer Integer; + struct Float Float; + struct Symbol Symbol; + struct Pair Pair; + struct String String; + struct Array Array; + struct Primitive Primitive; + struct Closure Closure; + struct Call Call; + struct Block Block; + struct Unary Unary; + struct Binary Binary; + struct Cast Cast; + struct For For; + struct While While; + struct If If; + struct Return Return; + struct Continue Continue; + struct Break Break; + struct Tbase Tbase; + struct Tpointer Tpointer; + struct Tarray Tarray; + struct Tstruct Tstruct; + struct Tfunction Tfunction; + struct Scope Scope; + struct TypeName TypeName; + struct Variable Variable; + struct Constant Constant; + struct Function Function; + struct VarDecls VarDecls; }; int opt_O = 0; // optimise (use VM) @@ -230,7 +238,7 @@ oop newFloat(double value) # endif } -char *typeName(type_t type) +char *typeName(int type) { static char *typeNames[] = { # define _(X) #X, @@ -259,7 +267,7 @@ int is(type_t type, oop obj) { return type == getType(obj); } oop _check(oop obj, type_t type, char *file, int line) { if (type != getType(obj)) - fatal("%s:%d: expected type %d, got type %d", file, line, type, getType(obj)); + fatal("%s:%d: expected %s, got %s", file, line, typeName(type), getTypeName(obj)); return obj; } @@ -391,6 +399,23 @@ int String_append(oop string, int element) return elements[size] = element; } +char *String_appendAll(oop string, char *chars, int len) +{ + char *elements = get(string, String,elements); + int size = get(string, String,size); + int newSize = size + len; + elements = REALLOC(elements, sizeof(*elements) * newSize); + memcpy(elements + size, chars, len); + set(string, String,elements, elements); + set(string, String,size, newSize); + return chars; +} + +#define Array_do(ARR, VAR) \ + for (int do_size = get(ARR, Array,size), do_index = 0; \ + do_index < do_size && (VAR = (ARR)->Array.elements[do_index]); \ + ++do_index) + oop newArray(void) { oop obj = new(Array); @@ -409,13 +434,25 @@ oop Array_append(oop array, oop element) return elements[size] = element; } -oop newArrayWith(oop a) +oop newArray1(oop a) { oop obj = newArray(); Array_append(obj, a); return obj; } +oop newArray2(oop a, oop b) +{ + oop obj = newArray1(a); + Array_append(obj, b); + return obj; +} + +int Array_size(oop array) +{ + return get(array, Array,size); +} + oop Array_last(oop array) { int size = get(array, Array,size); @@ -435,6 +472,14 @@ oop Array_popLast(oop array) return last; } +oop Array_get(oop array, int index) +{ + oop *elements = get(array, Array,elements); + int size = get(array, Array,size); + if (index >= size) fatal("array index %d out of bounds %d", index, size); + return elements[index]; +} + oop Array_set(oop array, int index, oop element) { oop *elements = get(array, Array,elements); @@ -443,6 +488,52 @@ oop Array_set(oop array, int index, oop element) return elements[index] = element; } +struct keyval { oop key, val; }; + +oop newMap(void) +{ + return newArray(); +} + +int Map_find(oop map, oop key) +{ + int size = get(map, Array,size) / 2; + struct keyval *kvs = (struct keyval *)get(map, Array,elements); + int lo = 0, hi = size - 1; + while (lo <= hi) { + int mi = (lo + hi) / 2; + if (key < kvs[mi].key) hi = mi - 1; + else if (key > kvs[mi].key) lo = mi + 1; + else return mi; + } + return -1 - lo; // not found, encoding expected location +} + +oop Map_set(oop map, oop key, oop val) +{ + int size = get(map, Array,size) / 2; + struct keyval *kvs = (struct keyval *)get(map, Array,elements); + int index = Map_find(map, key); + if (index > 0) return kvs[index].val = val; + index = -1 - index; + int last = size++; + kvs = realloc(kvs, sizeof(*kvs) * size); + while (last > index) { + kvs[last] = kvs[last - 1]; + --last; + } + kvs[index].key = key; + return kvs[index].val = val; +} + +oop Map_get(oop map, oop key) +{ + struct keyval *kvs = (struct keyval *)get(map, Array,elements); + int index = Map_find(map, key); + if (index < 0) fatal("key not found in map"); + return kvs[index].val; +} + CTOR2(Closure, function, environment); CTOR2(Call, function, arguments); CTOR1(Block, statements); @@ -470,39 +561,54 @@ CTOR4(For, initialiser, condition, update, body); CTOR3(If, condition, consequent, alternate); CTOR1(Return, value); CTOR0(Continue); -CTOR1(Break, value); +CTOR0(Break); void println(oop obj); -oop newType(char *name) +oop newTbase(char *name, int size) { - oop obj = new(Type); - obj->Type.name = name; + oop obj = new(Tbase); + obj->Tbase.name = name; + obj->Tbase.size = size; return obj; } -oop Type_void = 0; -oop Type_char = 0; -oop Type_int = 0; +oop t_void = 0; +oop t_char = 0; +oop t_int = 0; +oop t_float = 0; +oop t_string = 0; -CTOR2(Struct, tag, members); +oop newTpointer(oop target) +{ + oop obj = new(Tpointer); + obj->Tpointer.target = target; + return obj; +} -oop newVarDecls(oop type, oop declaration) +oop newTarray(oop target, oop size) { - oop obj = new(VarDecls); - obj->VarDecls.type = type; - obj->VarDecls.declarations = newArray(); - obj->VarDecls.variables = newArray(); - Array_append(obj->VarDecls.declarations, declaration); + oop obj = new(Tarray); + obj->Tarray.target = target; + obj->Tarray.size = size; return obj; } -void VarDecls_append(oop vd, oop declaration) +oop newTstruct(oop tag, oop members) { - Array_append(get(vd, VarDecls,declarations), declaration); + oop obj = new(Tstruct); + obj->Tstruct.tag = tag; + obj->Tstruct.members = members; + return obj; } -CTOR4(FunDefn, type, name, parameters, body); +oop newTfunction(oop result, oop parameters) +{ + oop obj = new(Tfunction); + obj->Tfunction.result = result; + obj->Tfunction.parameters = parameters; + return obj; +} oop newScope(void) { @@ -518,7 +624,7 @@ int Scope_find(oop scope, oop name) oop names = get(scope, Scope,names); int size = get(names, Array,size); oop *elts = get(names, Array,elements); - for (int i = 0; i < size; ++i) + for (int i = size; i--;) if (name == elts[i]) return i; return -1; @@ -563,21 +669,199 @@ oop newFunction(oop name, oop type, oop parameters, oop body) return obj; } -oop newPrimitive(oop name, prim_t function) +oop newPrimitive(oop name, oop type, prim_t function) { oop obj = new(Primitive); obj->Primitive.name = name; + obj->Primitive.type = type; obj->Primitive.function = function; return obj; } +oop makeType(oop base, oop decl); + +oop makeTypes(oop declarations) +{ + int size = get(declarations, Array,size); + oop *elts = get(declarations, Array,elements); + oop types = newArray(); + for (int i = 0; i < size; ++i) { + oop vdecl = elts[i]; + oop type = get(vdecl, VarDecls,type); + oop decls = get(vdecl, VarDecls,declarations); + int dsize = get(decls, Array,size); + oop *delts = get(decls, Array,elements); + for (int j = 0; j < dsize; ++j) + Array_append(types, makeType(type, delts[j])); + } + return types; +} + +oop makeType(oop base, oop type) +{ + switch (getType(type)) { + case Symbol: return base; + case Tpointer: return newTpointer(makeType(base, get(type, Tpointer,target))); + default: break; + } + printf("cannot make type from delcaration: "); + println(type); + exit(1); + return 0; +} + +oop makeName(oop decl) +{ + // printf("MAKE NAME "); println(decl); + switch (getType(decl)) { + case Undefined: + case Symbol: return decl; + case Tpointer: return makeName(get(decl, Tpointer,target)); + default: break; + } + printf("cannot make name from delcaration: "); + println(decl); + exit(1); + return 0; +} + +oop newVarDecls(oop type, oop decl) +{ + oop obj = new(VarDecls); + obj->VarDecls.type = type; + obj->VarDecls.declarations = newArray(); + obj->VarDecls.variables = newArray(); + Array_append(obj->VarDecls.declarations, decl); + Array_append(obj->VarDecls.variables, newVariable(makeName(decl), makeType(type, decl), nil)); + return obj; +} + +void VarDecls_append(oop vds, oop decl) +{ + Array_append(get(vds, VarDecls,declarations), decl); + oop type = makeType(get(vds, VarDecls,type), decl); + oop name = makeName(decl); + Array_append(get(vds, VarDecls,variables), newVariable(name, type, nil)); +} + #undef CTOR4 #undef CTOR3 #undef CTOR2 #undef CTOR1 #undef CTOR0 +oop baseType(oop type) +{ + switch (getType(type)) { + case Tbase: return type; + case Tpointer: return baseType(get(type, Tpointer,target)); + case Tarray: return baseType(get(type, Tarray,target)); + default: + fatal("cannot find base type of %s", getTypeName(type)); + } + return nil; +} + +oop toStringOn(oop obj, oop str); + +void declareStringOn(oop type, oop name, oop str) +{ + switch (getType(type)) { + case Tbase: + toStringOn(name, str); + break; + case Tpointer: + String_append(str, '*'); + declareStringOn(get(type, Tpointer,target), name, str); + break; + default: + fatal("cannot convert to declaration: %s", getTypeName(type)); + } +} + +oop toStringOn(oop obj, oop str) +{ + int n = 0; + switch (getType(obj)) { + case Symbol: + String_appendAll(str, get(obj, Symbol,name), strlen(get(obj, Symbol,name))); + break; + case String: + String_appendAll(str, get(obj, String,elements), get(obj, String,size)); + break; + case Tbase: + String_appendAll(str, get(obj, Tbase,name), strlen(get(obj, Tbase,name))); + break; + case Tpointer: { + oop target = get(obj, Tpointer,target); + toStringOn(target, str); + if (is(Tbase, target)) String_append(str, ' '); + String_append(str, '*'); + break; + } + case Tfunction: { + oop result = get(obj, Tfunction,result); + oop params = get(obj, Tfunction,parameters); + toStringOn(result, str); + String_append(str, '('); + oop param = nil; + Array_do(params, param) { + if (do_index) String_appendAll(str, ", ", 2); + toStringOn(param, str); + } + String_append(str, ')'); + break; + } + case Variable: { + oop type = get(obj, Variable,type); + oop name = get(obj, Variable,name); + toStringOn(baseType(type), str); + String_append(str, ' '); + declareStringOn(type, name, str); + break; + } + case Function: { + toStringOn(get(get(obj, Function,type), Tfunction,result), str); + String_append(str, ' '); + toStringOn(get(obj, Function,name), str); + String_append(str, '('); + oop params = get(obj, Function,parameters); + oop param = nil; + Array_do(params, param) { + if (do_index) String_appendAll(str, ", ", 2); + toStringOn(param, str); + } + String_append(str, ')'); + break; + } + case VarDecls: { + oop vars = get(obj, VarDecls,variables); + oop base = get(obj, VarDecls,type); + oop decls = get(obj, VarDecls,declarations); + oop decl = nil; + Array_do(decls, decl) { + if (do_index) String_appendAll(str, ", ", 2); + toStringOn(decl, str); + String_append(str, ' '); + toStringOn(base, str); + } + break; + } + default: + fatal("cannot convert %s to string", getTypeName(obj)); + break; + } + return str; +} + +char *toString(oop obj) +{ + oop str = toStringOn(obj, newString()); + String_append(str, 0); + return get(str, String,elements); +} + void printiln(oop obj, int indent) { printf("%*s", indent*2, ""); @@ -718,17 +1002,33 @@ void printiln(oop obj, int indent) } case Break: { printf("BREAK\n"); - printiln(get(obj, Break,value), indent+1); break; } - case Type: { - printf("<%s>\n", get(obj, Type,name)); + case Tbase: { + printf("<%s:%d>\n", get(obj, Tbase,name), get(obj, Tbase,size)); + break; + } + case Tpointer: { + printf("Tpointer\n"); + printiln(get(obj, Tpointer,target), indent+1); + break; + } + case Tarray: { + printf("Tarray\n"); + printiln(get(obj, Tarray,size ), indent+1); + printiln(get(obj, Tarray,target), indent+1); break; } - case Struct: { - printf("Struct\n"); - printiln(get(obj, Struct,tag ), indent+1); - printiln(get(obj, Struct,members), indent+1); + case Tstruct: { + printf("Tstruct\n"); + printiln(get(obj, Tstruct,tag ), indent+1); + printiln(get(obj, Tstruct,members), indent+1); + break; + } + case Tfunction: { + printf("Tfunction\n"); + printiln(get(obj, Tfunction,result ), indent+1); + printiln(get(obj, Tfunction,parameters), indent+1); break; } case VarDecls: { @@ -738,14 +1038,6 @@ void printiln(oop obj, int indent) printiln(get(obj, VarDecls,variables ), indent+1); break; } - case FunDefn: { - printf("FunDefn\n"); - printiln(get(obj, FunDefn,type ), indent+1); - printiln(get(obj, FunDefn,name ), indent+1); - printiln(get(obj, FunDefn,parameters), indent+1); - printiln(get(obj, FunDefn,body ), indent+1); - break; - } case Scope: { printf("SCOPE\n"); printiln(get(obj, Scope,names), indent+1); @@ -772,7 +1064,7 @@ void printiln(oop obj, int indent) break; }; case Function: { - printf("Function\n"); + printf("Function %s\n", toString(get(obj, Function,name))); printiln(get(obj, Function,type ), indent+1); printiln(get(obj, Function,parameters), indent+1); printiln(get(obj, Function,body ), indent+1); @@ -843,6 +1135,8 @@ void expected(oop where, char *what) fatal("%s expected near: %.*s", what, get(where, String,size), get(where, String,elements)); } +oop eval(oop exp, oop env); + %} start = - ( interp { yysval = 0 } @@ -864,18 +1158,17 @@ include = HASH INCLUDE ( tldecl = fundefn | vardecl vardecl = t:tname d:inidecl { d = newVarDecls(t, d) } - ( COMMA e:inidecl { VarDecls_append(d, e) } - )* SEMI { $$ = d } + ( COMMA e:inidecl { VarDecls_append(d, e) } + )* SEMI { $$ = d } -tname = INT { $$ = Type_int } - | CHAR { $$ = Type_char } - | VOID { $$ = Type_void } +tname = INT { $$ = t_int } + | CHAR { $$ = t_char } + | VOID { $$ = t_void } | struct - | i:id -struct = STRUCT ( i:id m:members { $$ = newStruct( i, m) } - | i:id { $$ = newStruct(nil, m) } - | m:members { $$ = newStruct( i, nil) } +struct = STRUCT ( i:id m:members { $$ = newTstruct( i, m) } + | i:id { $$ = newTstruct(nil, m) } + | m:members { $$ = newTstruct( i, nil) } ) members = LBRACE vardecl* RBRACE @@ -884,13 +1177,13 @@ inidecl = d:decltor ( ASSIGN e:initor { $$ = newBinary(ASSIGN, d, e) } | { $$ = d } ) -decltor = STAR d:decltor { $$ = newUnary(DEREF, d) } +decltor = STAR d:decltor { $$ = newTpointer(d) } | ddector ddector = ( LPAREN d:decltor RPAREN | d:idopt - ) ( LBRAK e:expropt RBRAK { d = newBinary(INDEX, d, e) } - | p:params { d = newCall(d, e) } + ) ( LBRAK e:expropt RBRAK { d = newTarray(d, e) } + | p:params { d = newTfunction(d, p) } )* { $$ = d } params = LPAREN a:mkArray @@ -907,7 +1200,7 @@ agrinit = LBRACE i:mkArray ( COMMA j:initor { Array_append(i, j) } )* COMMA? )? RBRACE { $$ = i } -fundefn = t:tname d:funid p:params b:block { $$ = newFunDefn(t, d, p, b) } +fundefn = t:tname d:funid p:params b:block { $$ = newFunction(d, t, p, b) } funid = STAR d:funid { $$ = newUnary(DEREF, d) } | LPAREN d:funid RPAREN { $$ = d } @@ -928,10 +1221,10 @@ stmt = WHILE c:cond s:stmt { $$ = newWhile(c, e) } ) | RETURN e:expropt SEMI { $$ = newReturn(e) } | CONTINU SEMI { $$ = newContinue() } - | BREAK SEMI { $$ = newBreak(nil) } + | BREAK SEMI { $$ = newBreak() } | block - | vardecl | e:expr SEMI { $$ = e } + | vardecl cond = LPAREN e:expr RPAREN { $$ = e } @@ -1151,115 +1444,52 @@ oop nlrPop(void) #define isFalse(O) ((O) == nil) #define isTrue(O) ((O) != nil) -oop eval(oop exp, oop env); +void defineVariable(oop name, oop type, oop value); oop apply(oop function, oop arguments, oop env) { - // printf("APPLY "); println(function); + if (opt_v > 2) { printf("APPLY "); println(function); } switch (getType(function)) { default: { fatal("type %s is not callable", getTypeName(function)); } case Primitive: { + oop argv = newArray(), arg = nil; + Array_do(arguments, arg) Array_append(argv, eval(arg, nil)); return get(function, Primitive,function) - ( get(arguments, Array,size), - get(arguments, Array,elements), + ( get(argv, Array,size), + get(argv, Array,elements), env ); } case Function: { oop parameters = get(function, Function,parameters); oop body = get(function, Function,body); - int nParams = get(parameters, Array,size); - int nArgs = get(arguments, Array,size); - if (nParams != nArgs) - fatal("wrong number of arguments, expected %d got %d", nParams, nArgs); + int parc = get(parameters, Array,size); + int argc = get(arguments, Array,size); + if (parc != argc) + fatal("wrong number of arguments, expected %d got %d", parc, argc); + oop *parv = get(parameters, Array,elements); + oop *argv = get(arguments, Array,elements); Scope_begin(); + for (int i = 0; i < argc; ++i) { + oop var = parv[i]; + oop arg = argv[i]; + defineVariable(get(var, Variable,name), get(var, Variable,type), eval(arg, nil)); + } switch (nlrPush()) { // longjmp occurred case NLR_INIT: break; - case NLR_RETURN: return nlrPop(); + case NLR_RETURN: Scope_end(); return nlrPop(); case NLR_CONTINUE: fatal("continue outside loop"); case NLR_BREAK: fatal("break outside loop"); } oop result = eval(body, nil); + Scope_end(); nlrPop(); return result; } } } -oop makeType(oop base, oop decl); - -oop makeTypes(oop declarations) -{ - int size = get(declarations, Array,size); - oop *elts = get(declarations, Array,elements); - oop types = newArray(); - // printf("MAKE TYPES\n"); - for (int i = 0; i < size; ++i) { - oop vdecl = elts[i]; - oop type = get(vdecl, VarDecls,type); - oop decls = get(vdecl, VarDecls,declarations); - int dsize = get(decls, Array,size); - oop *delts = get(decls, Array,elements); - for (int j = 0; j < dsize; ++j) - Array_append(types, makeType(type, delts[j])); - } - return types; -} - -oop makeType(oop base, oop decl) -{ - // printf("MAKE TYPE "); println(base); - // printf(" "); println(decl); - switch (getType(decl)) { - case Undefined: - case Symbol: return base; - case Unary: { - switch (get(decl, Unary,operator)) { - case DEREF: return newUnary(DEREF, makeType(base, get(decl, Unary,rhs))); - default: break; - } - break; - } - case Call: { - oop func = get(decl, Call,function); - oop params = get(decl, Call,arguments); - return newCall(makeType(base, func), makeTypes(params)); - } - default: - break; - } - printf("cannot make type from delcaration: "); - println(decl); - exit(1); - return 0; -} - -oop makeName(oop decl) -{ - // printf("MAKE NAME "); println(decl); - switch (getType(decl)) { - case Undefined: - case Symbol: return decl; - case Unary: { - switch (get(decl, Unary,operator)) { - case DEREF: return makeName(get(decl, Unary,rhs)); - default: break; - } - break; - } - case Call: { - return makeName(get(decl, Call,function)); - } - default: - break; - } - printf("cannot make name from delcaration: "); - println(decl); - exit(1); - return 0; -} - void define(oop name, oop value) { oop scope = Array_last(scopes); @@ -1292,14 +1522,33 @@ void defineFunction(oop name, oop type, oop parameters, oop body) define(name, newFunction(name, type, parameters, body)); } -void definePrimitive(oop name, prim_t function) +void definePrimitive(oop name, oop type, prim_t function) +{ + define(name, newPrimitive(name, type, function)); +} + +int VarDecls_finalise(oop vds) { - define(name, newPrimitive(name, function)); + oop vars = get(vds, VarDecls,variables); + if (nil == vars) { + assert(nil == vars); + oop base = get(vds, VarDecls,type ); + oop decls = get(vds, VarDecls,declarations); + oop decl = nil; + vars = newArray(); + Array_do(decls, decl) { + oop name = makeName(decl); + oop type = makeType(base, decl); + Array_append(vars, newVariable(name, type, nil)); + } + set(vds, VarDecls,variables, vars); + } + return get(vars, Array,size); } oop eval(oop exp, oop env) { - // printf("EVAL "); println(exp); + if (opt_v > 2) { printf("EVAL "); println(exp); } switch (getType(exp)) { case Undefined: assert(!"this cannot happen"); case Input: assert(!"this cannot happen"); @@ -1319,7 +1568,7 @@ oop eval(oop exp, oop env) case Call: { oop fun = eval(get(exp, Call,function), env); oop args = get(exp, Call,arguments); - return apply(fun, args, env); + return apply(fun, args, nil); } case Block: { Object *stmts = get(exp, Block,statements); @@ -1455,26 +1704,20 @@ oop eval(oop exp, oop env) break; } case Break: { - nlrReturn(NLR_BREAK, eval(get(exp, Break,value), env)); + nlrReturn(NLR_BREAK, nil); break; } - case Type: assert(!"unimplemented"); break; - case Struct: assert(!"unimplemented"); break; + case Tbase: assert(!"unimplemented"); break; + case Tpointer: assert(!"unimplemented"); break; + case Tarray: assert(!"unimplemented"); break; + case Tstruct: assert(!"unimplemented"); break; + case Tfunction: assert(!"unimplemented"); break; case VarDecls: assert(!"unimplemented"); break; - case FunDefn: { - oop type = get(exp, FunDefn,type ); - oop name = get(exp, FunDefn,name ); - oop parameters = get(exp, FunDefn,parameters); - oop body = get(exp, FunDefn,body ); - type = makeType(type, newCall(name, parameters)); - defineFunction(name, type, parameters, body); - return nil; - } case Scope: break; case TypeName: break; case Variable: break; case Constant: break; - case Function: return newClosure(exp, env); + case Function: return exp; } assert(!"this cannot happen"); return 0; @@ -1491,8 +1734,27 @@ oop prim_printf(int argc, oop *argv, oop env) // array char *fmt = get(format, String,elements); int size = get(format, String,size); int n = 0; - for (int i = 0; i < size; ++i) { - putchar(fmt[i]); + int argn = 1; + for (int i = 0; i < size;) { + int c = fmt[i++]; + if (c == '%' && fmt[i]) { + c = fmt[i++]; + if (c == '%') goto echo; + oop arg = nil; + switch (c) { + case 'd': { + if (argn >= argc) + fatal("not enough argments for printf format string"); + arg = argv[argn++]; + if (!is(Integer, arg)) + fatal("%%d conversion argument is %s", getTypeName(arg)); + n += printf("%ld", _integerValue(arg)); + continue; + } + } + } + echo: + putchar(c); ++n; } return newInteger(n); @@ -1920,10 +2182,12 @@ void compileOn(oop exp, oop program, oop cs, oop bs) Array_append(bs, newInteger(L1)); return; } - case Type: assert(!"unimplemented"); return; - case Struct: assert(!"unimplemented"); return; + case Tbase: assert(!"unimplemented"); return; + case Tpointer: assert(!"unimplemented"); return; + case Tarray: assert(!"unimplemented"); return; + case Tstruct: assert(!"unimplemented"); return; + case Tfunction: assert(!"unimplemented"); return; case VarDecls: assert(!"unimplemented"); return; - case FunDefn: assert(!"unimplemented"); return; case Scope: assert(!"this cannot happen"); return; case TypeName: assert(!"unimplemented"); return; case Variable: assert(!"unimplemented"); return; @@ -1956,6 +2220,93 @@ oop compile(oop exp) // 6*7 return program; } +oop typeCheck(oop exp) +{ + // printf("TYPE CHECK "); println(exp); + switch (getType(exp)) { + case Integer: return t_int; + case Float: return t_float; + case String: return t_string; + case Symbol: { + oop value = Scope_lookup(exp); + if (!value) fatal("undefined variable '%s'", symbolName(exp)); + if (nil == value) fatal("uninitialised variable '%s'", symbolName(exp)); + switch (getType(value)) { + case Primitive: return get(value, Primitive,type); + case Function: return get(value, Function,type); + case Variable: return get(value, Variable,type); + default: + fatal("cannot typecheck value %s", getTypeName(value)); + } + return nil; + } + case Primitive: { + return get(exp, Primitive,type); + } + case Function: { + oop result = get(exp, Function,type ); + oop name = get(exp, Function,name ); + oop parameters = get(exp, Function,parameters); + oop body = get(exp, Function,body ); + oop vdecls = nil; + 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_append(ptypes, get(var, Variable,type)); + } + set(exp, Function,type, newTfunction(result, ptypes)); + define(name, exp); // add function to global scope so recursive calls will work + Scope_begin(); // parameters + oop param = nil; + Array_do(parameters, param) define(get(param, Variable,name), param); + typeCheck(body); // block + Scope_end(); + return nil; + } + case Block: { + Scope_begin(); + oop statements = get(exp, Block,statements), statement = nil; + Array_do(statements, statement) typeCheck(statement); + Scope_end(); + return nil; + } + case Call: { + oop function = get(exp, Call,function ); + oop arguments = get(exp, Call,arguments); + oop tfunc = typeCheck(function); + if (!is(Tfunction, tfunc)) fatal("cannot call %s", getTypeName(tfunc)); + oop params = get(tfunc, Tfunction,parameters); + int argc = get(arguments, Array,size); + oop *argv = get(arguments, Array,elements); + int parc = get(params, Array,size); + oop *parv = get(params, Array,elements); + if (argc != parc) fatal("wrong number (%d) of arguments, expected %d", argc, parc); + for (int i = 0; i < argc; ++i) { + oop part = parv[i]; + oop arg = argv[i]; + oop argt = typeCheck(arg); + if (argt != part) + fatal("cannot pass argument of type '%s' to parameter of type '%s' ", + toString(argt), toString(part)); + } + return get(tfunc,Tfunction, result); + } + case Return: { + oop value = get(exp, Return,value); + if (isNil(value)) return t_void; + return typeCheck(value); + } + default: + break; + } + printf("\ncannot typeCheck %s: ", getTypeName(exp)); + println(exp); + exit(1); + return 0; +} + void replFile(char *name, FILE *file) { input = pushInput(name, file); @@ -1976,12 +2327,12 @@ void replFile(char *name, FILE *file) case NLR_CONTINUE: fatal("continue outside loop"); case NLR_BREAK: fatal("break outside loop"); } + typeCheck(yysval); result = eval(yysval, nil); nlrPop(); } if (opt_v > 0) { - printf("=> "); - println(result); + printf("=> %s\n", toString(result)); } } } @@ -1998,14 +2349,20 @@ void replPath(char *path) int main(int argc, char **argv) { true = newSymbol("true"); - Type_void = newType("void"); - Type_char = newType("char"); - Type_int = newType("int"); + + t_void = newTbase("void", 1); + t_char = newTbase("char", 1); + t_int = newTbase("int", 4); + t_float = newTbase("float", 4); + t_string = newTpointer(t_char); scopes = newArray(); - Scope_begin(); - definePrimitive(intern("printf"), prim_printf); + Scope_begin(); // the global scope + + definePrimitive(intern("printf"), + newTfunction(t_int, newArray2(t_string, t_int)), + prim_printf); int repls = 0;