evaluates test.txt with no type checking

main.leg

@@ -43,16 +43,25 @@ void fatal(char *fmt, ...)
 # endif
 #endif
 
+#define indexableSize(A)	(sizeof(A) / sizeof(*(A)))
+
 typedef union Object Object, *oop;
 
 #define YYSTYPE oop
 
+#define _do_types(_)										\
+    _(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)
+
+
 typedef enum {
-    Undefined, Input, Integer, Float, Symbol, Pair, String, Array,
-    Primitive, Closure, Function, Call,
-    Block, Unary, Binary, Cast, While, For, If, Return, Continue, Break,
-    Type, Struct,
-    VarDecls, FunDefn,
+# define _(X) X,
+    _do_types(_)
+# undef _
 } type_t;
 
 typedef enum { NEG, NOT, COM, DEREF, REF, PREINC, PREDEC, POSTINC, POSTDEC } unary_t;
@@ -75,9 +84,7 @@ struct Symbol  	 { type_t _type;  char *name; oop value; };
 struct Pair   	 { type_t _type;  oop head, tail; };
 struct String  	 { type_t _type;  int size;  char *elements; };
 struct Array   	 { type_t _type;  int size;  oop *elements; };
-struct Primitive { type_t _type;  prim_t function;  char *name; };
 struct Closure	 { type_t _type;  oop function, environment; };
-struct Function	 { type_t _type;  oop parameters, body, *code; };
 struct Call   	 { type_t _type;  oop function, arguments; };
 struct Block   	 { type_t _type;  oop statements; };
 struct Unary   	 { type_t _type;  unary_t  operator;  oop      rhs; };
@@ -96,6 +103,13 @@ struct Struct 	 { type_t _type;  oop tag, members; };
 struct VarDecls	 { type_t _type;  oop type, declarations, variables; };
 struct FunDefn	 { type_t _type;  oop type, name, parameters, body; };
 
+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; };
+
 union Object
 {
     type_t           _type;
@@ -108,7 +122,6 @@ union Object
     struct Array     Array;
     struct Primitive Primitive;
     struct Closure   Closure;
-    struct Function  Function;
     struct Call      Call;
     struct Block     Block;
     struct Unary     Unary;
@@ -124,6 +137,11 @@ union Object
     struct Struct    Struct;
     struct VarDecls  VarDecls;
     struct FunDefn   FunDefn;
+    struct Scope     Scope;
+    struct TypeName  TypeName;
+    struct Variable  Variable;
+    struct Constant  Constant;
+    struct Function  Function;
 };
 
 int opt_O = 0; // optimise (use VM)
@@ -145,6 +163,45 @@ oop _new(size_t size, type_t type)
 
 #define new(TYPE) _new(sizeof(struct TYPE), TYPE)
 
+#define CTOR0(Type)				\
+    oop new##Type(void) {			\
+	return new(Type);			\
+    }
+
+#define CTOR1(Type, A)				\
+    oop new##Type(oop A) {			\
+	oop obj = new(Type);			\
+	obj->Type.A = A;			\
+	return obj;				\
+    }
+
+#define CTOR2(Type, A, B)			\
+    oop new##Type(oop A, oop B) {		\
+	oop obj = new(Type);			\
+	obj->Type.A = A;			\
+	obj->Type.B = B;			\
+	return obj;				\
+    }
+
+#define CTOR3(Type, A, B, C)			\
+    oop new##Type(oop A, oop B, oop C) {	\
+	oop obj = new(Type);			\
+	obj->Type.A = A;			\
+	obj->Type.B = B;			\
+	obj->Type.C = C;			\
+	return obj;				\
+    }
+
+#define CTOR4(Type, A, B, C, D)			\
+    oop new##Type(oop A, oop B, oop C, oop D) {	\
+	oop obj = new(Type);			\
+	obj->Type.A = A;			\
+	obj->Type.B = B;			\
+	obj->Type.C = C;			\
+	obj->Type.D = D;			\
+	return obj;				\
+    }
+
 oop newInteger(long value)
 {
 # if TAGINT
@@ -173,6 +230,17 @@ oop newFloat(double value)
 # endif
 }
 
+char *typeName(type_t type)
+{
+    static char *typeNames[] = {
+#     define _(X) #X,
+	_do_types(_)
+#     undef _
+    };
+    if (type < 0 || type >= indexableSize(typeNames)) fatal("unknown type %d", type);
+    return typeNames[type];
+}
+
 type_t getType(oop obj)
 {
 # if TAGINT
@@ -184,6 +252,8 @@ type_t getType(oop obj)
     return obj->_type;
 }
 
+char *getTypeName(oop obj)	{ return typeName(getType(obj)); }
+
 int is(type_t type, oop obj)	{ return type == getType(obj); }
 
 oop _check(oop obj, type_t type, char *file, int line)
@@ -280,13 +350,7 @@ oop intern(char *name)
     return sym;
 }
 
-oop newPair(oop head, oop tail)
-{
-    oop obj = new(Pair);
-    obj->Pair.head = head;
-    obj->Pair.tail = tail;
-    return obj;
-}
+CTOR2(Pair, head, tail);
 
 oop head(oop pair)	{ return get(pair, Pair,head); }
 oop tail(oop pair)	{ return get(pair, Pair,tail); }
@@ -345,53 +409,43 @@ oop Array_append(oop array, oop element)
     return elements[size] = element;
 }
 
-oop Array_set(oop array, int index, oop element)
+oop newArrayWith(oop a)
 {
-    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] = element;
-}
-
-oop newPrimitive(prim_t function, char *name)
-{
-    oop obj = new(Primitive);
-    obj->Primitive.function = function;
-    obj->Primitive.name     = name;
+    oop obj = newArray();
+    Array_append(obj, a);
     return obj;
 }
 
-oop newClosure(oop function, oop environment)
+oop Array_last(oop array)
 {
-    oop obj = new(Closure);
-    obj->Closure.function    = function;
-    obj->Closure.environment = environment;
-    return obj;
+    int  size = get(array, Array,size);
+    oop *elts = get(array, Array,elements);
+    assert(size > 0);
+    return elts[size - 1];
 }
 
-oop newFunction(oop parameters, oop body)
+oop Array_popLast(oop array)
 {
-    oop obj = new(Function);
-    obj->Function.parameters = parameters;
-    obj->Function.body       = body;
-    obj->Function.code       = 0;
-    return obj;
+    int  size = get(array, Array,size);
+    oop *elts = get(array, Array,elements);
+    assert(size > 0);
+    oop  last = elts[--size];
+    elts[size] = nil;
+    set(array, Array,size, size);
+    return last;
 }
 
-oop newCall(oop function, oop arguments)
+oop Array_set(oop array, int index, oop element)
 {
-    oop obj = new(Call);
-    obj->Call.function  = function;
-    obj->Call.arguments = arguments;
-    return obj;
+    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] = element;
 }
 
-oop newBlock(oop statements)
-{
-    oop obj = new(Block);
-    obj->Block.statements = statements;
-    return obj;
-}
+CTOR2(Closure, function, environment);
+CTOR2(Call,    function, arguments);
+CTOR1(Block,   statements);
 
 oop newUnary(unary_t operator, oop operand)
 {
@@ -410,107 +464,120 @@ oop newBinary(binary_t operator, oop lhs, oop rhs)
     return obj;
 }
 
-oop newCast(oop type, oop declarator, oop rhs)
-{
-    oop obj = new(Cast);
-    obj->Cast.type       = type;
-    obj->Cast.declarator = declarator;
-    obj->Cast.rhs        = rhs;
-    return obj;
-}
+CTOR3(Cast,   type, declarator, rhs);
+CTOR2(While,  condition, expression);
+CTOR4(For,    initialiser, condition, update, body);
+CTOR3(If,     condition, consequent, alternate);
+CTOR1(Return, value);
+CTOR0(Continue);
+CTOR1(Break,  value);
+
+void println(oop obj);
 
-oop newWhile(oop condition, oop expression)
+oop newType(char *name)
 {
-    oop obj = new(While);
-    obj->While.condition  = condition;
-    obj->While.expression = expression;
+    oop obj = new(Type);
+    obj->Type.name = name;
     return obj;
 }
 
-oop newFor(oop initialiser, oop condition, oop update, oop body)
+oop Type_void = 0;
+oop Type_char = 0;
+oop Type_int  = 0;
+
+CTOR2(Struct, tag, members);
+
+oop newVarDecls(oop type, oop declaration)
 {
-    oop obj = new(For);
-    obj->For.initialiser = initialiser;
-    obj->For.condition   = condition;
-    obj->For.update      = update;
-    obj->For.body        = body;
+    oop obj = new(VarDecls);
+    obj->VarDecls.type         = type;
+    obj->VarDecls.declarations = newArray();
+    obj->VarDecls.variables    = newArray();
+    Array_append(obj->VarDecls.declarations, declaration);
     return obj;
 }
 
-oop newIf(oop condition, oop consequent, oop alternate)
+void VarDecls_append(oop vd, oop declaration)
 {
-    oop obj = new(If);
-    obj->If.condition  = condition;
-    obj->If.consequent = consequent;
-    obj->If.alternate  = alternate;
-    return obj;
+    Array_append(get(vd, VarDecls,declarations), declaration);
 }
 
-oop newReturn(oop value)
+CTOR4(FunDefn, type, name, parameters, body);
+
+oop newScope(void)
 {
-    oop obj = new(Return);
-    obj->Return.value = value;
+    oop obj = new(Scope);
+    obj->Scope.names  = newArray();
+    obj->Scope.types  = newArray();
+    obj->Scope.values = newArray();
     return obj;
 }
 
-oop newContinue(void)
+int Scope_find(oop scope, oop name)
 {
-    return new(Continue);
+    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)
+	if (name == elts[i])
+	    return i;
+    return -1;
 }
 
-oop newBreak(oop value)
+oop scopes = 0;
+
+void Scope_begin(void)
 {
-    oop obj = new(Break);
-    obj->Break.value = value;
-    return obj;
+    Array_append(scopes, newScope());
 }
 
-void println(oop obj);
-
-oop newType(char *name)
+void Scope_end(void)
 {
-    oop obj = new(Type);
-    obj->Type.name = name;
-    return obj;
+    Array_popLast(scopes);
 }
 
-oop Type_void = 0;
-oop Type_char = 0;
-oop Type_int  = 0;
-
-oop newStruct(oop tag, oop members)
+oop Scope_lookup(oop name)
 {
-    oop obj = new(Struct);
-    obj->Struct.tag     = tag;
-    obj->Struct.members = members;
-    return obj;
+    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];
+    }
+    return 0; // NOTE: 0 means undefined (rather than nil, which means uninitialised)
 }
 
-oop newVarDecls(oop type, oop declaration)
+CTOR2(TypeName, name, type);
+CTOR3(Variable, name, type, value);
+CTOR3(Constant, name, type, value);
+
+oop newFunction(oop name, oop type, oop parameters, oop body)
 {
-    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(Function);
+    obj->Function.name       = name;
+    obj->Function.type       = type;
+    obj->Function.parameters = parameters;
+    obj->Function.body       = body;
+    obj->Function.code       = 0;
     return obj;
 }
 
-void VarDecls_append(oop vd, oop declaration)
+oop newPrimitive(oop name, prim_t function)
 {
-    Array_append(get(vd, VarDecls,declarations), declaration);
-}
+    oop obj = new(Primitive);
+    obj->Primitive.name     = name;
+    obj->Primitive.function = function;
 
-oop newFunDefn(oop type, oop name, oop parameters, oop body)
-{
-    oop obj = new(FunDefn);
-    obj->FunDefn.type       = type;
-    obj->FunDefn.name       = name;
-    obj->FunDefn.parameters = parameters;
-    obj->FunDefn.body       = body;
     return obj;
 }
 
+#undef CTOR4
+#undef CTOR3
+#undef CTOR2
+#undef CTOR1
+#undef CTOR0
+
 void printiln(oop obj, int indent)
 {
     printf("%*s", indent*2, "");
@@ -551,7 +618,7 @@ void printiln(oop obj, int indent)
 	    break;
 	}
 	case Primitive: {
-	    printf("PRIMITIVE<%s>\n", get(obj, Primitive,name));
+	    printf("PRIMITIVE<%s>\n", symbolName(get(obj, Primitive,name)));
 	    break;
 	}
 	case Closure: {
@@ -559,15 +626,9 @@ void printiln(oop obj, int indent)
 	    printiln(get(obj, Closure,function), indent+1);
 	    break;
 	}
-	case Function: {
-	    printf("FUNCTION\n");
-	    printiln(get(obj, Function,parameters), indent+1);
-	    printiln(get(obj, Function,body), indent+1);
-	    break;
-	}
 	case Call: {
 	    printf("CALL\n");
-	    printiln(get(obj, Call,function), indent+1);
+	    printiln(get(obj, Call,function ), indent+1);
 	    printiln(get(obj, Call,arguments), indent+1);
 	    break;
 	}
@@ -661,7 +722,7 @@ void printiln(oop obj, int indent)
 	    break;
 	}
 	case Type: {
-	    printf("Type %s\n", get(obj, Type,name));
+	    printf("<%s>\n", get(obj, Type,name));
 	    break;
 	}
 	case Struct: {
@@ -685,6 +746,38 @@ void printiln(oop obj, int indent)
 	    printiln(get(obj, FunDefn,body      ),  indent+1);
 	    break;
 	}
+	case Scope: {
+	    printf("SCOPE\n");
+	    printiln(get(obj, Scope,names), indent+1);
+	    break;
+	}
+	case TypeName: {
+	    printf("TypeName\n");
+	    printiln(get(obj, TypeName,name), indent+1);
+	    printiln(get(obj, TypeName,type), indent+1);
+	    break;
+	}
+	case Variable: {
+	    printf("Variable\n");
+	    printiln(get(obj, Variable,name ), indent+1);
+	    printiln(get(obj, Variable,type ), indent+1);
+	    printiln(get(obj, Variable,value), indent+1);
+	    break;
+	}
+	case Constant: {
+	    printf("Constant\n");
+	    printiln(get(obj, Constant,name ), indent+1);
+	    printiln(get(obj, Constant,type ), indent+1);
+	    printiln(get(obj, Constant,value), indent+1);
+	    break;
+	};
+	case Function: {
+	    printf("Function\n");
+	    printiln(get(obj, Function,type      ), indent+1);
+	    printiln(get(obj, Function,parameters), indent+1);
+	    printiln(get(obj, Function,body      ), indent+1);
+	    break;
+	}
     }
 }
 
@@ -752,7 +845,8 @@ void expected(oop where, char *what)
 
 %}
 
-start	= - (   include		{ yysval = 0 }
+start	= - (   interp		{ yysval = 0 }
+	    |   include		{ yysval = 0 }
 	    | x:tldecl		{ yysval = x }
 	    |   !.		{ yysval = 0 }
 	    |  e:error		{ expected(e, "declaration") }
@@ -760,6 +854,8 @@ start	= - (   include		{ yysval = 0 }
 
 error	= < (![\n\r] .)* > 	{ $$ = newStringWith(yytext) }
 
+interp	= HASH PLING (![\n\r] .)*
+
 include	= HASH INCLUDE (
 	    '<' < [a-zA-Z0-9_.]* > '>' @{ pushInput(yytext, sysOpen(yytext)) }
 	  | '"' < [a-zA-Z0-9_.]* > '"' @{ pushInput(yytext, usrOpen(yytext)) }
@@ -798,9 +894,9 @@ ddector	= ( LPAREN d:decltor RPAREN
 	    )*				{ $$ = d }
 
 params	= LPAREN a:mkArray
-	  	 ( p:pdecl		{ Array_append(a, p) }
-	  	   ( COMMA p:pdecl	{ Array_append(a, p) }
-	  	   )* )? RPAREN		{ $$ = a }
+	  ( p:pdecl			{ Array_append(a, p) }
+	    ( COMMA p:pdecl		{ Array_append(a, p) }
+	    )* )? RPAREN		{ $$ = a }
 
 pdecl	= t:tname d:decltor		{ $$ = newVarDecls(t, d) }
 
@@ -1045,14 +1141,6 @@ oop nlrPop(void)
 
 #define nlrReturn(TYPE, VAL)	((nlrValue = (VAL), longjmp(nlrStack[nlrCount-1], TYPE)))
 
-oop define(oop lhs, oop rhs, oop env)
-{
-    oop kv = assoc(env, lhs);
-    if (nil != kv) return set(kv, Pair,tail, rhs); // local
-    if (!is(Symbol, lhs)) fatal("cannot assign to non-symbol type %d", getType(lhs));
-    return set(lhs, Symbol,value, rhs);
-}
-
 #define IBINOP(L, OP, R)	newInteger(integerValue(L) OP integerValue(R))
 #define IRELOP(L, OP, R)	(integerValue(L) OP integerValue(R) ? true : false)
 
@@ -1067,9 +1155,10 @@ oop eval(oop exp, oop env);
 
 oop apply(oop function, oop arguments, oop env)
 {
+    // printf("APPLY ");  println(function);
     switch (getType(function)) {
 	default: {
-	    fatal("object type %d is not callable", getType(function));
+	    fatal("type %s is not callable", getTypeName(function));
 	}
 	case Primitive: {
 	    return get(function, Primitive,function)
@@ -1077,54 +1166,156 @@ oop apply(oop function, oop arguments, oop env)
 		  get(arguments, Array,elements),
 		  env );
 	}
-	case Closure: {
-	    oop env2 = get(function, Closure,environment);
-	    function     = get(function, Closure,function);
+	case Function: {
 	    oop parameters = get(function, Function,parameters);
-	    int nParams = get(parameters, Array,size);
-	    int nArgs   = get(arguments,  Array,size);
+	    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);
-	    oop *params = get(parameters, Array,elements);
-	    oop *args   = get(arguments,  Array,elements);
-	    for (int i = nArgs;  i--;) {
-		oop key = params[i];
-		oop val = eval(args[i], env);
-		env2 = newPair(newPair(key, val), env2);
-	    }
-	    oop body = get(function, Function,body);
-	    oop result = nil;
+	    Scope_begin();
 	    switch (nlrPush()) { // longjmp occurred
 		case NLR_INIT:     break;
 		case NLR_RETURN:   return nlrPop();
 		case NLR_CONTINUE: fatal("continue outside loop");
 		case NLR_BREAK:	   fatal("break outside loop");
 	    }
-	    result = eval(body, env2);
+	    oop result = eval(body, nil);
 	    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);
+    int index = Scope_find(scope, name);
+    if (index >= 0) 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)
+{
+    define(name, newTypeName(name, type));
+}
+
+void defineVariable(oop name, oop type, oop value)
+{
+    define(name, newVariable(name, type, value));
+}
+
+void defineConstant(oop name, oop type, oop value)
+{
+    define(name, newConstant(name, type, value));
+}
+
+void defineFunction(oop name, oop type, oop parameters, oop body)
+{
+    define(name, newFunction(name, type, parameters, body));
+}
+
+void definePrimitive(oop name, prim_t function)
+{
+    define(name, newPrimitive(name, function));
+}
+
 oop eval(oop exp, oop env)
 {
+    // printf("EVAL  "); println(exp);
     switch (getType(exp)) {
 	case Undefined:	assert(!"this cannot happen");
 	case Input:	assert(!"this cannot happen");
 	case Integer:	return exp;
 	case Float:	return exp;
 	case Symbol: {
-	    oop kv = assoc(env, exp);
-	    if (nil == kv) return get(exp, Symbol,value); // global value stored in symbol
-	    return tail(kv); // local value stored in association
+	    oop value = Scope_lookup(exp);
+	    if (!value) 	fatal("'%s' is undefined\n",     get(exp, Symbol,name));
+	    if (isNil(value))	fatal("'%s' is uninitialised\n", get(exp, Symbol,name));
+	    return value;
 	}
 	case Pair:	assert(!"this cannot happen");
 	case String:	return exp;
 	case Array: 	assert(!"this cannot happen");
 	case Primitive:	return exp;
 	case Closure:	return exp;
-	case Function:  return newClosure(exp, env);
 	case Call: {
  	    oop fun  = eval(get(exp, Call,function), env);
  	    oop args = get(exp, Call,arguments);
@@ -1164,8 +1355,8 @@ oop eval(oop exp, oop env)
 		case LAND:   return isFalse(eval(lhs, env)) ? false : eval(rhs, env);
 		case LOR:    return isTrue (eval(lhs, env)) ? true  : eval(rhs, env);
 		case ASSIGN: {
-		    rhs = eval(rhs, env);
-		    return define(lhs, rhs, env);
+		    assert(!"unimplemented");
+		    return nil;
 		}
 		default: {
 		    lhs = eval(lhs, env);
@@ -1270,7 +1461,20 @@ oop eval(oop exp, oop env)
 	case Type:	assert(!"unimplemented");	    break;
 	case Struct:	assert(!"unimplemented");	    break;
 	case VarDecls:	assert(!"unimplemented");	    break;
-	case FunDefn:	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);
     }
     assert(!"this cannot happen");
     return 0;
@@ -1278,23 +1482,20 @@ oop eval(oop exp, oop env)
 
 // primitive functions
 
-oop prim_print(int argc, oop *argv, oop env) // array
+oop prim_printf(int argc, oop *argv, oop env) // array
 {
     oop result = nil;
-    for (int i = 0;  i < argc;  ++i) {
-	result = eval(argv[i], env);
-	println(result);
+    if (argc < 1) fatal("printf: no format string");
+    oop format = argv[0];
+    if (!is(String, format)) fatal("printf: format is not a string");
+    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]);
+	++n;
     }
-    return result;
-}
-
-#include <sys/resource.h>
-
-oop prim_memsize(int argc, oop *argv, oop env) // array
-{
-    struct rusage ru;
-    if (getrusage(RUSAGE_SELF, &ru) < 0) return nil;
-    return newInteger(ru.ru_maxrss);
+    return newInteger(n);
 }
 
 enum opcode_t { iHALT = 0, iPUSH, iPOP,
@@ -1574,13 +1775,6 @@ void compileOn(oop exp, oop program, oop cs, oop bs)
 	case Array:	assert(!"unimplemented");
 	case Primitive:	EMITio(iPUSH, exp);	return;
 	case Closure:	EMITio(iPUSH, exp);	return;
-	case Function: {
-	    assert(0 == get(exp, Function,code));
-	    oop prog2 = compileFunction(get(exp, Function,body));
-	    set(exp, Function,code, get(prog2, Array,elements));
-	    EMITio(iCLOSE, exp);
-	    return;
-	}
 	case Call: {
 	    Object  *args = get(exp, Call,arguments);
 	    int      argc = get(args, Array,size);
@@ -1726,10 +1920,21 @@ 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 VarDecls:	assert(!"unimplemented");    return;
-	case FunDefn:	assert(!"unimplemented");    return;
+	case Type:	assert(!"unimplemented");    	return;
+	case Struct:	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;
+	case Constant:	assert(!"unimplemented");    	return;
+	case Function: {
+	    assert(0 == get(exp, Function,code));
+	    oop prog2 = compileFunction(get(exp, Function,body));
+	    set(exp, Function,code, get(prog2, Array,elements));
+	    EMITio(iCLOSE, exp);
+	    return;
+	}
     }
 }
 
@@ -1758,7 +1963,7 @@ void replFile(char *name, FILE *file)
     while (input) {
 	if (yyparse() && yysval) {
 	    if (opt_v > 1) println(yysval);
-	    if (0*!opt_x) {
+	    if (!opt_x) {
 		oop result = nil;
 		if (opt_O) {
 		    oop program = compile(yysval);
@@ -1797,8 +2002,10 @@ int main(int argc, char **argv)
     Type_char = newType("char");
     Type_int  = newType("int");
 
-    define(intern("print"  ), newPrimitive(prim_print,   "print"  ), nil);
-    define(intern("memsize"), newPrimitive(prim_memsize, "memsize"), nil);
+    scopes = newArray();
+    Scope_begin();
+
+    definePrimitive(intern("printf"), prim_printf);
 
     int repls = 0;
 
@@ -1822,5 +2029,17 @@ int main(int argc, char **argv)
 
     if (!repls) replFile("stdin", stdin);
 
-    return 0;
+    oop args = newArray();
+    Array_append(args, newInteger(1));
+    Array_append(args, newStringWith("main"));
+
+    oop result = eval(newCall(intern("main"), args), nil);
+
+    if (!is(Integer, result)) {
+	printf("\n=> ");
+	println(result);
+	fatal("main did not return an integer");
+    }
+
+    return _integerValue(result);
 }