Add return, break, and continue.

minproto.leg

@@ -1,6 +1,6 @@
 # minproto.leg -- minimal prototype langauge for semantic experiments
 #
-# last edited: 2024-05-10 03:08:44 by piumarta on zora-1034.local
+# last edited: 2024-05-11 20:13:21 by piumarta on zora
 
 %{
 ;
@@ -21,7 +21,11 @@
 #endif
 
 #ifndef DELOPT		// delegate is a member of Object structure, not a normal property
-# define DELOPT 0	// (approx. 60% performance increase, becase no associative lookup of __delegate__)
+# define DELOPT 0	// (approx. 60% performance increase, because no associative lookup of __delegate__)
+#endif
+
+#ifndef NONLOCAL	// support non-local control flow (return, break, continue)
+# define NONLOCAL 1	// (approx. 5% [loop] to 55% [call] performance decrease, because of jmp_buf initialisations)
 #endif
 
 #include <math.h>
@@ -85,9 +89,9 @@ typedef oop (*prim_t)(oop func, oop self, oop args, oop env);
 #endif
 
 #if PRIMCLOSURE
-#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal)
+#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal)
 #else
-#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure)
+#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure)
 #endif
 
 #define  declareProto(NAME)	oop p##NAME = 0;
@@ -121,6 +125,44 @@ doProperties(declareProp);
 doSymbols(declareSym);
 #undef declareSym
 
+#if NONLOCAL
+
+#include <setjmp.h>
+
+enum {
+    NLR_RESULT = 0,  // initialisation, no non-local flow
+    NLR_CONTINUE,    // non-local jump back to the start of active loop
+    NLR_BREAK,	     // non-local jump out of the active loop
+    NLR_RETURN,	     // non-local return from the active function
+};		     // passed to longjmp, returned from setjmp
+
+struct NLR {
+    int     ntrace;
+    jmp_buf env;
+};
+
+struct NLR *nlrs = 0;
+
+int     nnlrs = 0;
+int   maxnlrs = 0;
+oop   valnlr  = 0;
+
+#define nlrPush() ({									\
+	    if (nnlrs == maxnlrs) nlrs = realloc(nlrs, sizeof(jmp_buf) * ++maxnlrs);	\
+	    ++nnlrs;									\
+	    nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize);				\
+	    setjmp(nlrs[nnlrs - 1].env);						\
+	})
+
+#define nlrReturn(VAL, TYPE) {			\
+	valnlr = VAL;				\
+	longjmp(nlrs[nnlrs-1].env, TYPE);	\
+    }
+
+#define nlrPop() (_set(trace, Object,isize, nlrs[--nnlrs].ntrace), valnlr)
+
+#endif
+
 struct property  { oop key, val; };
 
 struct Integer 	 { enum type type;  long _value; };
@@ -1271,6 +1313,75 @@ void Invoke_codeOn(oop exp, oop str, oop env)
     codeArgumentsOn(str, Object_get(exp, sym_arguments), "(", ")");
 }
 
+oop newContinue(void)
+{
+    return new(pContinue);
+}
+
+oop Continue_eval(oop exp, oop env)
+{
+# if NONLOCAL
+    nlrReturn(nil, NLR_CONTINUE);
+    assert(!"this cannot happen");
+# endif
+    return nil;
+}
+
+void Continue_codeOn(oop exp, oop str, oop env)
+{
+    String_appendAll(str, "continue");
+}
+
+oop newBreak(oop value)
+{
+    oop o = new(pBreak);
+    Object_put(o, sym_value, value);
+    return o;
+}
+
+oop Break_eval(oop exp, oop env)
+{
+    oop value = eval(Object_get(exp, sym_value), env);
+# if NONLOCAL
+    nlrReturn(value, NLR_BREAK);
+    assert(!"this cannot happen");
+# endif
+    return value;
+}
+
+void Break_codeOn(oop exp, oop str, oop env)
+{
+    String_appendAll(str, "break");
+    oop value = Object_get(exp, sym_value);
+    if (nil != value) {
+	String_appendAll(str, " ");
+	codeOn(str, value, 0);
+    }
+}
+
+oop newReturn(oop value)
+{
+    oop o = new(pReturn);
+    Object_put(o, sym_value, value);
+    return o;
+}
+
+oop Return_eval(oop exp, oop env)
+{
+    oop value = eval(Object_get(exp, sym_value), env);
+# if NONLOCAL
+    nlrReturn(value, NLR_RETURN);
+    assert(!"this cannot happen");
+# endif
+    return value;
+}
+
+void Return_codeOn(oop exp, oop str, oop env)
+{
+    String_appendAll(str, "return ");
+    codeOn(str, Object_get(exp, sym_value), 0);
+}
+
 #if !PRIMCLOSURE
 
 oop newLambda(oop parameters, oop body)
@@ -1706,6 +1817,25 @@ oop newFor(oop initialise, oop condition, oop update, oop body)
     return o;
 }
 
+#define _PASTE(A, B) A##B
+#define  PASTE(A, B) _PASTE(A,B)
+
+#if NONLOCAL
+
+# define LOOP()									\
+  PASTE(continue,__LINE__):							\
+    switch (nlrPush()) {							\
+	case NLR_CONTINUE:	nlrPop();  goto PASTE(continue, __LINE__);	\
+	case NLR_BREAK:		return nlrPop();				\
+	case NLR_RETURN:	nlrReturn(nlrPop(), NLR_RETURN);		\
+    }
+
+# define DONE()	nlrPop()
+#else
+# define LOOP()
+# define DONE()
+#endif
+
 oop For_eval(oop exp, oop env)
 {
     oop initialise = Object_get(exp, sym_initialise);
@@ -1715,10 +1845,16 @@ oop For_eval(oop exp, oop env)
     oop env2 = new(pObject);
     _setDelegate(env2, env);
     oop result     = eval(initialise, env2);
-    while (nil != eval(condition, env2)) {
+    int n          = 0;
+    LOOP();
+    if (n++) goto doContinue;
+    for (;;) {
+	if (nil == eval(condition, env2)) break;
 	result = eval(body, env2);
+      doContinue:
 	eval(update, env2);
     }
+    DONE();
     return result;
 }
 
@@ -1757,29 +1893,37 @@ oop ForIn_eval(oop exp, oop env)
     oop env2 = new(pObject);
     _setDelegate(env2, env);
     if (isInteger(vals)) {
-	long limit = _integerValue(vals);
-	for (long i = 0;  i < limit;  ++i) {
+	long i = -1, limit = _integerValue(vals);
+	LOOP();
+	while (++i < limit) {
 	    Object_put(env2, identifier, newInteger(i));
 	    result = eval(body, env2);
 	}
+	DONE();
 	return result;
     }
     if (is(String, vals)) {
 	int   len = _get(vals, String,length);
 	char *val = _get(vals, String,value);
-	for (int i = 0;  i < len;  ++i) {
+	int    i  = -1;
+	LOOP();
+	while (++i < len) {
 	    Object_put(env2, identifier, newInteger(val[i]));
 	    result = eval(body, env2);
 	}
+	DONE();
 	return result;
     }
     if (!is(Object, vals)) fatal("for: non-object sequence %s", storeString(vals, 0));
     oop *indexed   = _get(vals, Object,indexed);
     int size       = _get(vals, Object,isize);
-    for (int i = 0;  i < size;  ++i) {
+    int i          = -1;
+    LOOP();
+    while (++i < size) {
 	Object_put(env2, identifier, indexed[i]);
 	result = eval(body, env2);
     }
+    DONE();
     return result;
 }
 
@@ -1818,12 +1962,14 @@ oop ForFromTo_eval(oop exp, oop env)
     long stop  	= integerValue(last,  "for");
     long step  	= start < stop ? 1  : -1;
     oop  result = nil;
+    LOOP();
     for (;;) {
 	Object_put(env2, identifier, newInteger(start));
 	result = eval(body, env2);
 	if (start == stop) break;
 	start += step;
     }
+    DONE();
     return result;
 }
 
@@ -1843,6 +1989,9 @@ void ForFromTo_codeOn(oop exp, oop str, oop env)
     codeOn(str, body, 0);
 }
 
+#undef LOOP
+#undef DONE
+
 oop newLiteral(oop object)
 {
     oop o = new(pLiteral);
@@ -1929,6 +2078,11 @@ stmt	= LET l:mklet k:id ASSIGN v:expr	{ Let_append(l, k, v) }
 	  ( ELSE t:stmt				{ $$ = newIf(c, s, t  ) }
 	  |					{ $$ = newIf(c, s, nil) }
 	  )
+	| CONT EOS				{ $$ = newContinue() }
+	| BREAK e:expr EOS			{ $$ = newBreak(e) }
+	| BREAK EOS				{ $$ = newBreak(nil) }
+	| RETURN e:expr EOS			{ $$ = newReturn(e) }
+	| RETURN EOS				{ $$ = newReturn(nil) }
 	| FOR LPAREN i:id IN e:expr RPAREN
 	      s:stmt				{ $$ = newForIn(i, e, s) }
 	| FOR LPAREN i:id FROM a:expr
@@ -2075,15 +2229,18 @@ EXP	= [eE] SIGN DIGIT+
 SPACE	= [ \t] | EOL | '//' (!EOL .)*
 EOL	= [\n\r]				{ ++lineno }
 
-NIL	= "nil"     !ALNUM  -
-WHILE	= "while"   !ALNUM  -
-IF	= "if"      !ALNUM  -
-ELSE	= "else"    !ALNUM  -
-FOR	= "for"     !ALNUM  -
-IN	= "in"      !ALNUM  -
-FROM	= "from"    !ALNUM  -
-TO	= "to"      !ALNUM  -
-LET	= "let"     !ALNUM  -
+NIL	= "nil"      !ALNUM  -
+WHILE	= "while"    !ALNUM  -
+IF	= "if"       !ALNUM  -
+ELSE	= "else"     !ALNUM  -
+FOR	= "for"      !ALNUM  -
+IN	= "in"       !ALNUM  -
+FROM	= "from"     !ALNUM  -
+TO	= "to"       !ALNUM  -
+LET	= "let"      !ALNUM  -
+CONT    = "continue" !ALNUM  -
+BREAK   = "break"    !ALNUM  -
+RETURN  = "return"   !ALNUM  -
 
 BQUOTE	= "`"      	-
 COMMAT	= "@"      	-
@@ -2169,10 +2326,20 @@ oop apply(oop func, oop self, oop args, oop env)
     oop *pparam = _get(parameters, Object,indexed);
     int  nargs  = _get(args,       Object,isize);
     oop *pargs  = _get(args,       Object,indexed);
+# if NONLOCAL
+    switch (nlrPush()) {
+	case NLR_CONTINUE:	fatal("continue outside loop");
+	case NLR_BREAK:		fatal("break outside loop");
+	case NLR_RETURN:	return nlrPop();
+    }
+# endif
     for (int i = 0;  i < nparam;  ++i)
 	Object_put(args, pparam[i], i < nargs ? pargs[i] : nil);
     for (int i = 0;  i < size;  ++i)
 	result = eval(exprs[i], args);
+# if NONLOCAL
+    nlrPop();
+# endif
     return result;
 }
 
@@ -2492,6 +2659,13 @@ oop replFile(FILE *in)
     input = newInput();
     readFile(in, &input->text, &input->size);
     oop result = nil;
+# if NONLOCAL
+    switch (nlrPush()) {
+	case NLR_CONTINUE:	fatal("continue outside loop");
+	case NLR_BREAK:		fatal("break outside loop");
+	case NLR_RETURN:	fatal("return outside function");
+    }
+# endif
     while (yyparse() && yysval) {
 	if (opt_v) {
 	    printf(">>> ");
@@ -2504,6 +2678,9 @@ oop replFile(FILE *in)
 	    else if (opt_v >= 1) storeln(result, 0);
 	}
     }
+# if NONLOCAL
+    nlrPop();
+# endif
     lineno   = oldline;
     return result;
 }