declare primitives as external functions

main.leg

@@ -1,6 +1,6 @@
 # main.leg -- C parser + interpreter
 #
-# Last edited: 2025-01-23 13:43:27 by piumarta on zora
+# Last edited: 2025-01-24 14:48:22 by piumarta on zora-1043.local
 
 %{
 ;
@@ -138,7 +138,7 @@ 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;  int variadic; };
-struct Primitive   { type_t _type;  oop name, type; prim_t function; };
+struct Primitive   { type_t _type;  oop name, type, parameters; prim_t function;  int variadic; };
 struct VarDecls	   { type_t _type;  oop type, declarations, variables; };
 
 union Object
@@ -754,13 +754,14 @@ oop newFunction(oop name, oop type, oop parameters, oop body)
     return obj;
 }
 
-oop newPrimitive(oop name, oop type, prim_t function)
+oop newPrimitive(oop name, oop type, oop parameters, prim_t function)
 {
     oop obj = new(Primitive);
-    obj->Primitive.name     = name;
-    obj->Primitive.type     = type;
-    obj->Primitive.function = function;
-
+    obj->Primitive.name       = name;
+    obj->Primitive.type       = type;
+    obj->Primitive.parameters = parameters;
+    obj->Primitive.function   = function;
+    obj->Primitive.variadic   = 0;
     return obj;
 }
 
@@ -1378,7 +1379,7 @@ include	= HASH INCLUDE (
 	  | '"' < [a-zA-Z0-9_.]* > '"' @{ pushInput(yytext, usrOpen(yytext)) }
 	  )
 
-tldecl	= fundefn | vardecl
+tldecl	= fundefn | primdef | vardecl
 
 vardecl	= t:tname d:inidecl		{ d = newVarDecls(t, d) }
 	  ( COMMA e:inidecl		{ VarDecls_append(d, e) }
@@ -1438,6 +1439,9 @@ funid	= STAR   d:funid		{ $$ = newTpointer(d) }
 	| LPAREN d:funid RPAREN		{ $$ = d }
 	| id
 
+primdef	= EXTERN t:tname d:funid
+	  p:params SEMI			{ $$ = newPrimitive(makeName(d), makeType(t, d), p, 0) }
+
 block	= LBRACE b:mkArray
 	  ( s:stmt			{ Array_append(b, s) }
 	  )* ( RBRACE			{ $$ = newBlock(b) }
@@ -1580,7 +1584,7 @@ idopt	= id | { $$ = nil }
 
 id	= !keyword < alpha alnum*  > -	{ $$ = intern(yytext) }
 
-keyword	= VOID | CHAR | INT | STRUCT
+keyword	= EXTERN | VOID | CHAR | INT | STRUCT
 	| IF | ELSE | WHILE | FOR | RETURN | CONTINU | BREAK
 
 alpha	= [a-zA-Z_]
@@ -1592,6 +1596,7 @@ comment = "//" < (![\n\r] .)* >
 	| "/*" (!"*/" .)* "*/"
 
 INCLUDE	= "include"  ![_a-zA-Z0-9] -
+EXTERN	= "extern"   ![_a-zA-Z0-9] -
 VOID	= "void"     ![_a-zA-Z0-9] -
 CHAR	= "char"     ![_a-zA-Z0-9] -
 INT	= "int"      ![_a-zA-Z0-9] -
@@ -1782,9 +1787,9 @@ void declareVariable(oop name, oop type, oop value)
     declare(name, newVariable(name, type, value));
 }
 
-void declarePrimitive(oop name, oop type, prim_t function)
+void declarePrimitive(oop name, oop type, oop parameters, prim_t function)
 {
-    declare(name, newPrimitive(name, type, function));
+    declare(name, newPrimitive(name, type, parameters, function));
 }
 
 oop incr(oop val, int amount)
@@ -2138,7 +2143,7 @@ oop preval(oop exp)
 	case Pair:		break;
 	case String:		break;
 	case Array:		break;
-	case Primitive:		break;
+	case Primitive:		return exp;
 	case Reference:		break;
 	case Closure:		break;
 	case Call:		break;
@@ -2184,6 +2189,13 @@ oop preval(oop exp)
 
 // primitive functions
 
+#define _do_primitives(_)			\
+    _(printf) _(assert)
+
+#define _(X) oop s_##X = 0;
+_do_primitives(_)
+#undef _
+
 oop prim_printf(int argc, oop *argv, oop env) // array
 {
     oop result = nil;
@@ -2867,7 +2879,35 @@ oop typeCheck(oop exp, oop fntype)
 	    return nil;
 	}
 	case Primitive: {
-	    return get(exp, Primitive,type);
+	    oop result     = get(exp, Primitive,type      );
+	    oop name       = get(exp, Primitive,name      );
+	    oop parameters = get(exp, Primitive,parameters);
+	    oop ptypes     = newArray();
+	    if (t_etc == Array_last(parameters)) {
+		Array_popLast(parameters);
+		set(exp, Primitive,variadic, 1);
+	    }
+	    Array_do(parameters, var) {
+		oop type = get(var, Variable,type);
+		if (t_void == type && (do_index || do_size > 1))
+		    fatal("illegal void parameter");
+		else {
+		    Array_append(ptypes, type);
+		}
+	    }
+	    if (1 == Array_size(ptypes) && Array_last(ptypes) == t_void) {
+		Array_popLast(ptypes);
+		Array_popLast(parameters);
+	    }
+	    assert(isNil(fntype));
+	    if (get(exp, Primitive,variadic)) Array_append(ptypes, t_etc);
+            fntype = newTfunction(result, ptypes);
+	    set(exp, Primitive,type, fntype);
+#         define _(X) if (s_##X == name) set(exp, Primitive,function, prim_##X);
+	    _do_primitives(_)
+#         undef _
+	    declare(name, exp);
+	    return nil;
 	}
 	case Function: {
 	    oop result     = get(exp, Function,type      );
@@ -2875,27 +2915,29 @@ oop typeCheck(oop exp, oop fntype)
 	    oop parameters = get(exp, Function,parameters);
 	    oop body       = get(exp, Function,body      );
 	    oop ptypes     = newArray();
+	    if (t_etc == Array_last(parameters)) {
+		Array_popLast(parameters);
+		set(exp, Function,variadic, 1);
+	    }
 	    Array_do(parameters, var) {
 		oop type = get(var, Variable,type);
 		if (t_void == type && (do_index || do_size > 1))
 		    fatal("illegal void parameter");
-		else if (t_etc == type) {
-		    if (do_index == 0 || do_index != do_size - 1)
-			fatal("illegal varargs parameter");
-		    set(exp, Function,variadic, 1);
+		else {
+		    Array_append(ptypes, type);
 		}
-		Array_append(ptypes, type);
 	    }
 	    if (1 == Array_size(ptypes) && Array_last(ptypes) == t_void) {
 		Array_popLast(ptypes);
 		Array_popLast(parameters);
 	    }
 	    assert(isNil(fntype));
-	    fntype = newTfunction(result, ptypes);
+	    if (get(exp, Function,variadic)) Array_append(ptypes, t_etc);
+            fntype = newTfunction(result, ptypes);
 	    set(exp, Function,type, fntype);
 	    declare(name, exp);	// add function to global scope so recursive calls will work
 	    Scope_begin();	// parameters
-	    Array_do(parameters, param)	declare(get(param, Variable,name), param);
+	    Array_do(parameters, param) declare(get(param, Variable,name), param);
 	    typeCheck(body, fntype); // block
 	    Scope_end();
 	    return nil;
@@ -3045,6 +3087,10 @@ int main(int argc, char **argv)
     true     = newInteger(1);
     s_etc    = newSymbol("...");
 
+# define _(X) s_##X = intern(#X);
+    _do_primitives(_);
+# undef _
+
     t_etc    = newTbase("...",   0, T_ETC);
     t_void   = newTbase("void",  1, T_VOID);
     t_char   = newTbase("char",  1, T_INT);
@@ -3056,13 +3102,17 @@ int main(int argc, char **argv)
 
     Scope_begin(); // the global scope
 
+#if 0
     declarePrimitive(intern("printf"),
 		     newTfunction(t_int, newArray2(t_string, t_etc)),
 		     prim_printf);
+#endif
 
+#if 0
     declarePrimitive(intern("assert"),
 		     newTfunction(t_void, newArray1(t_etc)),
 		     prim_assert);
+#endif
 
     int repls = 0;
 

stdio.h

@@ -1 +1 @@
-// here is stdio
+extern int printf(char *, ...);

test.txt

@@ -4,7 +4,10 @@
 
 int x = 21;
 
+int baz(int x, ...) { return 42; }
+
 int   foo(void) { return x + x; }
+
 char *bar(void) { return "bye bye"; }
 
 int main(int argc, char **argv)