writing code to implement return variables

lib/cnode.c

@@ -72,6 +72,12 @@ hcl_cnode_t* hcl_makecnodeellipsis (hcl_t* hcl, const hcl_ioloc_t* loc, const  h
 	return make_cnode(hcl, HCL_CNODE_ELLIPSIS, loc, tok);
 }
 
+hcl_cnode_t* hcl_makecnodetrpcolons (hcl_t* hcl, const hcl_ioloc_t* loc, const  hcl_oocs_t* tok)
+{
+	return make_cnode(hcl, HCL_CNODE_TRPCOLONS, loc, tok);
+}
+
+
 hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const  hcl_oocs_t* tok, const hcl_ooch_t v)
 {
 	hcl_cnode_t* c =  make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok);

lib/comp.c

@@ -642,12 +642,15 @@ static HCL_INLINE void patch_double_long_params_with_oow (hcl_t* hcl, hcl_ooi_t
 static int emit_indexed_variable_access (hcl_t* hcl, hcl_oow_t index, hcl_oob_t baseinst1, hcl_oob_t baseinst2, const hcl_ioloc_t* srcloc)
 {
 	hcl_oow_t i;
+	hcl_fnblk_info_t* fbi;
+
 
 	HCL_ASSERT (hcl, hcl->c->fnblk.depth >= 0);
+	fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth];
 
 	/* if a temporary variable is accessed inside a block,
 	 * use a special instruction to indicate it */
-	HCL_ASSERT (hcl, index < hcl->c->fnblk.info[hcl->c->fnblk.depth].tmprcnt);
+	HCL_ASSERT (hcl, index < fbi->tmprcnt);
 	for (i = hcl->c->fnblk.depth; i >= 0; i--)
 	{
 		hcl_oow_t parent_tmprcnt;
@@ -664,6 +667,11 @@ static int emit_indexed_variable_access (hcl_t* hcl, hcl_oow_t index, hcl_oob_t
 			 * index_in_ctx is a relative index within the context found.
 			 */
 			if (emit_double_param_instruction(hcl, baseinst1, ctx_offset, index_in_ctx, srcloc) <= -1) return -1;
+			if (ctx_offset > 0) 
+			{
+				fbi->access_outer = 1; /* the current function block accesses temporaries in an outer function block */
+				hcl->c->fnblk.info[i].accessed_by_inner = 1; /* temporaries in an outer function block is accessed by the current function block */
+			}
 			return 0;
 		}
 	}
@@ -717,6 +725,8 @@ static int push_fnblk (hcl_t* hcl, const hcl_ioloc_t* errloc,
 
 	hcl->c->fnblk.info[new_depth].make_inst_pos = make_inst_pos;
 	hcl->c->fnblk.info[new_depth].lfbase = lfbase;
+	hcl->c->fnblk.info[new_depth].access_outer = 0;
+	hcl->c->fnblk.info[new_depth].accessed_by_inner = 0;
 	hcl->c->fnblk.depth = new_depth;
 	return 0;
 }
@@ -1704,12 +1714,13 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 
 	/* process the argument list */
 	va = 0;
+	nargs = 0;
+	nrvars = 0;
 	args = HCL_CNODE_CONS_CAR(obj);
 	HCL_ASSERT (hcl, args != HCL_NULL);
 	if (HCL_CNODE_IS_ELIST_CONCODED(args, HCL_CONCODE_XLIST))
 	{
 		/* empty list - no argument - (lambda () (+ 10 20)) */
-		nargs = 0;
 	}
 	else if (!HCL_CNODE_IS_CONS(args))
 	{
@@ -1719,39 +1730,84 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 	else
 	{
 		hcl_cnode_t* arg, * dcl;
+		int in_ret_args = 0;
 
 		tv_dup_start = hcl->c->tv.s.len;
-		nargs = 0;
 		dcl = args;
 		do
 		{
 			arg = HCL_CNODE_CONS_CAR(dcl);
-			if (HCL_CNODE_IS_ELLIPSIS(arg))
-			{
-				va = 1;
-				break;
-			}
-			else if (!HCL_CNODE_IS_SYMBOL(arg))
-			{
-				hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "argument not a symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
-				return -1;
-			}
 
-			if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
+			if (in_ret_args)
 			{
-				hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "special symbol not to be declared as an argument in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+				if (!HCL_CNODE_IS_SYMBOL(arg))
-				return -1;
-			}
-
-			if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) 
-			{
-				if (hcl->errnum == HCL_EEXIST)
 				{
-					hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "argument duplicate in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "return variable not a symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					return -1;
+				}
+
+				if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
+				{
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "special symbol not to be declared as a return variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					return -1;
+				}
+
+				if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) 
+				{
+					if (hcl->errnum == HCL_EEXIST)
+					{
+						hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAMEDUP, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "return variable duplicate in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					}
+					return -1;
+				}
+				nrvars++;
+			}
+			else if (va)
+			{
+				if (HCL_CNODE_IS_TRPCOLONS(arg))
+				{
+					in_ret_args = 1;
+				}
+				else
+				{
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_CNODE, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "unexpected element in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					return -1;
+				}
+			}
+			else
+			{
+				if (HCL_CNODE_IS_TRPCOLONS(arg)) 
+				{
+					in_ret_args = 1;
+				}
+				else if (HCL_CNODE_IS_ELLIPSIS(arg))
+				{
+					va = 1;
+				}
+				else if (!HCL_CNODE_IS_SYMBOL(arg))
+				{
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "argument not a symbol in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+					return -1;
+				}
+				else
+				{
+					if (HCL_CNODE_IS_SYMBOL(arg) && HCL_CNODE_SYMBOL_SYNCODE(arg) /* || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2 */)
+					{
+						hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "special symbol not to be declared as an argument in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+						return -1;
+					}
+
+					if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(arg), tv_dup_start) <= -1) 
+					{
+						if (hcl->errnum == HCL_EEXIST)
+						{
+							hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(arg), HCL_CNODE_GET_TOK(arg), "argument duplicate in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+						}
+						return -1;
+					}
+					nargs++;
 				}
-				return -1;
 			}
-			nargs++;
 
 			dcl = HCL_CNODE_CONS_CDR(dcl);
 			if (!dcl) break;
@@ -1765,7 +1821,6 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 		while (1);
 	}
 
-	HCL_ASSERT (hcl, nargs == hcl->c->tv.wcount - saved_tv_wcount);
 	if (nargs > MAX_CODE_NBLKARGS) /*TODO: change this limit to max call argument count */
 	{
 		/* while an integer object is pused to indicate the number of
@@ -1776,10 +1831,9 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
 		return -1;
 	}
 
-	nrvars = 0; /* TODO: support return variables , */
 	if (nrvars > MAX_CODE_NBLKLVARS)
 	{
-		hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) return variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); 
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(args), HCL_NULL, "too many(%zu) return variables in %.*js", nrvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); 
 		return -1;
 	}
 	HCL_ASSERT (hcl, nargs + nrvars == hcl->c->tv.wcount - saved_tv_wcount);
@@ -2884,7 +2938,7 @@ redo:
 					goto done;
 
 				case HCL_CONCODE_VLIST:
-					hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELLIPSISBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "variable declaration disallowed");
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "variable declaration disallowed");
 					return -1;
 
 				default:
@@ -2901,8 +2955,13 @@ redo:
 			goto redo;
 
 		case HCL_CNODE_ELLIPSIS:
-			hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "ellipsis disallowed in this context", HCL_CNODE_GET_TYPE(oprnd));
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELLIPSISBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "ellipsis disallowed in this context", HCL_CNODE_GET_TYPE(oprnd));
 			return -1;
+
+		case HCL_CNODE_TRPCOLONS:
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_TRPCOLONSBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "triple colons disallowed in this context", HCL_CNODE_GET_TYPE(oprnd));
+			return -1;
+
 			
 		default:
 			hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "internal error - unexpected object type %d", HCL_CNODE_GET_TYPE(oprnd));

lib/err.c

@@ -91,6 +91,7 @@ static char* synerrstr[] =
 {
 	"no error",
 	"internal error",
+	"unexpected compiler node",
 	"illegal character",
 	"illegal token",
 	"comment not closed",
@@ -126,6 +127,7 @@ static char* synerrstr[] =
 	"#include error",
 
 	"... disallowed",
+	"::: disallowed",
 	"loop body too big",
 	"if body too big",
 	"lambda block too big",

lib/hcl-prv.h

@@ -150,6 +150,7 @@ enum hcl_iotok_type_t
 	HCL_IOTOK_DOT,
 	HCL_IOTOK_ELLIPSIS,
 	HCL_IOTOK_COLON,
+	HCL_IOTOK_TRPCOLONS,
 	HCL_IOTOK_COMMA,
 	HCL_IOTOK_LPAREN,
 	HCL_IOTOK_RPAREN,
@@ -197,6 +198,7 @@ enum hcl_cnode_type_t
 	HCL_CNODE_TRUE,
 	HCL_CNODE_FALSE,
 	HCL_CNODE_ELLIPSIS,
+	HCL_CNODE_TRPCOLONS,
 
 	HCL_CNODE_CONS,
 	HCL_CNODE_ELIST, /* empty list */
@@ -211,6 +213,7 @@ typedef enum hcl_cnode_type_t hcl_cnode_type_t;
 #define HCL_CNODE_GET_TOKLEN(x) ((x)->cn_tok.len)
 
 #define HCL_CNODE_IS_ELLIPSIS(x) ((x)->cn_type == HCL_CNODE_ELLIPSIS)
+#define HCL_CNODE_IS_TRPCOLONS(x) ((x)->cn_type == HCL_CNODE_TRPCOLONS)
 
 #define HCL_CNODE_IS_SYMBOL(x) ((x)->cn_type == HCL_CNODE_SYMBOL)
 #define HCL_CNODE_IS_SYMBOL_SYNCODED(x, code) ((x)->cn_type == HCL_CNODE_SYMBOL && (x)->u.symbol.syncode == (code))
@@ -400,6 +403,9 @@ struct hcl_fnblk_info_t
 	hcl_oow_t lfbase;
 
 	hcl_ooi_t cblk_base;
+
+	unsigned int access_outer: 1;
+	unsigned int accessed_by_inner: 1;
 };
 typedef struct hcl_fnblk_info_t hcl_fnblk_info_t;
 

lib/hcl.h

@@ -97,6 +97,7 @@ enum hcl_synerrnum_t
 {
 	HCL_SYNERR_NOERR,
 	HCL_SYNERR_INTERN,        /* internal error */
+	HCL_SYNERR_CNODE,         /* unexpected compiler node */
 	HCL_SYNERR_ILCHR,         /* illegal character */
 	HCL_SYNERR_ILTOK,         /* invalid token */
 	HCL_SYNERR_CMTNC,         /* comment not closed */
@@ -132,6 +133,7 @@ enum hcl_synerrnum_t
 	HCL_SYNERR_INCLUDE,       /* #include error */
 
 	HCL_SYNERR_ELLIPSISBANNED, /* ... disallowed */
+	HCL_SYNERR_TRPCOLONSBANNED, /* ::: disallowed */
 	HCL_SYNERR_LOOPFLOOD,     /* loop body too big */
 	HCL_SYNERR_IFFLOOD,       /* if body too big */
 	HCL_SYNERR_BLKFLOOD,      /* lambda block too big */

lib/read.c

@@ -1085,7 +1085,7 @@ retry:
 				hcl_iolxc_t sd;
 				hcl_ooci_t oldc2;
 
-				sd = hcl->c->lxc; /* back up '#' */
+				sd = hcl->c->lxc; 
 
 				oldc2 = c;
 				GET_CHAR_TO (hcl, c);
@@ -1117,10 +1117,40 @@ retry:
 			break;
 
 		case ':':
+			oldc = c;
+			GET_CHAR_TO (hcl, c);
+			if(c == ':')
+			{
+				hcl_iolxc_t sd;
+				hcl_ooci_t oldc2;
+
+				sd = hcl->c->lxc;
+
+				oldc2 = c;
+				GET_CHAR_TO (hcl, c);
+				if (c == ':')
+				{
+					SET_TOKEN_TYPE (hcl, HCL_IOTOK_TRPCOLONS);
+					ADD_TOKEN_CHAR (hcl, oldc);
+					ADD_TOKEN_CHAR (hcl, oldc2);
+					ADD_TOKEN_CHAR (hcl, c);
+					break;
+				}
+
+				unget_char (hcl, &hcl->c->lxc);
+				unget_char (hcl, &sd);
+			}
+			else
+			{
+				unget_char (hcl, &hcl->c->lxc);
+			}
+			c = oldc;
+
 			SET_TOKEN_TYPE (hcl, HCL_IOTOK_COLON);
 			ADD_TOKEN_CHAR (hcl, c);
 			break;
 
+
 		case '\"':
 			if (get_string(hcl, '\"', '\\', 0, 0) <= -1) return -1;
 			break;
@@ -1943,6 +1973,10 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
 				obj = hcl_makecnodeellipsis(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
 				break;
 
+			case HCL_IOTOK_TRPCOLONS:
+				obj = hcl_makecnodetrpcolons(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
+				break;
+
 			case HCL_IOTOK_SMPTRLIT:
 			{
 				hcl_oow_t i;