Implement quad names for variables

7 files changed, 152 insertions, 34 deletions

diff --git a/apl9.h b/apl9.h
index 8eb570f..f65e8f7 100644
--- a/apl9.h
+++ b/apl9.h
@@ -46,7 +46,7 @@ typedef struct Function Function;
 typedef struct Datum Datum;
 typedef struct Symbol Symbol;
 typedef struct Symtab Symtab;
-
+typedef struct QuadnameDef QuadnameDef;
 struct Array
 {
 	arrayDataType type;
@@ -110,11 +110,14 @@ struct Symbol
 	int undefined;
 	Rune *name;
 	Datum value;
+	Datum *(*getfn)(void);
+	int (*setfn)(Datum);
 };
 
 struct Symtab
 {
 	int nsyms;
+	int io; /* index origin */
 	Symbol **syms;
 };
 
@@ -123,9 +126,22 @@ typedef Array* (*fndyad)(Array*, Array*);
 typedef Array* (*opmonad)(Datum *, Array *, Array *);
 typedef Array* (*opdyad)(Datum *, Datum *, Array *, Array *);
 
+struct QuadnameDef
+{
+	Rune *name;
+	datumTag tag;
+	Datum *(*get)(void);
+	int (*set)(Datum);
+	fnmonad monadfn;
+	fnmonad dyadfn;
+	opmonad monadop;
+	opdyad dyadop;
+};
+
 /* Function prototypes for the different source files */
 /* main.c */
 Datum *evalline(Rune *);
+Rune *prompt(Rune *);
 
 /* print.c */
 Rune *ppdatum(Datum);
@@ -166,6 +182,9 @@ void incref(Array *);
 /* functions.c */
 Array *runfunc(Function, Array *,Array *);
 
+/* quadnames.c */
+Datum quadnamedatum(QuadnameDef);
+
 /* Monadic functions from function.c */
 Array *fnSame(Array *);
 Array *fnTally(Array *);
@@ -210,3 +229,4 @@ extern opdyad dyadoperatordefs[]; /* operators.c */
 extern Symtab *globalsymtab; /* symbol.c */
 extern Symtab *currentsymtab; /* symbol.c */
 extern int alloccounts; /* memory.c */
+extern QuadnameDef quadnames[]; /* quadnames.c */
diff --git a/eval.c b/eval.c
index 6b12245..3958a98 100644
--- a/eval.c
+++ b/eval.c
@@ -137,16 +137,22 @@ Datum *
 lookup(Datum var)
 {
 	traceprint("VAR LOOKUP %S\n", var.symbol->name);
+
 	if(var.symbol->undefined){
 		errormsg = runesmprint("Variable undefined: %S\n", var.symbol->name);
 		return nil;
-	}else{
-		Datum *val = &var.symbol->value;
-		val->shy = 0;
+	}
+
+	Datum *val;
+	if(var.symbol->getfn != nil)
+		val = var.symbol->getfn();
+	else{
+		val = &var.symbol->value;
 		if(val->tag == ArrayTag)
 			incref(val->array); /* since the value is now in the var AND in the code */
-		return val;
 	}
+	val->shy = 0;
+	return val;
 }
 
 Datum
@@ -215,17 +221,25 @@ nameis(Datum left, Datum right)
 Datum
 assign(Datum left, Datum right)
 {
-	if(left.symbol->undefined == 0)
-		freearray(left.symbol->value.array);
-
-	left.symbol->value = right;
-	left.symbol->undefined = 0;
-	if(left.symbol->value.tag == ArrayTag){
-		left.symbol->value.array->stranded = 0;
-		incref(right.array); /* for the binding */
-		incref(right.array); /* for the returned array */
+	if(left.symbol->setfn != nil){
+		int ok = left.symbol->setfn(right);
+		if(!ok){
+			print("Assignment failed\n");
+			exits(nil);
+		}
+	}else{
+		if(left.symbol->undefined == 0 && left.symbol->value.tag == ArrayTag)
+			freearray(left.symbol->value.array);
+		left.symbol->value = right;
+		left.symbol->undefined = 0;
+		if(left.symbol->value.tag == ArrayTag){
+			left.symbol->value.array->stranded = 0;
+			incref(right.array); /* for the binding */
+		}
 	}
 	right.shy = 1;
+	if(right.tag == ArrayTag)
+		incref(right.array); /* for the returned array */
 	return right;
 }
 
diff --git a/lexer.c b/lexer.c
index 4c9e8f2..d72cdd7 100644
--- a/lexer.c
+++ b/lexer.c
@@ -101,21 +101,36 @@ lexline(Rune *line)
 			stmt->toks[stmt->ntoks].tag = NameTag;
 			stmt->toks[stmt->ntoks].symbol = getsym(currentsymtab, name);
 			offset++;
-		}else if(isalpharune(line[offset]) || line[offset] == L'⎕'){
-			int quadname = L'⎕' == line[offset];
+		}else if(isalpharune(line[offset])){
 			Rune buf[64];
 			Rune *p = buf;
-			while(isalpharune(line[offset]) || (line[offset] == L'⎕' && p == buf)){
-				if(quadname)
-					*p = toupperrune(line[offset]);
-				else
-					*p = line[offset];
+			while(isalpharune(line[offset])){
+				*p = line[offset];
 				p++;
 				offset++;
 			}
 			*p = 0;
 			stmt->toks[stmt->ntoks].tag = NameTag;
 			stmt->toks[stmt->ntoks].symbol = getsym(currentsymtab, buf);
+		}else if(runestrchr(L"⎕⍞", line[offset])){
+			/* quad names */
+			Rune buf[64];
+			Rune *p = buf;
+			*p++ = line[offset++];
+			while(isalpharune(line[offset]))
+				*p++ = toupperrune(line[offset++]);
+			*p = 0;
+			int valid = 0;
+			for(int i = 0; quadnames[i].name != nil && !valid; i++){
+				if(runestrcmp(buf, quadnames[i].name) != 0)
+					continue;
+				valid = 1;
+				stmt->toks[stmt->ntoks] = quadnamedatum(quadnames[i]);
+			}
+			if(!valid){
+				offset -= runestrlen(buf);
+				goto syntax_error;
+			}
 		}else{
 syntax_error:
 			print("Can't lex: %S\n", &line[offset]);
diff --git a/main.c b/main.c
index 82c44f5..ef6e948 100644
--- a/main.c
+++ b/main.c
@@ -5,9 +5,6 @@
 
 #include "apl9.h"
 
-Rune *prompt(Rune *);
-Datum *evalline(Rune *);
-
 Biobuf *stdin;
 
 void
diff --git a/mkfile b/mkfile
index 4fdcccd..ac9967f 100644
--- a/mkfile
+++ b/mkfile
@@ -11,6 +11,7 @@ OFILES=\
 	symbol.$O\
 	memory.$O\
 	operators.$O\
+	quadnames.$O\
 
 HFILES=\
 	apl9.h\
diff --git a/quadnames.c b/quadnames.c
new file mode 100644
index 0000000..b765e58
--- /dev/null
+++ b/quadnames.c
@@ -0,0 +1,77 @@
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+
+#include "apl9.h"
+
+Datum *getquad(void);
+int setquad(Datum);
+Datum *getio(void);
+int setio(Datum);
+
+QuadnameDef quadnames[] = {
+	{L"⎕", NameTag, getquad, setquad, nil, nil},
+	{L"⎕IO", NameTag, getio, setio, nil, nil},
+	{nil, 0, nil, nil, nil, nil} /* MUST BE LAST */
+};
+
+Datum
+quadnamedatum(QuadnameDef q)
+{
+	Datum d;
+	d.tag = q.tag;
+	switch(q.tag){
+	case NameTag:
+		d.symbol = getsym(currentsymtab, q.name);
+		d.symbol->getfn = q.get;
+		d.symbol->setfn = q.set;
+		d.symbol->undefined = 0;
+		break;
+	case FunctionTag:
+	case MonadicOpTag:
+	case DyadicOpTag:
+	default:
+		print("Can't use quad names with type=%d\n", q.tag);
+		exits("quadname");
+	}
+	return d;
+}
+
+/* ⎕ */
+Datum *
+getquad(void)
+{
+	Rune *input = prompt(L"⎕:\n\t");
+	Datum *result = evalline(input);
+	/* TODO check that the expression doesn't fail */
+	return result;
+}
+
+int
+setquad(Datum new)
+{
+	print("%S\n", ppdatum(new));
+	return 1;
+}
+
+/* ⎕IO */
+Datum *
+getio(void)
+{
+	Datum *d = mallocz(sizeof(Datum), 1);
+	d->tag = ArrayTag;
+	d->array = mkscalarint(globalIO());
+	return d;
+}
+
+int
+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)){
+		print("⎕IO: domain error\n");
+		return 0;
+	}else{
+		currentsymtab->io = new.array->intdata[0];
+		return 1;
+	}
+}
\ No newline at end of file
diff --git a/symbol.c b/symbol.c
index 8bcaa13..938ab99 100644
--- a/symbol.c
+++ b/symbol.c
@@ -19,6 +19,8 @@ getsym(Symtab *tab, Rune *name)
 	tab->syms[tab->nsyms-1] = emalloc(sizeof(Symbol));
 	tab->syms[tab->nsyms-1]->name = runestrdup(name);
 	tab->syms[tab->nsyms-1]->undefined = 1;
+	tab->syms[tab->nsyms-1]->getfn = nil;
+	tab->syms[tab->nsyms-1]->setfn = nil;
 	return tab->syms[tab->nsyms-1];
 }
 
@@ -28,12 +30,7 @@ newsymtab(void)
 	Symtab *tab = emalloc(sizeof(Symtab));
 	tab->nsyms = 0;
 	tab->syms = nil;
-
-	Symbol *io = getsym(tab, L"⎕IO");
-	io->value.tag = ArrayTag;
-	io->value.array = mkscalarint(currentsymtab ? globalIO() : 1);
-	io->value.shy = 0;
-	io->undefined = 0;
+	tab->io = currentsymtab ? globalIO() : 1;
 
 	return tab;
 }
@@ -41,7 +38,6 @@ newsymtab(void)
 void
 freesymtab(Symtab *tab)
 {
-	print("Freeing symtab\n");
 	int i;
 	for(i = 0; i < tab->nsyms; i++){
 		Symbol *s = tab->syms[i];
@@ -50,12 +46,10 @@ freesymtab(Symtab *tab)
 	}
 	free(tab->syms);
 	free(tab);
-	print("Done freeing symtab\n");
 }
 
 vlong
 globalIO(void)
 {
-	Symbol *s = getsym(currentsymtab, L"⎕IO");
-	return s->value.array->intdata[0];
+	return currentsymtab->io;
 }
\ No newline at end of file