working on the block expression compilation

bin/main.c

@@ -97,6 +97,7 @@ struct xtn_t
 	const char* udo_path;
 
 	int vm_running;
+	int extra_cflags;
 	/*hcl_oop_t sym_errstr;*/
 };
 
@@ -447,11 +448,18 @@ static hcl_oop_t execute_in_batch_mode (hcl_t* hcl, int verbose)
 
 static int on_fed_cnode_in_interactive_mode (hcl_t* hcl, hcl_cnode_t* obj)
 {
-	if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK) <= -1) return -1;
+	xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);
+	if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK | xtn->extra_cflags) <= -1) return -1;
 	execute_in_interactive_mode (hcl);
 	return 0;
 }
 
+static int on_fed_cnode_in_batch_mode (hcl_t* hcl, hcl_cnode_t* obj)
+{
+	xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);
+        return hcl_compile(hcl, obj, xtn->extra_cflags);
+}
+
 static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
 {
 	FILE* fp = HCL_NULL;
@@ -468,7 +476,8 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
 
 	/* override the default cnode handler. the default one simply
 	 * compiles the expression node without execution */
-	if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: HCL_NULL) <= -1)
+	/*if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: HCL_NULL) <= -1)*/
+	if (hcl_beginfeed(hcl, is_tty? on_fed_cnode_in_interactive_mode: on_fed_cnode_in_batch_mode) <= -1)
 	{
 		hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot begin feed - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
 		goto oops;
@@ -477,37 +486,41 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
 	/* [NOTE] it isn't a very nice idea to get this internal data and use it with read_input() */
 	while (1)
 	{
-	#if 0
-		hcl_bch_t buf[1024];
-		hcl_oow_t xlen;
 
-		xlen = fread(buf, HCL_SIZEOF(buf[0]), HCL_COUNTOF(buf), fp);
+		if (is_tty)
-		if (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error;
-		if (xlen < HCL_COUNTOF(buf))
 		{
-			if (ferror(fp))
+			hcl_bch_t bch;
+			int ch = fgetc(fp);
+			if (ch == EOF)
 			{
-				hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno));
+				if (ferror(fp))
-				goto oops;
+				{
+					hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno));
+					goto oops;
+				}
+				break;
 			}
-			break;
-		}
-	#else
-		hcl_bch_t bch;
-		int ch = fgetc(fp);
-		if (ch == EOF)
-		{
-			if (ferror(fp))
-			{
-				hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno));
-				goto oops;
-			}
-			break;
-		}
 
-		bch = ch;
+			bch = ch;
-		if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error;
+			if (hcl_feedbchars(hcl, &bch, 1) <= -1) goto feed_error;
-	#endif
+		}
+		else
+		{
+			hcl_bch_t buf[1024];
+			hcl_oow_t xlen;
+
+			xlen = fread(buf, HCL_SIZEOF(buf[0]), HCL_COUNTOF(buf), fp);
+			if (xlen > 0 && hcl_feedbchars(hcl, buf, xlen) <= -1) goto feed_error;
+			if (xlen < HCL_COUNTOF(buf))
+			{
+				if (ferror(fp))
+				{
+					hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: failed to read - %hs - %hs\n", xtn->cci_path, strerror(errno));
+					goto oops;
+				}
+				break;
+			}
+		}
 	}
 
 	if (hcl_endfeed(hcl) <= -1)
@@ -549,7 +562,7 @@ int main (int argc, char* argv[])
 	};
 	static hcl_bopt_t opt =
 	{
-		"l:v",
+		"l:xv",
 		lopt
 	};
 
@@ -557,7 +570,7 @@ int main (int argc, char* argv[])
 	hcl_oow_t heapsize = DEFAULT_HEAPSIZE;
 	int verbose = 0;
 	int show_info = 0;
-	/*int experimental = 0;*/
+	int experimental = 0;
 
 #if defined(HCL_BUILD_DEBUG)
 	const char* dbgopt = HCL_NULL;
@@ -581,9 +594,9 @@ int main (int argc, char* argv[])
 				logopt = opt.arg;
 				break;
 
-			/*case 'x':
+			case 'x':
 				experimental = 1;
-				break;*/
+				break;
 
 			case 'v':
 				verbose = 1;
@@ -695,6 +708,7 @@ int main (int argc, char* argv[])
 		goto oops;
 	}
 
+	if (experimental) xtn->extra_cflags |= HCL_COMPILE_ENABLE_BLOCK;
 	xtn->cci_path = argv[opt.ind++]; /* input source code file */
 	if (opt.ind < argc) xtn->udo_path = argv[opt.ind++];
 

lib/cnode.c

@@ -193,9 +193,7 @@ redo:
 
 			HCL_ASSERT (hcl, tmp1 != HCL_NULL);
 			hcl_freemem (hcl, c);
-
 			hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */
-
 			if (tmp2)
 			{
 				c = tmp2;
@@ -210,9 +208,7 @@ redo:
 			hcl_cnode_t* tmp;
 
 			tmp = c->u.shell.obj;
-
 			hcl_freemem (hcl, c);
-
 			if (tmp)
 			{
 				c = tmp;

lib/comp.c

@@ -684,9 +684,9 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
 		/* MAKE_FUNCTION is a quad-parameter instruction.
 		 * The caller must emit two more parameters after the call to this function.
 		 * however the instruction format is the same up to the second
-		 * parameters between MAKE_FUNCTION and MAKE_BLOCK.
+		 * parameters between MAKE_FUNCTION and MAKE_LAMBDA.
 		 */
-		case HCL_CODE_MAKE_BLOCK:
+		case HCL_CODE_MAKE_LAMBDA:
 		case HCL_CODE_MAKE_FUNCTION:
 		case HCL_CODE_CALL_R:
 		case HCL_CODE_SEND_R:
@@ -1129,8 +1129,8 @@ static void pop_fnblk (hcl_t* hcl)
 	{
 		hcl_oow_t attr_mask;
 
-		/* patch the temporaries mask parameter for the MAKE_BLOCK or MAKE_FUNCTION instruction */
+		/* patch the temporaries mask parameter for the MAKE_LAMBDA or MAKE_FUNCTION instruction */
-		HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_BLOCK || 
+		HCL_ASSERT (hcl, hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_LAMBDA ||
 		                 hcl->code.bc.ptr[fbi->make_inst_pos] == HCL_CODE_MAKE_FUNCTION);
 
 		/* the total number of temporaries in this function block must be the sum of
@@ -1138,7 +1138,7 @@ static void pop_fnblk (hcl_t* hcl)
 		HCL_ASSERT (hcl, fbi->tmprcnt - hcl->c->tv.wcount == fbi->tmpr_nargs + fbi->tmpr_nrvars + fbi->tmpr_nlvars);
 
 		/* the temporaries mask is a bit-mask that encodes the counts of different temporary variables.
-		 * and it's split to two intruction parameters when used with MAKE_BLOCK and MAKE_FUNCTION */
+		 * and it's split to two intruction parameters when used with MAKE_LAMBDA and MAKE_FUNCTION */
 		attr_mask = ENCODE_BLK_MASK((fbi->fun_type == FUN_CIM), fbi->tmpr_va, fbi->tmpr_nargs, fbi->tmpr_nrvars, fbi->tmpr_nlvars);
 		patch_double_long_params_with_oow (hcl, fbi->make_inst_pos + 1, attr_mask);
 	}
@@ -2702,13 +2702,43 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 	HCL_ASSERT (hcl, nargs + nrvars == hcl->c->tv.wcount - saved_tv_wcount);
 
 	obj = HCL_CNODE_CONS_CDR(obj);
-	tv_dup_start = hcl->c->tv.s.len;
-	if (collect_vardcls(hcl, obj, &obj, tv_dup_start, &nlvars, "local") <= -1) return -1;
 
-	if (nlvars > MAX_CODE_NBLKLVARS)
+	if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
 	{
-		hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); 
+		hcl_cnode_t* bdy;
-		return -1;
+
+		if (!obj || !HCL_CNODE_IS_CONS(obj))
+		{
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(args), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+			return -1;
+		}
+
+		bdy = HCL_CNODE_CONS_CAR(obj);
+		if (!bdy || !HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK))
+		{
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCK, HCL_CNODE_GET_LOC(obj), HCL_NULL, "block expression expected as body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+			return -1;
+		}
+
+		if (HCL_CNODE_CONS_CDR(bdy))
+		{
+			/* TODO: change error code */
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(obj), HCL_NULL, "redundant code prohibited after body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+			return -1;
+		}
+
+		nlvars = 0; /* no known local variables until the actual block is processed */
+	}
+	else
+	{
+		tv_dup_start = hcl->c->tv.s.len;
+		if (collect_vardcls(hcl, obj, &obj, tv_dup_start, &nlvars, "local") <= -1) return -1;
+
+		if (nlvars > MAX_CODE_NBLKLVARS)
+		{
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+			return -1;
+		}
 	}
 
 	HCL_ASSERT (hcl, nargs + nrvars + nlvars == hcl->c->tv.wcount - saved_tv_wcount);
@@ -2726,8 +2756,8 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 	}
 	else
 	{
-		/* MAKE_BLOCK attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */
+		/* MAKE_LAMBDA attr_mask_1 attr_mask_2 - will patch attr_mask in pop_fnblk() */
-		if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
+		if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_LAMBDA, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
 	}
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);  /* guaranteed in emit_byte_instruction() */
@@ -3791,6 +3821,10 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 	return 0;
 }
 
+static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets)
+{
+}
+
 static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
 {
 	hcl_var_info_t vi;
@@ -4112,9 +4146,12 @@ redo:
 					break;
 
 				case HCL_CONCODE_BLOCK:
-					/* TODO: not implemented yet */
+					if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK))
-					hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - block not implemented");
+					{
-					return -1;
+						hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCKBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "block expression disallowed");
+						return -1;
+					}
+					if (compile_cons_block_expression(hcl, oprnd, 0) <= -1) return -1;
 					break;
 
 				case HCL_CONCODE_ARRAY:
@@ -4158,6 +4195,11 @@ redo:
 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty message send list");
 					return -1;
 
+				case HCL_CONCODE_BLOCK:
+					/* TODO: may have to allow it..  */
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block list");
+					return -1;
+
 				case HCL_CONCODE_ARRAY:
 					if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
 					goto done;
@@ -5237,6 +5279,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 	hcl_bitmask_t log_default_type_mask;
 	hcl_fnblk_info_t top_fnblk_saved;
 
+	hcl->c->flags = flags;
+
 	HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0);
 	if (flags & HCL_COMPILE_CLEAR_CODE)
 	{
@@ -5292,7 +5336,7 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 
 		/* keep a virtual function block for the top-level compilation.
 		 * pass HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos because there is
-		 * no actual MAKE_BLOCK/MAKE_FUNCTION instruction which otherwise
+		 * no actual MAKE_LAMBDA/MAKE_FUNCTION instruction which otherwise
 		 * would be patched in pop_fnblk(). */
 		if (push_fnblk(hcl, HCL_NULL, 0, 0, 0, hcl->c->tv.wcount, hcl->c->tv.wcount, hcl->c->tv.s.len, HCL_TYPE_MAX(hcl_oow_t), 0, FUN_PLAIN) <= -1) return -1; /* must not goto oops */
 	}

lib/decode.c

@@ -712,14 +712,14 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
 				break;
 			}
 
-			case HCL_CODE_MAKE_BLOCK:
+			case HCL_CODE_MAKE_LAMBDA:
 				/* b1 - block mask
 				 * b2 - block mask */
 				FETCH_PARAM_CODE_TO (hcl, b1);
 				FETCH_PARAM_CODE_TO (hcl, b2);
 				b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
 
-				LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu", 
+				LOG_INST_5 (hcl, "make_lambda %zu %zu %zu %zu %zu",
 					GET_BLK_MASK_INSTA(b1),
 					GET_BLK_MASK_VA(b1),
 					GET_BLK_MASK_NARGS(b1),

lib/err.c

@@ -160,7 +160,9 @@ static char* synerrstr[] =
 	"unbalanced key/value pair",
 	"unbalanced parenthesis/brace/bracket",
 	"empty x-list",
-	"empty m-list"
+	"empty m-list",
+	"block expression expected"
+	"block expression disallowed"
 };
 
 /* --------------------------------------------------------------------------

lib/exec.c

@@ -427,13 +427,13 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
 	func->attr_mask = HCL_SMOOI_TO_OOP(attr_mask);
 }
 
-static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
+static HCL_INLINE hcl_oop_lambda_t make_lambda (hcl_t* hcl)
 {
 	/* create a base block used for creation of a block context */
-	return (hcl_oop_block_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS);
+	return (hcl_oop_lambda_t)hcl_allocoopobj(hcl, HCL_BRAND_LAMBDA, HCL_BLOCK_NAMED_INSTVARS);
 }
 
-static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
+static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_lambda_t blk, hcl_ooi_t attr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
 {
 	HCL_ASSERT (hcl, attr_mask >= 0 && attr_mask <= HCL_SMOOI_MAX);
 	HCL_ASSERT (hcl, ip >= 0 && ip <= HCL_SMOOI_MAX);
@@ -1897,7 +1897,7 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle)
 
 /* ------------------------------------------------------------------------- */
 
-static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx)
+static int prepare_new_context (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx)
 {
 	/* prepare a new block context for activation.
 	 * the passed block context becomes the base for a new block context. */
@@ -1908,7 +1908,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na
 	hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs;
 
 	/* the receiver must be a block context */
-	HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
+	HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
 
 	attr_mask = HCL_OOP_TO_SMOOI(op_blk->attr_mask);
 
@@ -1992,11 +1992,11 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t na
 	return 0;
 }
 
-static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t nargs, hcl_ooi_t nrvars, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx)
+static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_lambda_t op_blk, hcl_ooi_t nargs, hcl_ooi_t nrvars, int is_msgsend, hcl_ooi_t msg_ivaroff, hcl_oop_context_t* pnewctx)
 {
 	int x;
 
-	HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
+	HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
 
 	x = prepare_new_context(
 		hcl,
@@ -2018,12 +2018,12 @@ static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_
 
 static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrvars)
 {
-	hcl_oop_block_t op_blk;
+	hcl_oop_lambda_t op_blk;
 	hcl_oop_context_t newctx;
 	int x;
 
-	op_blk = (hcl_oop_block_t)HCL_STACK_GETOP(hcl, nargs);
+	op_blk = (hcl_oop_lambda_t)HCL_STACK_GETOP(hcl, nargs);
-	HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
+	HCL_ASSERT (hcl, HCL_IS_LAMBDA(hcl, op_blk));
 
 	x = __activate_block(hcl, op_blk, nargs, nrvars, 0, 0, &newctx);
 	if (HCL_UNLIKELY(x <= -1)) return -1;
@@ -2143,7 +2143,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
 
 /* ------------------------------------------------------------------------- */
 
-static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner)
+static hcl_oop_lambda_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner)
 {
 	hcl_oocs_t name;
 
@@ -2184,7 +2184,7 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
 					/* ivaroff isn't useful for a clas smethod but is useful for class instatiation method
 					 * (INSTA bit on in the mask field) */
 					*ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super);
-					return (hcl_oop_block_t)HCL_CONS_CAR(val); /* car - class method, cdr - instance method */
+					return (hcl_oop_lambda_t)HCL_CONS_CAR(val); /* car - class method, cdr - instance method */
 				}
 			}
 		}
@@ -2195,7 +2195,7 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
 	return HCL_NULL;
 }
 
-static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner)
+static hcl_oop_lambda_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op_name, int to_super, hcl_ooi_t* ivaroff, hcl_oop_class_t* owner)
 {
 	hcl_oocs_t name;
 
@@ -2232,7 +2232,7 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
 					/* TODO: futher check if it's a method block? */
 					*owner = class_;
 					*ivaroff = HCL_OOP_TO_SMOOI(class_->nivars_super);
-					return (hcl_oop_block_t)HCL_CONS_CDR(val); /* car - class method, cdr - instance method */
+					return (hcl_oop_lambda_t)HCL_CONS_CDR(val); /* car - class method, cdr - instance method */
 				}
 			}
 		}
@@ -2245,7 +2245,7 @@ static hcl_oop_block_t find_imethod_noseterr (hcl_t* hcl, hcl_oop_class_t class_
 
 static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, int to_super, hcl_ooi_t nargs, hcl_ooi_t nrvars)
 {
-	hcl_oop_block_t mth_blk;
+	hcl_oop_lambda_t mth_blk;
 	hcl_oop_context_t newctx;
 	hcl_oop_class_t class_, owner;
 	hcl_ooi_t ivaroff;
@@ -3688,7 +3688,7 @@ static int execute (hcl_t* hcl)
 				LOG_INST_2 (hcl, "call %zu %zu", b1, b2);
 
 				rcv = HCL_STACK_GETOP(hcl, b1);
-				if (HCL_IS_BLOCK(hcl, rcv))
+				if (HCL_IS_LAMBDA(hcl, rcv))
 				{
 					if (activate_block(hcl, b1, b2) <= -1) goto call2_failed;
 					break;
@@ -3729,7 +3729,7 @@ static int execute (hcl_t* hcl)
 							if (activate_function(hcl, b1) <= -1) goto call_failed;
 							break;
 
-						case HCL_BRAND_BLOCK:
+						case HCL_BRAND_LAMBDA:
 							if (activate_block(hcl, b1, 0) <= -1) goto call_failed;
 							break;
 
@@ -4611,16 +4611,16 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				break;
 			}
 
-			case HCL_CODE_MAKE_BLOCK:
+			case HCL_CODE_MAKE_LAMBDA:
 			{
-				hcl_oop_block_t blkobj;
+				hcl_oop_lambda_t blkobj;
 
 				/* b1 - block temporaries mask
 				 * b2 - block temporaries mask */
 				FETCH_PARAM_CODE_TO (hcl, b1);
 				FETCH_PARAM_CODE_TO (hcl, b2);
 				b1 = (b1 << (8 * HCL_CODE_LONG_PARAM_SIZE)) | b2;
-				LOG_INST_5 (hcl, "make_block %zu %zu %zu %zu %zu", 
+				LOG_INST_5 (hcl, "make_lambda %zu %zu %zu %zu %zu",
 					GET_BLK_MASK_INSTA(b1),
 					GET_BLK_MASK_VA(b1),
 					GET_BLK_MASK_NARGS(b1),
@@ -4629,7 +4629,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 
 				HCL_ASSERT (hcl, b1 >= 0);
 
-				blkobj = make_block(hcl);
+				blkobj = make_lambda(hcl);
 				if (HCL_UNLIKELY(!blkobj)) goto oops;
 
 				/* the long forward jump instruction has the format of
@@ -4790,13 +4790,13 @@ hcl_pfrc_t hcl_pf_process_current (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 
 hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
-	hcl_oop_block_t blk;
+	hcl_oop_lambda_t blk;
 	hcl_oop_context_t newctx;
 	hcl_oop_process_t newprc;
 	int x;
 
-	blk = (hcl_oop_block_t)HCL_STACK_GETARG(hcl, nargs, 0);
+	blk = (hcl_oop_lambda_t)HCL_STACK_GETARG(hcl, nargs, 0);
-	if (!HCL_IS_BLOCK(hcl, blk))
+	if (!HCL_IS_LAMBDA(hcl, blk))
 	{
 		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not block - %O", blk);
 		return HCL_PF_FAILURE;

lib/hcl-prv.h

@@ -641,6 +641,9 @@ struct hcl_frd_t
 
 struct hcl_compiler_t
 {
+	/* flags passed in via hcl_compile() */
+	int flags;
+
 	/* callback pointer registerd upon compiler creation */
 	hcl_cb_t* cbp;
 
@@ -758,13 +761,13 @@ struct hcl_compiler_t
 
 
 
-/* hcl_context_t, hcl_block_t, hcl_function_t stores the local variable information
+/* hcl_context_t, hcl_lambda_t, hcl_function_t stores the local variable information
  *
  * Use up to 29 bits in a 32-bit hcl_ooi_t. Exclude the tag bit and the sign bit.
  * | SIGN | INSTA | VA | NARGS | NRVARS | NLVARS | TAG |
  *     1            1     8       8        11        2    <= 32
  * -----------------------------------------------------------
- * Parameters to the MAKE_BLOCK or MAKE_FUNCTION instructions
+ * Parameters to the MAKE_LAMBDA or MAKE_FUNCTION instructions
  *  | INSTA | VA | NARGS | NRVARS | NLVARS
  *    1       1      4      4        6         <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params)
  *    1       1      8      8        11        <= 32 (HCL_CODE_LONG_PARAM_SIZE 2, two params, use 29 bits to avoid collection when converted to a smooi)
@@ -1158,7 +1161,7 @@ enum hcl_bcode_t
 	HCL_CODE_RETURN_FROM_BLOCK        = 0xFC, /* 252, return the stack top from a block */
 
 	HCL_CODE_MAKE_FUNCTION            = 0xFD, /* 253 */
-	HCL_CODE_MAKE_BLOCK               = 0xFE, /* 254 */
+	HCL_CODE_MAKE_LAMBDA               = 0xFE, /* 254 */
 	HCL_CODE_NOOP                     = 0xFF  /* 255 */
 };
 

lib/hcl.h

@@ -164,8 +164,11 @@ enum hcl_synerrnum_t
 	HCL_SYNERR_CALLABLE,      /* invalid callable */
 	HCL_SYNERR_UNBALKV,       /* unbalanced key/value pair */
 	HCL_SYNERR_UNBALPBB,      /* unbalanced parenthesis/brace/bracket */
+	HCL_SYNERR_SEMICOLON,     /* unexpected semicolon */
 	HCL_SYNERR_EMPTYXLIST,    /* empty x-list */
-	HCL_SYNERR_EMPTYMLIST     /* empty m-list */
+	HCL_SYNERR_EMPTYMLIST,    /* empty m-list */
+	HCL_SYNERR_BLOCK,         /* block expression expected */
+	HCL_SYNERR_BLOCKBANNED    /* block expression disallowed */
 };
 typedef enum hcl_synerrnum_t hcl_synerrnum_t;
 
@@ -575,8 +578,8 @@ typedef struct hcl_function_t hcl_function_t;
 typedef struct hcl_function_t* hcl_oop_function_t;
 
 #define HCL_BLOCK_NAMED_INSTVARS 3
-typedef struct hcl_block_t hcl_block_t;
+typedef struct hcl_lambda_t hcl_lambda_t;
-typedef struct hcl_block_t* hcl_oop_block_t;
+typedef struct hcl_lambda_t* hcl_oop_lambda_t;
 
 #define HCL_CONTEXT_NAMED_INSTVARS 9
 typedef struct hcl_context_t hcl_context_t;
@@ -600,10 +603,10 @@ struct hcl_function_t
 };
 
 /* hcl_function_t copies the byte codes and literal frames into itself
- * hlc_block_t contains minimal information(ip) for referening byte codes
+ * hlc_lambda_t contains minimal information(ip) for referening byte codes
  * and literal frames available in home->origin.
  */
-struct hcl_block_t
+struct hcl_lambda_t
 {
 	HCL_OBJ_HEADER;
 
@@ -692,10 +695,10 @@ struct hcl_process_t
 	hcl_oop_t         id; /* SmallInteger */
 	hcl_oop_t         state; /* SmallInteger */
 
-	hcl_oop_t         sp;    /* stack pointer. SmallInteger */
+	hcl_oop_t         sp;   /* stack pointer. SmallInteger */
 	hcl_oop_t         st;   /* stack top */
 
-	hcl_oop_t         exsp;  /* exception stack pointer. SmallInteger */
+	hcl_oop_t         exsp; /* exception stack pointer. SmallInteger */
 	hcl_oop_t         exst; /* exception stack top */
 
 	hcl_oop_t         clsp; /* class stack pointer */
@@ -1491,7 +1494,10 @@ enum hcl_compile_flag_t
 	HCL_COMPILE_CLEAR_CODE  = (1 << 0),
 
 	/* clear the top-level function block at the end of hcl_compile() */
-	HCL_COMPILE_CLEAR_FNBLK = (1 << 1)
+	HCL_COMPILE_CLEAR_FNBLK = (1 << 1),
+
+	/* enable the block {} mode */
+	HCL_COMPILE_ENABLE_BLOCK = (1 << 2)
 };
 typedef enum hcl_compile_flag_t hcl_compile_flag_t;
 #endif
@@ -1868,7 +1874,7 @@ enum hcl_brand_t
 	HCL_BRAND_PRIM,
 
 	HCL_BRAND_FUNCTION,
-	HCL_BRAND_BLOCK,
+	HCL_BRAND_LAMBDA,
 	HCL_BRAND_CONTEXT,
 	HCL_BRAND_PROCESS,
 	HCL_BRAND_PROCESS_SCHEDULER,
@@ -1934,7 +1940,7 @@ typedef enum hcl_concode_t hcl_concode_t;
 #define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY)
 #define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)
 #define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
-#define HCL_IS_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK)
+#define HCL_IS_LAMBDA(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_LAMBDA)
 #define HCL_IS_CLASS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CLASS)
 #define HCL_IS_INSTANCE(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INSTANCE)
 #define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)

lib/print.c

@@ -88,7 +88,7 @@ enum
 	WORD_PRIM,
 
 	WORD_FUNCTION,
-	WORD_BLOCK,
+	WORD_LAMBDA,
 	WORD_CONTEXT,
 	WORD_PROCESS,
 	WORD_PROCESS_SCHEDULER,
@@ -113,7 +113,7 @@ static struct
 	{  7,  { '#','<','P','R','I','M','>' } },
 
 	{  11, { '#','<','F','U','N','C','T','I','O','N','>' } },
-	{  11, { '#','<','B','L','O','C','K','>' } },
+	{  9,  { '#','<','L','A','M','B','D','A','>' } },
 	{  10, { '#','<','C','O','N','T','E','X','T','>' } },
 	{  10, { '#','<','P','R','O','C','E','S','S','>' } },
 	{  20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
@@ -677,8 +677,8 @@ next:
 			word_index = WORD_FUNCTION;
 			goto print_word;
 
-		case HCL_BRAND_BLOCK:
+		case HCL_BRAND_LAMBDA:
-			word_index = WORD_BLOCK;
+			word_index = WORD_LAMBDA;
 			goto print_word;
 
 		case HCL_BRAND_CONTEXT:

lib/read.c

@@ -673,10 +673,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv
 static HCL_INLINE int is_at_block_beginning (hcl_t* hcl)
 {
 	hcl_rstl_t* rstl;
-
-	//HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
 	rstl = hcl->c->r.st;
-
 	return !rstl || LIST_FLAG_GET_CONCODE(rstl->flagv) == HCL_CONCODE_BLOCK && rstl->count <= 0;
 }
 
@@ -876,12 +873,10 @@ static int on_fed_cnode (hcl_t* hcl, hcl_cnode_t* obj)
 static void init_feed (hcl_t* hcl)
 {
 	HCL_MEMSET (&hcl->c->feed, 0, HCL_SIZEOF(hcl->c->feed));
-
 	hcl->c->feed.lx.state = HCL_FLX_START;
 	hcl->c->feed.lx.loc.line = 1;
 	hcl->c->feed.lx.loc.colm = 1;
 	hcl->c->feed.lx.loc.file = HCL_NULL;
-
 	hcl->c->feed.on_cnode = on_fed_cnode;
 }
 
@@ -1101,6 +1096,7 @@ static int feed_process_token (hcl_t* hcl)
 		case HCL_TOK_LBRACE: /* { */
 			frd->flagv = 0;
 			LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_BLOCK);
+hcl_logbfmt (hcl, HCL_LOG_FATAL, "XXXX [%d,%d]\n", TOKEN_LOC(hcl)->line, TOKEN_LOC(hcl)->colm);
 			goto start_list;
 
 		case HCL_TOK_DLPAREN: /* #{ */
@@ -1176,14 +1172,15 @@ static int feed_process_token (hcl_t* hcl)
 			if (frd->level <= 0)
 			{
 				/* redundant semicolons */
-				hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
+				/* TOD: change  error info or code */
+				hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL);
 				goto oops;
 			}
 
 			if (!(frd->flagv & AUTO_FORGED))
 			{
-				/* TODO: change error info */
+				/* TODO: change error info or code */
-				hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
+				hcl_setsynerr (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), HCL_NULL);
 				goto oops;
 			}
 
@@ -1194,6 +1191,7 @@ static int feed_process_token (hcl_t* hcl)
 				hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
 				goto oops;
 			}
+hcl_logbfmt(hcl, HCL_LOG_FATAL, "forged xlist...exiting..OK\n");
 
 			frd->obj = leave_list(hcl, &frd->flagv, &oldflagv);
 			frd->level--;
@@ -1388,6 +1386,7 @@ static int feed_process_token (hcl_t* hcl)
 			{
 				hcl_oop_t obj = frd->obj;
 
+hcl_logbfmt(hcl, HCL_LOG_FATAL, "QQQQQQQQQQQQ forged xlist...\n");
 				frd->flagv = AUTO_FORGED;
 				LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_XLIST);