From d152639e4495089cabbbf7a16e5bc5129af78bfa Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Wed, 12 Jan 2022 19:42:14 +0000
Subject: Add dfn parsing, but not evaluation yet

---
 apl9.h  | 11 ++++++---
 eval.c  | 79 +++++++++++++++++++++++++++++++++--------------------------------
 lexer.c | 29 +++++++++++++++++-------
 mkfile  |  2 +-
 print.c | 16 +++++++++----
 5 files changed, 82 insertions(+), 55 deletions(-)

diff --git a/apl9.h b/apl9.h
index 30c5897..f30c6e8 100644
--- a/apl9.h
+++ b/apl9.h
@@ -12,8 +12,6 @@ typedef enum
 	BoundFunctionTag, /* Function with left arg bound */
 	LParTag,
 	RParTag,
-	LCurlTag,
-	RCurlTag,
 	LBracketTag,
 	RBracketTag,
 	ArrowTag,
@@ -27,6 +25,12 @@ typedef enum
 	AtypeArray,
 } arrayDataType;
 
+typedef enum
+{
+	FunctypeDfn,
+	FunctypePrim,
+} functionType;
+
 /* Data types */
 typedef struct Array Array;
 typedef struct Statement Statement;
@@ -58,9 +62,10 @@ struct Statement
 
 struct Function
 {
+	functionType type;
 	union {
 		int code;
-		Statement *dfn;
+		Rune *dfn;
 	};
 	Array *left;
 };
diff --git a/eval.c b/eval.c
index afca940..4d0d497 100644
--- a/eval.c
+++ b/eval.c
@@ -20,42 +20,38 @@ Datum nameis(Datum, Datum);
 Datum assign(Datum, Datum);
 Datum *lookup(Datum);
 
-int bindingstrengths[15][15] = {
-/*	A  F  H  MO DO AF (  )  {  }  [  ]  ←  IS N */
-	4, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
-	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
-	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
-	5, 5, 5, 5, 5, 5, 0, 6, 5, 5, 5, 5, 5, 5, 5, /* ( */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* { */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* } */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
-	1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, /* N */
+int bindingstrengths[13][13] = {
+/*	A  F  H  MO DO AF (  )  [  ]  ←  IS N */
+	4, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
+	5, 5, 5, 5, 5, 5, 0, 6, 5, 5, 5, 5, 5, /* ( */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
+	1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, /* N */
 };
 
-evalfn evalfns[15][15] = {
-/*	A  F  H  MO DO AF (  )  {  }  [  ] ← IS N */
-	strand, dyadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
-	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
-	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
-	lpar, lpar, lpar, lpar, lpar, 0, lpar, rpar, lpar, lpar, lpar, lpar, lpar, lpar, lpar, /* ( */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* { */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* } */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
-	assign, assign, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
-	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, nameis, 0, 0, /* N */	
+evalfn evalfns[13][13] = {
+/*	A  F  H  MO DO AF (  )  [  ] ← IS N */
+	strand, dyadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	monadfun, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* AF */
+	lpar, lpar, lpar, lpar, lpar, 0, lpar, rpar,  lpar, lpar, lpar, lpar, lpar, /* ( */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ← */
+	assign, assign, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* IS */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, nameis, 0, 0, /* N */	
 };
 
 Datum *
@@ -155,11 +151,16 @@ monadfun(Datum left, Datum right)
 	Datum result;
 	result.tag = ArrayTag;
 
-	/* TODO handle undefined functions here */
-	if(left.func.left)
-		result.array = dyadfunctiondefs[left.func.code](left.func.left, right.array);
-	else
-		result.array = monadfunctiondefs[left.func.code](right.array);
+	if(left.func.type == FunctypeDfn){
+		print("Can't evaluate dfns yet: %S %S\n", ppdatum(left), ppdatum(right));
+		exits(nil);
+	}else{
+		/* TODO handle undefined functions here */
+		if(left.func.left)
+			result.array = dyadfunctiondefs[left.func.code](left.func.left, right.array);
+		else
+			result.array = monadfunctiondefs[left.func.code](right.array);
+	}
 	return result;
 }
 
diff --git a/lexer.c b/lexer.c
index 36000c8..eb5a3c4 100644
--- a/lexer.c
+++ b/lexer.c
@@ -23,24 +23,36 @@ lexline(Rune *line, Symtab *symtab)
 		if(isspacerune(line[offset])){
 			offset++;
 			continue;
-		}else if(runestrchr(L"(){}[]←⋄⍝", line[offset])){
+		}else if(runestrchr(L"()[]←⋄⍝", line[offset])){
 			switch(line[offset]){
 			case '(': stmt->toks[stmt->ntoks].tag = LParTag; break;
 			case ')': stmt->toks[stmt->ntoks].tag = RParTag; break;
-			case '{': stmt->toks[stmt->ntoks].tag = LCurlTag; break;
-			case '}': stmt->toks[stmt->ntoks].tag = RCurlTag; break;
 			case '[': stmt->toks[stmt->ntoks].tag = LBracketTag; break;
 			case ']': stmt->toks[stmt->ntoks].tag = RBracketTag; break;
 			case L'←': stmt->toks[stmt->ntoks].tag = ArrowTag; break;
-			case L'⋄':
-				stmt->next = lexline(&line[offset+1], symtab);
-				goto end;
-			case L'⍝':
-				goto end;
+			case L'⋄': stmt->next = lexline(&line[offset+1], symtab); goto end;
+			case L'⍝': goto end;
 			}
 			offset++;
+		}else if(line[offset] == L'{'){
+			Rune buf[MAX_LINE_LENGTH];
+			Rune *p = buf;
+			offset++;
+			while(line[offset] != L'}' && offset < len){
+				*p = line[offset];
+				p++;
+				offset++;
+			}
+			if(line[offset] != L'}')
+				goto syntax_error;
+			*p = 0;
+			offset++;
+			stmt->toks[stmt->ntoks].tag = FunctionTag;
+			stmt->toks[stmt->ntoks].func.type = FunctypeDfn;
+			stmt->toks[stmt->ntoks].func.dfn = runestrdup(buf);
 		}else if(p = runestrchr(primfuncnames, line[offset])){
 			stmt->toks[stmt->ntoks].tag = FunctionTag;
+			stmt->toks[stmt->ntoks].func.type = FunctypePrim;
 			stmt->toks[stmt->ntoks].func.code = p-primfuncnames;
 			offset++;
 		}else if(p = runestrchr(primmonopnames, line[offset])){
@@ -77,6 +89,7 @@ lexline(Rune *line, Symtab *symtab)
 			stmt->toks[stmt->ntoks].tag = NameTag;
 			stmt->toks[stmt->ntoks].symbol = getsym(symtab, buf);
 		}else{
+syntax_error:
 			print("Can't lex: %S\n", &line[offset]);
 			free(stmt->toks);
 			free(stmt);
diff --git a/mkfile b/mkfile
index c5e87f7..2b9dafe 100644
--- a/mkfile
+++ b/mkfile
@@ -1,6 +1,6 @@
 </$objtype/mkfile
 
-TARG=apl9
+TARG=apl
 OFILES=\
 	main.$O\
 	lexer.$O\
diff --git a/print.c b/print.c
index 588ce0a..1d0856d 100644
--- a/print.c
+++ b/print.c
@@ -10,15 +10,23 @@ ppdatum(Datum d)
 	Rune *result;
 	switch(d.tag){
 	case ArrayTag: result = pparray(d.array); break;
-	case FunctionTag: result = runesmprint("%C", primfuncnames[d.func.code]); break;
+	case FunctionTag:
+		if(d.func.type == FunctypePrim)
+			result = runesmprint("%C", primdyadopnames[d.func.code]);
+		else
+			result = runesmprint("{%S}", d.func.dfn);
+		break;
 	case HybridTag: result = runesmprint("%C", primhybridnames[d.func.code]); break;
 	case MonadicOpTag: result = runesmprint("%C", primmonopnames[d.func.code]); break;
 	case DyadicOpTag: result = runesmprint("%C", primdyadopnames[d.func.code]); break;
-	case BoundFunctionTag: result = runesmprint("%S∘%C", pparray(d.func.left), primfuncnames[d.func.code]); break;
+	case BoundFunctionTag:
+		if(d.func.type == FunctypePrim)
+			result = runesmprint("%S∘%C", pparray(d.func.left), primdyadopnames[d.func.code]);
+		else
+			result = runesmprint("%S∘{%S}", pparray(d.func.left), d.func.dfn);
+		break;
 	case LParTag: result = runestrdup(L"("); break;
 	case RParTag: result = runestrdup(L")"); break;
-	case LCurlTag: result = runestrdup(L"{"); break;
-	case RCurlTag: result = runestrdup(L"}"); break;
 	case LBracketTag: result = runestrdup(L"["); break;
 	case RBracketTag: result = runestrdup(L"]"); break;
 	case ArrowTag: result = runestrdup(L"←"); break;
-- 
cgit v1.2.3