diff --git a/lib/comp.c b/lib/comp.c index 6510ff7..86af99d 100644 --- a/lib/comp.c +++ b/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; -#endif + int top_fnblk_pushed_here = 0; 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) - fnblk_pushed_here = 1; + top_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 (fnblk_pushed_here) + if (top_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; } diff --git a/lib/hcl.h b/lib/hcl.h index 7ebc8a8..82a011a 100644 --- a/lib/hcl.h +++ b/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, diff --git a/lib/read.c b/lib/read.c index 403601d..774c5d5 100644 --- a/lib/read.c +++ b/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); diff --git a/t/Makefile.am b/t/Makefile.am index 3a009e2..37c8294 100644 --- a/t/Makefile.am +++ b/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 \ diff --git a/t/Makefile.in b/t/Makefile.in index aca5de1..47e8303 100644 --- a/t/Makefile.in +++ b/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 \ diff --git a/t/var-01.hcl b/t/var-01.hcl index 350a338..d3b5ca7 100644 --- a/t/var-01.hcl +++ b/t/var-01.hcl @@ -1,111 +1,97 @@ -(defun x (a b :: r) +defun x (a b :: r) { | x y | - (set x a) - (set y b) + set x a + set y b - (if (> a b) - (do - | a b | - (set a (mod x y)) - (set b (+ x y)) - (set r (* a b)) - ) - else - (do + if (> a b) { + | a b | + set a (mod x y) + set b (+ x y) + set r (* a b) + } else { + | a b | + set a (* x y) + 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 (/= y b) (printf "ERROR: y is not equal to b\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") +} + +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)) -(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)) +set v2 #(30 32 999) - -(defun x () - - (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")) +if (nql? v v2) (print "ERROR: v1 and v2 are not equal\n")\ +else (printf "OK: v and v2 equal\n") diff --git a/t/var-03.hcl b/t/var-03.hcl new file mode 100644 index 0000000..759bbdb --- /dev/null +++ b/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 };