allow multiple identical declarations; function parmeters are arrays of variables not vardecls

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 <stdarg.h>
 #include <errno.h>
 
+#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;
 }