shithub: lpa

Info  •  Files  •  Log  •  Branches

More general work

--- a/array.c

+++ b/array.c

@@ -151,6 +151,75 @@

 	return buf;

 }

+static int

+printexpr(char *start, Ast *e, int left)

+{

+	if(e == nil)

+		return sprint(start, "{?nil?}");

+

+	char *p = start;

+	int paren = 0;

+	if(left){

+		switch(e->tag){

+		case AstAssign:

+		case AstMonadic:

+		case AstDyadic:

+		case AstStrand:

+			p += sprint(p, "(");

+			paren = 1;

+			break;

+		}

+	}

+

+	switch(e->tag){

+	case AstName:

+		if(left)

+			p += sprint(p, " ");

+		p += sprint(p, "%s", e->name);

+		if(left)

+			p += sprint(p, " ");

+		break;

+	case AstAssign:

+		p += printexpr(p, e->left, 0);

+		p += sprint(p, "←");

+		p += printexpr(p, e->right, 0);

+		break;

+	case AstMonadic:

+		p += printexpr(p, e->func, 1);

+		p += printexpr(p, e->right, 0);

+		break;

+	case AstDyadic:

+		p += printexpr(p, e->left, 1);

+		p += printexpr(p, e->func, 1);

+		p += printexpr(p, e->right, 0);

+		break;

+	case AstConst:

+		p += printarraysub(p, e->val, 0);

+		break;

+	case AstPrim:

+		p += sprint(p, "%s", primsymb(e->prim));

+		break;

+	case AstStrand:

+		for(uvlong i = 0; i < e->childcount; i++){

+			if(i != 0)

+				p += sprint(p, " ");

+			p += printexpr(p, e->children[i], 1);

+		}

+		break;

+	case AstLater:

+		p += sprint(p, "{later..}");

+		break;

+	default:

+		p += sprint(p, "{expr %d}", e->tag);

+		break;

+	}

+

+	if(paren)

+		p += sprint(p, ")");

+

+	return p - start;

+}

+

 char *

 printfunc(Function *f) /* Doesn't really belong here.. */

 {

@@ -167,6 +236,10 @@

 		p += sprint(p, " %s", f->ast->funcrightarg->name);

 	for(uvlong i = 0; i < f->ast->funclocals->childcount; i++)

 		p += sprint(p, ";%s", f->ast->funclocals->children[i]->name);

+	for(uvlong i = 0; i < f->ast->childcount; i++){

+		p += sprint(p, "\n ");

+		p += printexpr(p, f->ast->children[i], 0);

+	}

 	sprint(p, "\n∇");

 	return buf;

 }

--- a/dat.h

+++ b/dat.h

@@ -101,12 +101,6 @@

 	void **items;

 };

-enum Primitive

-{

-	PrimPlus,

-	PrimMinus,

-};

-

 enum TokenTag

 {

 	TokNumber,

--- a/eval.c

+++ b/eval.c

@@ -105,6 +105,11 @@

 		emitbyte(c, ILookup);

 		emituvlong(c, sym(m->symtab, a->name));

 		break;

+	case AstAssign:

+		codegensub(s, m, c, a->right);

+		emitbyte(c, IAssign);

+		emituvlong(c, sym(m->symtab, a->left->name));

+		break;

 	case AstConst:

 		emitbyte(c, IPushConst);

 		emitptr(c, a->val); /* TODO: better to have consts array and emit index? */

@@ -262,11 +267,21 @@

 			}

 			break;

 		case IMonadic:

-			appendlog(s, "NOTE: monadic call acts like ⊢\n");

+			{

+				Function *f = popval(values);

+				Array *y = popval(values);

+				Array *z = primmonad(f->prim, y);

+				pushval(values, z);

+			}

 			break;

 		case IDyadic:

-			appendlog(s, "NOTE: dyadic call acts like ⊢\n");

-			popval(values);

+			{

+				Function *f = popval(values);

+				Array *x = popval(values);

+				Array *y = popval(values);

+				Array *z = primdyad(f->prim, x, y);

+				pushval(values, z);

+			}

 			break;

 		case ICall:

 			func = popval(values);

--- a/fns.h

+++ b/fns.h

@@ -28,6 +28,13 @@

 /* parse.c */

 Ast *parse(TokenList *, Symtab *, char **);

+/* prim.c */

+char *primsymb(int);

+int primclass(int);

+int primid(char *);

+Array *primmonad(int, Array *);

+Array *primdyad(int, Array *, Array *);

+

 /* scan.c */

 TokenList *scan(char *, char **);

--- a/mkfile

+++ b/mkfile

@@ -10,6 +10,7 @@

 	memory.$O\

 	module.$O\

 	parse.$O\

+	prim.$O\

 	scan.$O\

 	session.$O\

 	symtab.$O\

--- a/parse.c

+++ b/parse.c

@@ -141,10 +141,10 @@

 			break;

 		/* more cases here in the future */

 		}

-	}else{

-		/* TODO: Check if the name exist in the locallist */

-		class = NameclassUndef;

 	}

+

+	/* TODO: Check if the name exist in the locallist */

+

 	return class;

 }

@@ -265,10 +265,14 @@

 		if(t->tokens[i].tag != TokName)

 			continue;

+		if((i+1) < end && t->tokens[i+1].tag == TokLarrow)

+			continue; /* assignment */

+

 		name = t->tokens[i].name;

 		class = nameclass(name, symtab, func);

 		t->tokens[i].nameclass = class;

 		if(class == 0){ /* We don't know how to parse it until runtime */

+			print("nameclass 0 name: %s funcname: %s\n", name, func ? func->funcname->name : "<no func>");

 			if(symtab)

 				error(t, "could not resolve nameclasses");

--- /dev/null

+++ b/prim.c

@@ -1,0 +1,92 @@

+#include <u.h>

+#include <libc.h>

+#include <thread.h>

+

+#include "dat.h"

+#include "fns.h"

+

+/* NOTE: In LPA, system functions are treated as primitives as well */

+

+/* monadic functions */

+static Array *primfn_same(Array *);

+

+/* dyadic functions */

+static Array *primfn_left(Array *, Array *);

+static Array *primfn_right(Array *, Array *);

+

+struct {

+	char *spelling;

+	int nameclass;

+	Array *(*monad)(Array *);

+	Array *(*dyad)(Array *, Array *);

+} primspecs[] = {

+	"⊢", NameclassFunc, primfn_same, primfn_right,

+	"⊣", NameclassFunc, primfn_same, primfn_left,

+	"+", NameclassFunc, nil, nil,

+	"-", NameclassFunc, nil, nil,

+};

+

+char *

+primsymb(int id)

+{

+	return primspecs[id].spelling;

+}

+

+int

+primclass(int id)

+{

+	return primspecs[id].nameclass;

+}

+

+int

+primid(char *s)

+{

+	for(int i = 0; i < nelem(primspecs); i++){

+		char *x = primspecs[i].spelling;

+		if(strncmp(s, x, strlen(x)) == 0)

+			return i;

+	}

+	return -1;

+}

+

+Array *

+primmonad(int id, Array *y)

+{

+	if(primspecs[id].monad)

+		return primspecs[id].monad(y);

+	else{

+		print("primitive %s has no monadic definition! (acts like ⊢)\n", primsymb(id));

+		return y;

+	}

+}

+

+Array *

+primdyad(int id, Array *x, Array *y)

+{

+	if(primspecs[id].dyad)

+		return primspecs[id].dyad(x, y);

+	else{

+		print("primitive %s has no dyadic definition! (acts like ⊣)\n", primsymb(id));

+		return x;

+	}

+}

+

+/* monadic functions */

+static Array *

+primfn_same(Array *a)

+{

+	return a;

+}

+

+/* dyadic functions */

+static Array *

+primfn_left(Array *x, Array *)

+{

+	return x;

+}

+

+static Array *

+primfn_right(Array *, Array *y)

+{

+	return y;

+}

\ No newline at end of file

--- a/scan.c

+++ b/scan.c

@@ -5,14 +5,6 @@

 #include "dat.h"

 #include "fns.h"

-struct {

-	Rune spelling;

-	int id;

-} primspecs[] = {

-	L'+', PrimPlus,

-	L'-', PrimMinus,

-};

-

 Token *

 newtok(TokenList *tokens, int tag)

 {

@@ -30,7 +22,7 @@

 scan(char *buf, char **errp)

 {

 	Rune r;

-	int n;

+	int n, id;

 	TokenList *tokens = alloc(DataTokenList);

 	Token *tok;

 	char *cp = buf;

@@ -55,13 +47,12 @@

 			newtok(tokens, new);

 			goto next;

 		}

-		for(int i = 0; i < nelem(primspecs); i++){

-			if(r == primspecs[i].spelling){

-				tok = newtok(tokens, TokPrimitive);

-				tok->prim = primspecs[i].id;

-				tok->nameclass = NameclassFunc;

-				goto next;

-			}

+		if((id = primid(cp)) != -1){

+			n = strlen(primsymb(id));

+			tok = newtok(tokens, TokPrimitive);

+			tok->prim = id;

+			tok->nameclass = primclass(id);

+			goto next;

 		}

 		if(isspacerune(r))

 			goto next;

-- 

⑨