From 85aa2ad424c68343ef09e5f6df243ad6499e47d5 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <petermikkelsen10@gmail.com>
Date: Wed, 12 Jan 2022 00:09:12 +0000
Subject: =?UTF-8?q?Add=20a=20small=20version=20of=20monadic=20=E2=8D=B3=20?=
 =?UTF-8?q?and=20some=20simple=20form=20of=20=E2=8E=95IO?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 apl9.h      |  5 ++++-
 functions.c | 15 ++++++++++++++-
 lexer.c     | 10 +++++++---
 main.c      |  1 +
 symbol.c    | 14 ++++++++++++++
 5 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/apl9.h b/apl9.h
index 413c52c..620eae6 100644
--- a/apl9.h
+++ b/apl9.h
@@ -113,12 +113,14 @@ Datum *eval(Datum *, int *);
 /* symbol.c */
 Symbol *getsym(Symtab *, Rune *);
 Symtab *newsymtab(void);
+vlong globalIO(void);
 
 /* Monadic functions from functions.h */
 Array *fnSame(Array *);
 Array *fnTally(Array *);
 Array *fnEnclose(Array *);
 Array *fnNest(Array *);
+Array *fnIndexGenerator(Array *);
 Array *fnRavel(Array *);
 Array *fnShape(Array *);
 
@@ -138,4 +140,5 @@ extern Rune primdyadopnames[]; /* lexer.c */
 extern Rune primhybridnames[]; /* lexer.c */
 extern fnmonad monadfunctiondefs[]; /* function.c */
 extern fndyad dyadfunctiondefs[]; /* function.c */
-extern Symtab *globalsymtab; /* symbol.c */
\ No newline at end of file
+extern Symtab *globalsymtab; /* symbol.c */
+extern Symtab *currentsymtab; /* symbol.c */
\ No newline at end of file
diff --git a/functions.c b/functions.c
index cf5402a..4d9a69f 100644
--- a/functions.c
+++ b/functions.c
@@ -44,7 +44,7 @@ fnmonad monadfunctiondefs[] = {
 	0, /* ⌷ */
 	0, /* ⍋ */
 	0, /* ⍒ */
-	0, /* ⍳ */
+	fnIndexGenerator, /* ⍳ */
 	0, /* ⍸ */
 	0, /* ∊ */
 	0, /* ⍷ */
@@ -142,6 +142,19 @@ fnEnclose(Array *right)
 	}
 }
 
+Array *
+fnIndexGenerator(Array *right)
+{
+	/* TODO only works for creating vectors */
+	vlong n = right->intdata[0];
+	Array *res = mkarray(AtypeInt, 1, n);
+	res->shape[0] = n;
+	vlong io = globalIO();
+	for(vlong i = 0; i < n; i++)
+		res->intdata[i] = i + io;
+	return res;
+}
+
 Array *
 fnNest(Array *right)
 {
diff --git a/lexer.c b/lexer.c
index bc5aa50..a7557c2 100644
--- a/lexer.c
+++ b/lexer.c
@@ -53,11 +53,15 @@ lexline(Rune *line, int *ntoks, Symtab *symtab)
 			*p = 0;
 			tokens[*ntoks].tag = ArrayTag;
 			tokens[*ntoks].array = mkscalarint(atoll(buf));
-		}else if(isalpharune(line[offset])){
+		}else if(isalpharune(line[offset]) || line[offset] == L'⎕'){
+			int quadname = L'⎕' == line[offset];
 			Rune buf[64];
 			Rune *p = buf;
-			while(isalpharune(line[offset])){
-				*p = line[offset];
+			while(isalpharune(line[offset]) || (line[offset] == L'⎕' && p == buf)){
+				if(quadname)
+					*p = toupperrune(line[offset]);
+				else
+					*p = line[offset];
 				p++;
 				offset++;
 			}
diff --git a/main.c b/main.c
index c5679a3..378f840 100644
--- a/main.c
+++ b/main.c
@@ -15,6 +15,7 @@ main(int argc, char *argv[])
 	int off = 0;
 	stdin = Bfdopen(0, OREAD);
 	globalsymtab = newsymtab();
+	currentsymtab = globalsymtab;
 	traceeval = 0;
 
 	ARGBEGIN{
diff --git a/symbol.c b/symbol.c
index a9d1d1f..6cdbffe 100644
--- a/symbol.c
+++ b/symbol.c
@@ -5,6 +5,7 @@
 #include "apl9.h"
 
 Symtab *globalsymtab;
+Symtab *currentsymtab;
 
 Symbol *
 getsym(Symtab *tab, Rune *name)
@@ -27,5 +28,18 @@ newsymtab(void)
 	Symtab *tab = malloc(sizeof(Symtab));
 	tab->nsyms = 0;
 	tab->syms = nil;
+
+	Symbol *io = getsym(tab, L"⎕IO");
+	io->value.tag = ArrayTag;
+	io->value.array = mkscalarint(1);
+	io->undefined = 0;
+
 	return tab;
+}
+
+vlong
+globalIO(void)
+{
+	Symbol *s = getsym(currentsymtab, L"⎕IO");
+	return s->value.array->intdata[0];
 }
\ No newline at end of file
-- 
cgit v1.2.3