From: Michael D. Lowis <mike@mdlowis.com>
Date: Sat, 3 Dec 2022 02:35:38 +0000 (-0500)
Subject: added function forwarding and externing. Works, but lacks type checking
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=9dbd1b79e1c2e2bdca9c3095c640ab49ed8d5755;p=proto%2Fobnc.git

added function forwarding and externing. Works, but lacks type checking
---

diff --git a/cerise/inc/cerise.h b/cerise/inc/cerise.h
index f132ae4..d4cfc78 100644
--- a/cerise/inc/cerise.h
+++ b/cerise/inc/cerise.h
@@ -33,7 +33,9 @@ typedef enum {
     ELSE,
     ELSIF,
     END,
+    EXTERN,
     FOR,
+    FORWARD,
     IF,
     IMPORT,
     IS,
@@ -209,6 +211,7 @@ typedef struct Symbol {
     size_t module;
     int export : 1;
     int global : 1;
+    int forward : 1;
 } Symbol;
 
 typedef struct {
@@ -263,6 +266,7 @@ int consume(Parser* p);
 Type* symbol_newtype(Parser* p);
 Symbol* symbol_new(Parser* p, size_t scope, char* name, int class, bool export);
 Symbol* symbol_get(Parser* p, size_t module, char* name, int class);
+Symbol* symbol_find(Parser* p, size_t module, char* name, int class);
 size_t symbol_getid(Parser* p, size_t module, char* name, int class);
 Symbol* symbol_getbyid(Parser* p, size_t id);
 size_t symbol_openscope(Parser* p);
diff --git a/cerise/src/grammar.c b/cerise/src/grammar.c
index 33f7c05..df41d19 100644
--- a/cerise/src/grammar.c
+++ b/cerise/src/grammar.c
@@ -66,7 +66,9 @@ static SsaNode* qualident(Parser* p)
     {
         expect(p, '.');
         char* name = expect_text(p, IDENT);
-        symid = symbol_getid(p, symid, name, -1);
+        size_t qsymid = symbol_getid(p, symid, name, -1);
+        printf("%ld.%ld\n", symid, qsymid);
+        symid=qsymid;
     }
 
     /* make the identifier with the final index */
@@ -526,14 +528,21 @@ static void const_decl(Parser* p)
     EXIT_RULE();
 }
 
-void proc_decl(Parser* p)
+Symbol* proc_type(Parser* p)
 {
-    ENTER_RULE();
-
     expect(p, PROCEDURE);
     char* name = expect_text(p, IDENT);
     bool export = accept(p, '*');
-    Symbol* proc = symbol_new(p, 0, name, SYM_PROC, export);
+    Symbol* proc = symbol_find(p, 0, name, SYM_PROC);
+    if (!proc)
+    {
+        proc = symbol_new(p, 0, name, SYM_PROC, export);
+    }
+    else if (!proc->forward)
+    {
+        error(p, "procedure '%s' multiply defined in scope", name);
+    }
+
     Type* proctype = symbol_newtype(p);
     proctype->form = FORM_PROC;
     proc->type = proctype;
@@ -556,24 +565,18 @@ void proc_decl(Parser* p)
     }
     expect(p, ')');
     proctype->base = (accept(p, ':') ? type(p) : &VoidType);
-    codegen_symbol(p, proc);
-
-    /* parse the private declarations */
-    if (accept(p, CONST))
-    {
-        const_decl(p);
-    }
 
-    if (accept(p, TYPE))
+    if (proc->forward)
     {
-        type_decl(p);
-    }
-
-    if (accept(p, VAR))
-    {
-        var_decl(p);
+        // check the type here
+        proc->forward = 0;
     }
+    codegen_symbol(p, proc);
+    return proc;
+}
 
+void proc_body(Parser* p, Type* proctype)
+{
     expect(p, BEGIN);
     SsaBlock* block = ssa_block(p);
     p->curr_join = ssa_block(p);
@@ -593,6 +596,38 @@ void proc_decl(Parser* p)
     }
     expect(p, END);
     codegen_block(p, block);
+}
+
+void proc_decl(Parser* p)
+{
+    ENTER_RULE();
+
+    Symbol* proc = proc_type(p);
+
+    /* parse the private declarations */
+    if (accept(p, CONST))
+    {
+        const_decl(p);
+    }
+
+    if (accept(p, TYPE))
+    {
+        type_decl(p);
+    }
+
+    if (accept(p, VAR))
+    {
+        var_decl(p);
+    }
+
+    if (accept(p, FORWARD))
+    {
+        proc->forward = 1;
+    }
+    else if (!accept(p, EXTERN))
+    {
+        proc_body(p, proc->type);
+    }
 
     EXIT_RULE();
 }
@@ -734,6 +769,7 @@ static void import(Parser* curr, char* modname, char* alias)
         if (p.syms[i].export)
         {
             Symbol* sym = symbol_new(curr, 0, p.syms[i].name, p.syms[i].class, 0);
+            *sym = p.syms[i];
             sym->module = modid;
         }
     }
diff --git a/cerise/src/lex.c b/cerise/src/lex.c
index 72e87d5..7febbeb 100644
--- a/cerise/src/lex.c
+++ b/cerise/src/lex.c
@@ -72,8 +72,10 @@ KeywordDef Keywords[] = {
     { "else",      ELSE      },
     { "elsif",     ELSIF     },
     { "end",       END       },
+    { "extern",    EXTERN    },
     { "false",     BOOL      },
     { "for",       FOR       },
+    { "forward",   FORWARD   },
     { "if",        IF        },
     { "import",    IMPORT    },
     { "is",        IS        },
diff --git a/cerise/src/sym.c b/cerise/src/sym.c
index 5bb73f6..72dd6fe 100644
--- a/cerise/src/sym.c
+++ b/cerise/src/sym.c
@@ -109,6 +109,17 @@ Symbol* symbol_get(Parser* p, size_t module, char* name, int class)
     return symbol_getbyid(p, id);
 }
 
+Symbol* symbol_find(Parser* p, size_t module, char* name, int class)
+{
+    Symbol* sym = NULL;
+    size_t index = lookup(p, 0, module, name, class);
+    if (NIL_SYMBOL != index)
+    {
+        sym = symbol_getbyid(p, index);
+    }
+    return sym;
+}
+
 size_t symbol_getid(Parser* p, size_t module, char* name, int class)
 {
     size_t index = lookup(p, 0, module, name, class);
diff --git a/cerise/tests/A.m b/cerise/tests/A.m
index d57ca9c..1928398 100644
--- a/cerise/tests/A.m
+++ b/cerise/tests/A.m
@@ -1,2 +1,10 @@
 const
-  FOO* = 42
\ No newline at end of file
+  FOO* = 42
+
+procedure Foo*()
+forward
+
+procedure Foo*() : Int
+begin
+    return 0;
+end
\ No newline at end of file
diff --git a/cerise/tests/Module.m b/cerise/tests/Module.m
index b491d90..31c5466 100644
--- a/cerise/tests/Module.m
+++ b/cerise/tests/Module.m
@@ -1,8 +1,8 @@
 import
     A
 
-const
-  FOO* = 42
+#const
+#  FOO* = 42
 
 type
   FooRec* = record
@@ -17,7 +17,7 @@ var
   vBool* : Bool
   vInt* : Int
   vReal : Real
-  vIntArray : array 42 of Int
+  vIntArray : array A.FOO of Int
   vIntArray2 : array 5 of array 5 of Int
   vRec1 : FooRec
   vRec2 : record
@@ -198,6 +198,7 @@ begin
     vInt = Sum(1,2);
 end
 
-#begin
-#    TestReturnVoid();
-#end
+begin
+    TestReturnVoid();
+    A.Foo();
+end