hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

writing code to implement return variables

Browse Source
This commit is contained in:
hyung-hwan 2021-05-09 15:32:54 +00:00
parent 01719d0056
commit 391d62511b
6 changed files with 139 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lib/cnode.c
View File

@ -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);

81
lib/comp.c
View File

@ -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,24 +1730,67 @@ 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))
if (in_ret_args)
{
if (!HCL_CNODE_IS_SYMBOL(arg))
{
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;
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;
}
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));
@ -1752,6 +1806,8 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
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,9 +2955,14 @@ 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));
return -1;

2
lib/err.c
View File

@ -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",

6
lib/hcl-prv.h
View File

@ -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;

2
lib/hcl.h
View File

@ -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 */

36
lib/read.c
View File

@ -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;