fixed the tv.wcount and tv.s.len restoration logic upon compiliation failure

lib/comp.c

@@ -27,7 +27,6 @@
 /* limit the `do` expression to have not more than 1 expression and
  * no variable declaration if not enclosed in parentheses */
 #define LANG_LIMIT_DO
-#define CLEAR_FNBLK_ALWAYS
 
 #define FOR_NONE (0)
 #define FOR_IF   (1)
@@ -5856,23 +5855,46 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 {
 	hcl_oow_t saved_bc_len, saved_lit_len;
 	hcl_bitmask_t log_default_type_mask;
-#if !defined(CLEAR_FNBLK_ALWAYS)
 	hcl_fnblk_info_t top_fnblk_saved;
-	int fnblk_pushed_here = 0;
+	int top_fnblk_pushed_here = 0;
-#endif
 
 	hcl->c->flags = flags;
 
 	HCL_ASSERT (hcl, hcl->c->fnblk.depth <= 0); /* 0 or 1 fnblk must exist at this phase */
 	HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0);
-#if !defined(CLEAR_FNBLK_ALWAYS)
+
 	if (flags & HCL_COMPILE_CLEAR_FNBLK)
 	{
+		/* if the program is executed in the interactive mode,
+		 * each compiled expression is executed immediately.
+		 * that is, hcl_compile() is followed by hcl_execute()
+		 * immediately.
+		 *
+		 *   (1) a := 20
+		 *   (2) { | b c | b := 20; c := 30 }
+		 *   (3) printf "%d\n" a
+		 *
+		 * in the interactive mode,
+		 *  (1) is compiled and executed
+		 *  (2) is compiled and executed
+		 *  (3) is compiled and executed
+		 *
+		 * in the non-interactive mode,
+		 *  (1) is compiled, (2) is compiled, (3) is compiled
+		 *  (1), (2), (3) are executed
+		 * fnblk holds information about temporaries seen so far.
+		 * (2) has defined two temporary variables. this count
+		 * must get carried until (3) has been compiled in the
+		 * non-interactive mode. the accumulated count is used
+		 * in creating an initial context for execution.
+		 *
+		 * in the interactive mode, the information doesn't have
+		 * to get carried over.
+		 */
 		while (hcl->c->fnblk.depth >= 0) pop_fnblk (hcl);
 		HCL_ASSERT (hcl, hcl->c->fnblk.depth == -1);
 		/* it will be recreated below */
 	}
-#endif
 	if (flags & HCL_COMPILE_CLEAR_CODE) hcl_clearcode (hcl);
 
 	saved_bc_len = hcl->code.bc.len;
@@ -5915,10 +5937,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 /* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */
 	HCL_ASSERT (hcl, hcl->c->cblk.depth == -1);
 
-#if !defined(CLEAR_FNBLK_ALWAYS)
 	if (hcl->c->fnblk.depth <= -1)
 	{
-#endif
 		HCL_ASSERT (hcl, hcl->c->fnblk.depth == -1);
 		HCL_ASSERT (hcl, hcl->c->tv.s.len == 0);
 		HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
@@ -5941,11 +5961,9 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 			FUN_PLAIN /* fun_type */
 		) <= -1) return -1; /* must not goto oops */
 
-#if !defined(CLEAR_FNBLK_ALWAYS)
+		top_fnblk_pushed_here = 1;
-		fnblk_pushed_here = 1;
 	}
 	top_fnblk_saved = hcl->c->fnblk.info[0];
-#endif
 	HCL_ASSERT (hcl, hcl->c->fnblk.depth == 0); /* ensure the virtual function block is added */
 
 	PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj);
@@ -6204,27 +6222,31 @@ oops:
 	while (hcl->c->fnblk.depth > 0) pop_fnblk (hcl);
 	HCL_ASSERT (hcl, hcl->c->fnblk.depth == 0);
 
-#if !defined(CLEAR_FNBLK_ALWAYS)
+	if (top_fnblk_pushed_here)
-	if (fnblk_pushed_here)
 	{
-#endif
 		pop_fnblk (hcl);
 		HCL_ASSERT (hcl, hcl->c->fnblk.depth == -1);
 		HCL_ASSERT (hcl, hcl->c->tv.s.len == 0);
 		HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
-#if !defined(CLEAR_FNBLK_ALWAYS)
 	}
 	else
 	{
-		hcl->c->tv.s.len = 0;
+		/*
-		hcl->c->tv.wcount = 0;
+		{ |a b c| } ## tv.s.len 6, tv.wcount 3
+		{ |k a| (set x y z) }
+		*
+		* at this point when (set a b c) triggers a syntax error
+		* tv.s.len is 10 and tv.wcount is 5.
+		* it must be restored to 6 and 3 each.
+		*/
 
 		/* restore the top level function block as it's first captured in this function */
 		clear_fnblk_inners (hcl);
 		HCL_ASSERT (hcl, hcl->c->fnblk.depth == 0);
 		hcl->c->fnblk.info[0] = top_fnblk_saved;
+		hcl->c->tv.s.len = top_fnblk_saved.tmprlen;
+		hcl->c->tv.wcount = top_fnblk_saved.tmprcnt;
 	}
-#endif
 
 	return -1;
 }

lib/hcl.h

@@ -2840,11 +2840,6 @@ HCL_EXPORT hcl_oop_t hcl_makedic (
 	hcl_oow_t         inisize /* initial bucket size */
 );
 
-HCL_EXPORT hcl_oop_t hcl_makecontext (
-	hcl_t*            hcl,
-	hcl_ooi_t         ntmprs
-);
-
 HCL_EXPORT hcl_oop_t hcl_makeclass (
 	hcl_t*            hcl,
 	hcl_oop_t         superclass,

lib/read.c

@@ -1089,7 +1089,9 @@ static int feed_begin_include (hcl_t* hcl)
 	hcl_io_cciarg_t* arg;
 	const hcl_ooch_t* io_name;
 
+/*hcl_logbfmt(hcl, HCL_LOG_STDERR, "adding... %js\n", TOKEN_NAME_PTR(hcl));*/
 	io_name = add_sr_name(hcl, TOKEN_NAME(hcl));
+/*hcl_logbfmt(hcl, HCL_LOG_STDERR, "added... %js\n", io_name);*/
 	if (HCL_UNLIKELY(!io_name))
 	{
 		const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);

t/Makefile.am

@@ -8,7 +8,9 @@ check_SCRIPTS = \
 	ret-01.hcl \
 	retvar-01.hcl \
 	va-01.hcl \
-	var-02.hcl
+	var-01.hcl \
+	var-02.hcl \
+	var-03.hcl
 
 check_ERRORS = \
 	call-5001.err \

t/Makefile.in

@@ -480,7 +480,9 @@ check_SCRIPTS = \
 	ret-01.hcl \
 	retvar-01.hcl \
 	va-01.hcl \
-	var-02.hcl
+	var-01.hcl \
+	var-02.hcl \
+	var-03.hcl
 
 check_ERRORS = \
 	call-5001.err \

t/var-01.hcl

@@ -1,111 +1,97 @@
-(defun x (a b :: r)
+defun x (a b :: r) {
 	
 	| x y |
 
-	(set x a)
+	set x a
-	(set y b)
+	set y b
 
-	(if (> a b)
+	if (> a b) {
-		(do
+		| a b |
-			| a b |
+		set a (mod x y)
-			(set a (mod x y))
+		set b (+ x y)
-			(set b (+ x y))
+		set r (* a b)
-			(set r (* a b))
+	} else {
-		)
+		| a b |
-	else
+		set a (* x y)
-		(do
+		set b (- x y)
+		set r (* a b)
+	}
 
-			| a b |
-			(set a (* x y))
-			(set b (- x y))
-			(set r (* a b))
-		)
-	)
 
-	(if (/= x a) (printf "ERROR: x is not equal to a\n"))
+	if (/= x a) (printf "ERROR: x is not equal to a\n")
-	(if (/= y b) (printf "ERROR: y is not equal to b\n"))
+	if (/= y b) (printf "ERROR: y is not equal to b\n")
+}
+
+t := (x 10 20)
+if (/= t -2000) (printf "ERROR: t is not equal to -2000\n") \
+else (printf "OK: %d\n" t)
+set t (x 30 20)
+if (/= t 500) (printf "ERROR: t is not equal to 500\n") \
+else (printf "OK: %d\n" t)
+
+
+defun x () {
+
+	| x y |
+
+	set x 99
+	try {
+		| x |
+		set x 88
+		if (/= x 88) (printf "ERROR: x is not 88\n") \
+	  	else (printf "OK: %d\n" x)
+		throw 1000
+	} catch (x) {
+		if (/= x 1000) (printf "ERROR: x is not 1000\n") \
+	 	else (printf "OK: %d\n" x)
+		set y x
+	}
+
+	if (/= x 99) (printf "ERROR: x is not 99\n") \
+	else (printf "OK: %d\n" x)
+	if (/= y 1000) (print "ERROR: y is not 1000\n") \
+	else (printf "OK: %d\n" y)
+} 
+
+x
+
+
+class T | j | {
+
+	defun :* new() {
+		set j 99
+		return self
+	}
+
+	defun x() {
+		set R {
+			| x |
+			set x 1
+			while (< x j) {
+				defun Q() x
+				set x (+ x 1)
+			}
+		}
+	}
+}
+
+set t (T:new)
+t:x
+set t (Q)
+if (/= t 99) (print "ERROR: t is not 99\n") \
+else (printf "OK: %d\n" t)
+
+if (nqv? R false) (print "ERROR: R is not false\n") \
+else (printf "OK: %O\n" R)
+
+set v #(
+	(do |a b| (set a 10) (set b 20) (+ a b) )
+ 	(do |a b| (set a 11) (set b 21) (+ a b) )
+   	999
 )
 
-(set t (x 10 20))
+set v2 #(30 32 999)
-(if (/= t -2000) (printf "ERROR: t is not equal to -2000\n")
- else (printf "OK: %d\n" t))
-(set t (x 30 20))
-(if (/= t 500) (printf "ERROR: t is not equal to 500\n")
- else (printf "OK: %d\n" t))
 
-
+if (nql? v v2) (print "ERROR: v1 and v2 are not equal\n")\
-(defun x ()
+else (printf "OK: v and v2 equal\n")
-
-	(do
-		| x y |
-
-		(set x 99)
-		(try
-
-			(do
-				| x |
-				(set x 88)
-				(if (/= x 88) (printf "ERROR: x is not 88\n")
-		 	 	 else (printf "OK: %d\n" x))
-				(throw 1000)
-			)
-		catch (x)
-			(if (/= x 1000) (printf "ERROR: x is not 1000\n")
-		 	 else (printf "OK: %d\n" x))
-			(set y x)
-		)	
-
-		(if (/= x 99) (printf "ERROR: x is not 99\n")
-		 else (printf "OK: %d\n" x))
-		(if (/= y 1000) (print "ERROR: y is not 1000\n")
-		 else (printf "OK: %d\n" y))
-	)
-) 
-
-(x)
-
-
-(defclass T
-	| j |
-
-	(defun :* new()
-		(set j 99)
-		(return self)
-	)
-
-	(defun x()
-		(set R
-			(do 
-				| x |
-				(set x 1)
-				(while (< x j)
-					(defun Q() x)
-					(set x (+ x 1))
-				)
-			)
-		)
-	)
-)
-
-(set t (:T new))
-(:t x)
-(set t (Q))
-(if (/= t 99) (print "ERROR: t is not 99\n")
- else (printf "OK: %d\n" t))
-
-(if (nqv? R false) (print "ERROR: R is not false\n")
- else (printf "OK: %O\n" R))
-
-(set v 
-	#(
-		(do |a b| (set a 10) (set b 20) (+ a b) )
- 		(do |a b| (set a 11) (set b 21) (+ a b) )
-   		999
-	)
-)
-
-(set v2 #(30 32 999))
-
-(if (nql? v v2) (print "ERROR: v1 and v2 are not equal\n")
- else (printf "OK: v and v2 equal\n"))
 

t/var-03.hcl

@@ -0,0 +1,31 @@
+## there are 8 local temporaries variables in the top-level context
+## the 8 temporaries defined inside the block expression are parked
+## at the top-level context. 'a' assigned before the block expression
+## is a global variable.
+
+a := 1234
+
+{
+	| a b c d |
+	| e f g h |
+	a := 10
+	b := 20
+	c := 30
+	d := 40
+	e := 50
+	f := 60
+	g := 70
+	h := 80
+		
+	if (/= a 10) { print "ERROR: a inside the block expression is not 10\n" } \
+	else { printf "OK: %d\n" a };
+}
+
+a := (a + 1)
+c := (sprintf "%d" a)
+
+if (/= a 1235) { printf "ERROR: a is not 1235\n" } \
+else { printf "OK: %d\n" a };
+
+if (nql? c "1235") { printf "ERROR: c is not \"1235\"\n" } \
+else { printf "OK: %s\n" c };