shithub: mlisp

Info  •  Files  •  Log  •  Branches

restructure program feature

--- a/lisp.c

+++ b/lisp.c

@@ -703,8 +703,7 @@

 			return evbody(c->a->d, a);

 		}

 	}

-	err("error: no cond clause");

-	return nil;	/* make compiler happy */

+	return nil;

 }

 C*

@@ -1022,6 +1021,7 @@

 		fprintf(sysout, "→\n");

 	pdp = 0;

 	alist = nil;

+	memset(&prog, 0, sizeof(prog));

 	memset(&temlis, 0, sizeof(temlis));

 	eval_repl();

--- a/lisp.h

+++ b/lisp.h

@@ -139,6 +139,15 @@

 };

 extern Arglist largs;	/* LEXPR/LSUBR args */

+typedef struct Prog Prog;

+struct Prog

+{

+	C *prog;

+	C *pc;

+	C *ret;

+};

+extern Prog prog;

+

 extern C *noval;

 extern C *t;

 extern C *value;

--- a/subr.c

+++ b/subr.c

@@ -1,9 +1,4 @@

 #include "lisp.h"

-/*

-#include <limits.h>

-#include <float.h>

-#include <math.h>

-*/

 int

 floeq(flonum x, flonum y)

@@ -954,86 +949,44 @@

 /* Prog feature */

+Prog prog;

-typedef struct Prog Prog;

-struct Prog

-{

-	C *a;

-	C *go;

-	C *pc;

-	C *ret;

-};

-

-void

-setq_prog(Prog *prog, C *form)

-{

-	C *tt;

-	if(form == nil)

+C *go_fsubr(void){

+	C *t, *p;

+	if(prog.prog == nil)

+		err("error: not in prog");

+	if(alist[0] == nil)

 		err("error: arg count");

-	if(!atom(form->a))

-		err("error: no atom");

-	tt = assq(form->a, prog->a);

-	if(tt == nil)

-		err("error: undefined");

-	tt->d = eval(form->d->a, prog->a);

+	t = alist[0]->a;

+	while(!atom(t))

+		t = eval(t, alist[1]);

+	for(p = prog.prog; p != nil; p = p->d)

+		if(p->a == t){

+			prog.pc = p->d;

+			return nil;

+		}

+	err("undefined label");

+	return nil;	// hm...

 }

-

-void

-set_prog(Prog *prog, C *form)

-{

-	C *tt;

-	if(form == nil)

-		err("error: arg count");

-	tt = eval(form->a, prog->a);

-	if(!atom(tt))

-		err("error: no atom");

-	tt = assq(tt, prog->a);

-	if(tt == nil)

-		err("error: undefined");

-	tt->d = eval(form->d->a, prog->a);

+C *return_fsubr(void){

+	if(prog.prog == nil)

+		err("error: not in prog");

+	if(alist[0] == nil)

+		prog.ret = nil;

+	else

+		prog.ret = eval(alist[0]->a, alist[1]);

+	prog.pc = nil;

+	return nil;	// hm...

 }

-void

-progstmt(Prog *prog, C *form)

-{

-	C *tt;

-	C *pc;

-

-	if(atom(form))

-		{}

-	else if(form->a == setq)

-		setq_prog(prog, form->d);

-	else if(form->a == set)

-		set_prog(prog, form->d);

-	else if(form->a == cond){

-		for(form = form->d; form != nil; form = form->d)

-			if(eval(form->a->a, prog->a) != nil){

-				for(pc = form->a->d; pc != nil; pc = pc->d)

-					progstmt(prog, pc->a);

-				return;

-			}

-	}else if(form->a == go){

-		if(form->d == nil)

-			err("error: arg count");

-		if(tt = assq(form->d->a, prog->go), tt == nil)

-			err("error: undefined label");

-		prog->pc = tt->d;

-	}else if(form->a == retrn){

-		if(form->d == nil)

-			prog->ret = nil;

-		else

-			prog->ret = eval(form->d->a, prog->a);

-		prog->pc = nil;

-	}else

-		eval(form, prog->a);

-}

-

 C *prog_fsubr(void){

-	Prog prog;

+	Prog progsv;

-	C *p;

+	C *p, *a;

 	C **ap;

+	progsv = prog;

+	prog.prog = alist[0]->d;

 	prog.pc = alist[0]->d;

 	/* build a-list */

@@ -1043,28 +996,22 @@

 		*ap = cons(cons(p->a, nil), nil);

 		ap = &(*ap)->d;

 	}

-	*ap = alist[1];

-	alist[1] = temlis.a;

-	prog.a = alist[1];

+	*ap = alist[1];		/* nconc */

+	alist[1] = a = temlis.a;

 	temlis.a = nil;

-	/* build go-list */

-	for(p = prog.pc; p != nil; p = p->d)

-		if(atom(p->a))

-			temlis.a = cons(p, temlis.a);

-	prog.go = temlis.a;

-	temlis.a = nil;

-	alist[nargs++] = prog.go;

-

 	/* execute */

 	prog.ret = nil;

 	while(prog.pc != nil){

 		p = prog.pc->a;

 		prog.pc = prog.pc->d;

-		progstmt(&prog, p);

+		if(!atom(p))

+			eval(p, a);

 	}

-	return prog.ret;

+	p = prog.ret;

+	prog = progsv;

+	return p;

 }

 void

@@ -1156,6 +1103,8 @@

 	FSUBR("AND", and_fsubr)

 	FSUBR("OR", or_fsubr)

 	FSUBR("PROG", prog_fsubr)

+	FSUBR("RETURN", return_fsubr)

+	FSUBR("GO", go_fsubr)

 	FSUBR("SETQ", setq_fsubr)

 	FSUBR("SET", set_fsubr)