Rework symbol lookup to use lexical scoping, and implement recursive function call via ∇

7 files changed, 166 insertions, 38 deletions

diff --git a/apl9.h b/apl9.h
index 78b5c11..7f194d0 100644
--- a/apl9.h
+++ b/apl9.h
@@ -67,6 +67,7 @@ typedef struct Symbol Symbol;
 typedef struct Symtab Symtab;
 typedef struct QuadnameDef QuadnameDef;
 typedef struct ErrorHandler ErrorHandler;
+typedef struct DfnFrame DfnFrame;
 
 struct Array
 {
@@ -178,6 +179,13 @@ struct ErrorHandler
 	jmp_buf jmp;
 };
 
+struct DfnFrame
+{
+	Rune *code;
+	Symtab *symtab;
+	DfnFrame *prev;
+};
+
 /* Function prototypes for the different source files */
 /* main.c */
 Datum *evalline(Rune *, int);
@@ -214,9 +222,15 @@ Array *fillelement(Array *);
 Datum *eval(Statement *, int);
 
 /* symbol.c */
-Symbol *getsym(Symtab *, Rune *);
-Symtab *newsymtab(void);
-void freesymtab(Symtab *);
+Symbol *getsym(Rune *);
+void initsymtab(void);
+DfnFrame *getcurrentdfn(void);
+DfnFrame *pushdfnframe(Rune *);
+void popdfnframe(void);
+vlong globalIO(void);
+void globalIOset(vlong);
+int globalDIV(void);
+void globalDIVset(int);
 
 /* memory.c */
 void *emalloc(ulong);
@@ -271,6 +285,7 @@ Array *fnShape(Array *);
 Array *fnReverseLast(Array *);
 Array *fnReverseFirst(Array *);
 Array *fnTranspose(Array *);
+Array *fnSelfRef1(Array *);
 
 /* Dyadic functions from function.c */
 Array *fnPlus(Array *, Array *);
@@ -300,6 +315,7 @@ Array *fnIndex(Array *, Array *);
 Array *fnCatenateLast(Array *, Array *);
 Array *fnCatenateFirst(Array *, Array *);
 Array *fnReshape(Array *, Array *);
+Array *fnSelfRef2(Array *, Array *);
 
 /* Monadic operators from operators.c */
 Array *opEach(Datum *, Array *, Array *);
@@ -332,10 +348,8 @@ extern opmonad monadoperatordefs[]; /* operators.c */
 extern opdyad dyadoperatordefs[]; /* operators.c */
 extern fndyad hybridfunctiondefs[]; /* hybrids.c */
 extern opmonad hybridoperatordefs[]; /* hybrids.c */
-extern Symtab *globalsymtab; /* symbol.c */
-extern Symtab *currentsymtab; /* symbol.c */
 extern int alloccounts; /* memory.c */
 extern QuadnameDef quadnames[]; /* quadnames.c */
 extern int printprecision; /* print.c */
 extern ErrorHandler globalerror; /* error.c */
-extern Rune *errorstrs[]; /* error.c */
\ No newline at end of file
+extern Rune *errorstrs[]; /* error.c */
diff --git a/functions.c b/functions.c
index bc4d96c..c8bff78 100644
--- a/functions.c
+++ b/functions.c
@@ -4,7 +4,7 @@
 
 #include "apl9.h"
 
-Rune primfuncnames[] = L"+-×÷*⍟⌹○!?|⌈⌊⊥⊤⊣⊢=≠≤<>≥≡≢∨∧⍲⍱↑↓⊂⊃⊆⌷⍋⍒⍳⍸∊⍷∪∩~,⍪⍴⌽⊖⍉⍎⍕";
+Rune primfuncnames[] = L"+-×÷*⍟⌹○!?|⌈⌊⊥⊤⊣⊢=≠≤<>≥≡≢∨∧⍲⍱↑↓⊂⊃⊆⌷⍋⍒⍳⍸∊⍷∪∩~,⍪⍴⌽⊖⍉⍎⍕∇";
 
 fnmonad monadfunctiondefs[] = {
 	fnSame, /* + */
@@ -59,6 +59,7 @@ fnmonad monadfunctiondefs[] = {
 	fnTranspose, /* ⍉ */
 	0, /* ⍎ */
 	0, /* ⍕ */
+	fnSelfRef1, /* ∇ */
 };
 
 fndyad dyadfunctiondefs[] = {
@@ -114,8 +115,11 @@ fndyad dyadfunctiondefs[] = {
 	0, /* ⍉ */
 	0, /* ⍎ */
 	0, /* ⍕ */
+	fnSelfRef2, /* ∇ */
 };
 
+DfnFrame *currentdfn; /* a stack of active dnf calls */
+
 vlong gcd_int(vlong, vlong);
 double gcd_float(double, double);
 
@@ -125,26 +129,23 @@ runfunc(Function f, Array *left, Array *right)
 {
 	Array *result;
 	if(f.type == FunctypeDfn){
-		Symtab *tmpsymtab = currentsymtab;
-		currentsymtab = newsymtab();
-
+		pushdfnframe(f.dfn);
 		if(left){
-			Symbol *alpha = getsym(currentsymtab, L"⍺");
+			Symbol *alpha = getsym(L"⍺");
 			alpha->value.tag = ArrayTag;
 			alpha->value.array = left;
 			alpha->undefined = 0;
 			incref(left);
 		}
 
-		Symbol *omega = getsym(currentsymtab, L"⍵");
+		Symbol *omega = getsym(L"⍵");
 		omega->value.tag = ArrayTag;
 		omega->value.array = right;
 		omega->undefined = 0;
 		incref(right);
 
 		Datum *dfnres = evalline(f.dfn, 0);
-		freesymtab(currentsymtab);
-		currentsymtab = tmpsymtab;
+		popdfnframe();
 		result = (*dfnres).array; /* TODO what if the evaluation failed */
 	}else if(f.type == FunctypePrim){
 		if(left){
@@ -496,12 +497,13 @@ fnGradeUp(Array *right)
 	int i,j;
 	int len = right->shape[0];
 	Array **elems = malloc(sizeof(Array *) * len);
-	Array *index = mkscalarint(currentsymtab->io);
+	Array *index = mkscalarint(globalIO());
 	Array *order = allocarray(AtypeInt, 1, len);
 	order->shape[0] = len;
 
+	vlong io = globalIO();
 	for(i = 0; i < len; i++, index->intdata[0]++){
-		order->intdata[i] = currentsymtab->io + i;
+		order->intdata[i] = io + i;
 		elems[i] = fnIndex(index, right);
 	}
 
@@ -541,7 +543,7 @@ fnIndexGenerator(Array *right)
 	vlong n = right->intdata[0];
 	Array *res = allocarray(AtypeInt, 1, n);
 	res->shape[0] = n;
-	vlong io = currentsymtab->io;
+	vlong io = globalIO();
 	for(vlong i = 0; i < n; i++)
 		res->intdata[i] = i + io;
 	return res;
@@ -692,6 +694,17 @@ fnTranspose(Array *right)
 	return res;
 }
 
+Array *
+fnSelfRef1(Array *right)
+{
+	if(currentdfn != nil)
+		return rundfn(currentdfn->code, nil, right);
+	else{
+		throwerror(nil, ESyntax);
+		return nil;
+	}
+}
+
 /* Dyadic functions */
 
 /* macro to define dyadic scalar functions */
@@ -747,7 +760,7 @@ SCALAR_FUNCTION_2(fnTimes, 0, left->type,
 SCALAR_FUNCTION_2(fnDivide, 1, left->type,
 	case AtypeFloat:
 		if(right->floatdata[i] == 0){
-			if(currentsymtab->div)
+			if(globalDIV())
 				res->floatdata[i] = 0;
 			else
 				throwerror(nil, EDomain);
@@ -994,7 +1007,7 @@ fnTake(Array *left, Array *right)
 Array *
 fnIndex(Array *left, Array *right)
 {
-	int io = currentsymtab->io;
+	int io = globalIO();
 	int i;
 
 	if(left->rank > 1)
@@ -1221,6 +1234,17 @@ fnReshape(Array *left, Array *right)
 	return res;
 }
 
+Array *
+fnSelfRef2(Array *left, Array *right)
+{
+	if(currentdfn != nil)
+		return rundfn(currentdfn->code, left, right);
+	else{
+		throwerror(nil, ESyntax);
+		return nil;
+	}
+}
+
 /* helper functions */
 vlong
 gcd_int(vlong a, vlong b)
diff --git a/hybrids.c b/hybrids.c
index 00977da..2ac2a91 100644
--- a/hybrids.c
+++ b/hybrids.c
@@ -61,7 +61,7 @@ opReduceFirst(Datum *lefto, Array *left, Array *right)
 		return fnSame(right);
 
 	int n = right->shape[0];
-	int io = currentsymtab->io;
+	int io = globalIO();
 	if(n == 0)
 		throwerror(L"Can't figure out identity element", ENotImplemented);
 
diff --git a/lexer.c b/lexer.c
index 3be2359..f56a623 100644
--- a/lexer.c
+++ b/lexer.c
@@ -131,7 +131,7 @@ get_digits:
 			Rune *name = L"?";
 			name[0] = line[offset];
 			stmt->toks[stmt->ntoks].tag = NameTag;
-			stmt->toks[stmt->ntoks].symbol = getsym(currentsymtab, name);
+			stmt->toks[stmt->ntoks].symbol = getsym(name);
 			offset++;
 		}else if(isalpharune(line[offset])){
 			Rune buf[64];
@@ -143,7 +143,7 @@ get_digits:
 			}
 			*p = 0;
 			stmt->toks[stmt->ntoks].tag = NameTag;
-			stmt->toks[stmt->ntoks].symbol = getsym(currentsymtab, buf);
+			stmt->toks[stmt->ntoks].symbol = getsym(buf);
 		}else if(runestrchr(L"⎕⍞", line[offset])){
 			/* quad names */
 			Rune buf[64];
diff --git a/main.c b/main.c
index 7551958..1397003 100644
--- a/main.c
+++ b/main.c
@@ -12,8 +12,7 @@ main(int argc, char *argv[])
 {
 	int off = 0;
 	stdin = Bfdopen(0, OREAD);
-	globalsymtab = newsymtab();
-	currentsymtab = globalsymtab;
+	initsymtab();
 	traceeval = 0;
 	debugmem = 0;
 
@@ -31,7 +30,10 @@ main(int argc, char *argv[])
 restart:
 	SETUPERROR(errorcode);
 	if(errorcode){
-		currentsymtab = globalsymtab;
+		/* remove aborted dfn frames */
+		while(getcurrentdfn())
+			popdfnframe();
+
 		if(globalerror.msg)
 			print("%S: %S\n", errorstrs[errorcode], globalerror.msg);
 		else
diff --git a/quadnames.c b/quadnames.c
index df98193..fa1b247 100644
--- a/quadnames.c
+++ b/quadnames.c
@@ -34,7 +34,7 @@ quadnamedatum(QuadnameDef q)
 	d.tag = q.tag;
 	switch(q.tag){
 	case NameTag:
-		d.symbol = getsym(currentsymtab, q.name);
+		d.symbol = getsym(q.name);
 		d.symbol->getfn = q.get;
 		d.symbol->setfn = q.set;
 		d.symbol->undefined = 0;
@@ -76,7 +76,7 @@ getio(void)
 {
 	Datum *d = mallocz(sizeof(Datum), 1);
 	d->tag = ArrayTag;
-	d->array = mkscalarint(currentsymtab->io);
+	d->array = mkscalarint(globalIO());
 	return d;
 }
 
@@ -86,7 +86,7 @@ setio(Datum new)
 	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1))
 		throwerror(nil, EDomain);
 	else
-		currentsymtab->io = new.array->intdata[0];
+		globalIOset(new.array->intdata[0]);
 }
 
 /* ⎕PP */
@@ -114,7 +114,7 @@ getdiv(void)
 {
 	Datum *d = mallocz(sizeof(Datum), 1);
 	d->tag = ArrayTag;
-	d->array = mkscalarint(currentsymtab->div);
+	d->array = mkscalarint(globalDIV());
 	return d;
 }
 
@@ -124,7 +124,7 @@ setdiv(Datum new)
 	if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1))
 		throwerror(nil, EDomain);
 	else
-		currentsymtab->div = new.array->intdata[0];
+		globalDIVset(new.array->intdata[0]);
 }
 
 /* ⎕RUN */
diff --git a/symbol.c b/symbol.c
index d51a730..e67f043 100644
--- a/symbol.c
+++ b/symbol.c
@@ -5,15 +5,29 @@
 #include "apl9.h"
 
 Symtab *globalsymtab;
-Symtab *currentsymtab;
+DfnFrame *currentdfn;
+
+Symtab *newsymtab(void);
+void freesymtab(Symtab *);
 
 Symbol *
-getsym(Symtab *tab, Rune *name)
+getsym(Rune *name)
 {
-	for(int i = 0; i < tab->nsyms; i++)
-		if(runestrcmp(tab->syms[i]->name, name) == 0)
-			return tab->syms[i];
-	
+	DfnFrame *dfn = currentdfn;
+	Symtab *tab;
+	do{
+		if(dfn != nil)
+			tab = dfn->symtab;
+		else
+			tab = globalsymtab;
+
+		for(int i = 0; i < tab->nsyms; i++)
+			if(runestrcmp(tab->syms[i]->name, name) == 0)
+				return tab->syms[i];
+		if(dfn)
+			dfn = dfn->prev;
+	}while(dfn != nil);
+
 	tab->nsyms++;
 	tab->syms = realloc(tab->syms, sizeof(Symbol *) * tab->nsyms);
 	tab->syms[tab->nsyms-1] = emalloc(sizeof(Symbol));
@@ -30,8 +44,8 @@ newsymtab(void)
 	Symtab *tab = emalloc(sizeof(Symtab));
 	tab->nsyms = 0;
 	tab->syms = nil;
-	tab->io = currentsymtab ? currentsymtab->io : 1;
-	tab->div = currentsymtab ? currentsymtab->div : 0;
+	tab->io = globalIO();
+	tab->div = globalDIV();
 
 	return tab;
 }
@@ -48,3 +62,77 @@ freesymtab(Symtab *tab)
 	free(tab->syms);
 	free(tab);
 }
+
+void
+initsymtab(void)
+{
+	globalsymtab = newsymtab();
+}
+
+DfnFrame *
+getcurrentdfn(void)
+{
+	return currentdfn;
+}
+
+DfnFrame *
+pushdfnframe(Rune *code)
+{
+	DfnFrame *new = malloc(sizeof(DfnFrame));
+	new->code = code;
+	new->symtab = newsymtab();
+	new->prev = currentdfn;
+	currentdfn = new;
+	return new;
+}
+
+void
+popdfnframe(void)
+{
+	if(currentdfn != nil){
+		DfnFrame *prev = currentdfn->prev;
+		freesymtab(currentdfn->symtab);
+		free(currentdfn);
+		currentdfn = prev;
+	}
+}
+
+vlong
+globalIO(void)
+{
+	if(currentdfn)
+		return currentdfn->symtab->io;
+	else if(globalsymtab)
+		return globalsymtab->io;
+	else
+		return 1;
+}
+
+void
+globalIOset(vlong io)
+{
+	if(currentdfn)
+		currentdfn->symtab->io = io;
+	else
+		globalsymtab->io = io;
+}
+
+int
+globalDIV(void)
+{
+	if(currentdfn)
+		return currentdfn->symtab->div;
+	else if(globalsymtab)
+		return globalsymtab->div;
+	else
+		return 0;
+}
+
+void
+globalDIVset(int div)
+{
+	if(currentdfn)
+		currentdfn->symtab->div = div;
+	else
+		globalsymtab->div = div;
+}
\ No newline at end of file