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

fixed many more issue in compiling block expressoins
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2023-11-12 21:54:17 +09:00
parent 268eae3e53
commit 8cb9178820
6 changed files with 252 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lib/cnode.c
View File

@ -94,7 +94,7 @@ hcl_cnode_t* hcl_makecnodedcstar (hcl_t* hcl, const hcl_loc_t* loc, const hcl_o
hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v) hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.charlit.v = v; c->u.charlit.v = v;
return c; return c;
@ -102,7 +102,7 @@ hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_
hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok) hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, tok); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok); c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok);
return c; return c;
@ -135,7 +135,7 @@ hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_
hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v) hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, tok); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.smptrlit.v = v; c->u.smptrlit.v = v;
return c; return c;
@ -143,15 +143,15 @@ hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_
hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v) hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, tok); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.errlit.v = v; c->u.errlit.v = v;
return c; return c;
} }
hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr) hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_cnode_t* car, hcl_cnode_t* cdr)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, HCL_NULL); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, tok);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.cons.car = car; c->u.cons.car = car;
c->u.cons.cdr = cdr; c->u.cons.cdr = cdr;
@ -160,7 +160,7 @@ hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* c
hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type) hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ELIST, loc, HCL_NULL); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ELIST, loc, HCL_NULL);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.elist.concode = type; c->u.elist.concode = type;
return c; return c;
@ -168,7 +168,7 @@ hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t
hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj) hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SHELL, loc, HCL_NULL); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SHELL, loc, HCL_NULL);
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.shell.obj = obj; c->u.shell.obj = obj;
return c; return c;

83
lib/comp.c
View File

@ -1232,14 +1232,14 @@ static HCL_INLINE void pop_cframe (hcl_t* hcl)
hcl_cframe_t* _cf = GET_TOP_CFRAME(hcl); \ hcl_cframe_t* _cf = GET_TOP_CFRAME(hcl); \
_cf->opcode = _opcode; \ _cf->opcode = _opcode; \
_cf->operand = _operand; \ _cf->operand = _operand; \
} while (0); } while(0)
#define SWITCH_CFRAME(hcl,_index,_opcode,_operand) \ #define SWITCH_CFRAME(hcl,_index,_opcode,_operand) \
do { \ do { \
hcl_cframe_t* _cf = GET_CFRAME(hcl,_index); \ hcl_cframe_t* _cf = GET_CFRAME(hcl,_index); \
_cf->opcode = _opcode; \ _cf->opcode = _opcode; \
_cf->operand = _operand; \ _cf->operand = _operand; \
} while (0); } while(0)
static int push_subcframe (hcl_t* hcl, int opcode, hcl_cnode_t* operand) static int push_subcframe (hcl_t* hcl, int opcode, hcl_cnode_t* operand)
{ {
@ -1903,35 +1903,48 @@ inside_loop:
/* ========================================================================= */ /* ========================================================================= */
static int compile_do_list (hcl_t* hcl, hcl_cnode_t* src, hcl_cnode_t* obj) static int compile_expression_block (hcl_t* hcl, hcl_cnode_t* src, const hcl_bch_t* ctxname, int is_block)
{ {
hcl_cnode_t* cmd, * tmp; hcl_cnode_t* cmd, * obj, * tmp;
hcl_oow_t nlvars, tvslen; hcl_oow_t nlvars, tvslen;
hcl_fnblk_info_t* fbi; hcl_fnblk_info_t* fbi;
hcl_cframe_t* cf; hcl_cframe_t* cf;
//obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */ if (is_block)
if (!obj)
{ {
/* no value */ HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(src, HCL_CONCODE_BLOCK) || HCL_CNODE_IS_ELIST_CONCODED(src, HCL_CONCODE_BLOCK));
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); cmd = src; /* it's the cons cell itself */
return -1; /* `obj` must point to the cons cell pointing to the braced expression list */
obj = HCL_CNODE_IS_ELIST(src)? HCL_NULL: src;
/* no check for redundant cdr because {} cannot be dotted */
} }
else if (!HCL_CNODE_IS_CONS(obj)) else
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); cmd = HCL_CNODE_CONS_CAR(src); /* `do` itself */
return -1; /* `obj` must point to the expression list after `do` */
obj = HCL_CNODE_CONS_CDR(src); /* expression list after it */
if (obj && !HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj),
"redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
} }
tmp = obj;
tvslen = hcl->c->tv.s.len; tvslen = hcl->c->tv.s.len;
if (collect_vardcls(hcl, obj, &obj, tvslen, &nlvars, "do") <= -1) return -1; nlvars = 0;
if (obj)
if (nlvars > MAX_CODE_NBLKLVARS)
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL, "too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); hcl_cnode_t* tmp = obj;
return -1; if (collect_vardcls(hcl, obj, &obj, tvslen, &nlvars, ctxname) <= -1) return -1;
if (nlvars > MAX_CODE_NBLKLVARS)
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_VARFLOOD, HCL_CNODE_GET_LOC(tmp), HCL_NULL,
"too many(%zu) variables in %.*js", nlvars, HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
} }
fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth]; fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth];
@ -1939,6 +1952,10 @@ static int compile_do_list (hcl_t* hcl, hcl_cnode_t* src, hcl_cnode_t* obj)
fbi->tmprcnt = hcl->c->tv.wcount; fbi->tmprcnt = hcl->c->tv.wcount;
fbi->tmpr_nlvars = fbi->tmpr_nlvars + nlvars; fbi->tmpr_nlvars = fbi->tmpr_nlvars + nlvars;
/* for an expression like `(do )` or `(do | a b | ) , `obj` will point to HCL_NULL.
* let `obj` point to the internal cnode to convert the expression like `(do #nil)` or `(do |a b| #nil)`. */
if (!obj) obj = &hcl->c->fake_cnode.cons_to_nil;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
PUSH_SUBCFRAME (hcl, COP_COMPILE_DO_P1, src); /* 2 */ PUSH_SUBCFRAME (hcl, COP_COMPILE_DO_P1, src); /* 2 */
@ -2008,7 +2025,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
return 0; return 0;
#else #else
return compile_do_list(hcl, src, obj); return compile_expression_block(hcl, src, "do", 0);
#endif #endif
} }
@ -2764,7 +2781,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
return -1; return -1;
} }
bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item */ bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item. bdy is the expression inside */
trl = HCL_CNODE_CONS_CDR(blk); /* something after {} */ trl = HCL_CNODE_CONS_CDR(blk); /* something after {} */
if (!bdy || (!HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK) && !HCL_CNODE_IS_ELIST_CONCODED(bdy, HCL_CONCODE_BLOCK))) if (!bdy || (!HCL_CNODE_IS_CONS_CONCODED(bdy, HCL_CONCODE_BLOCK) && !HCL_CNODE_IS_ELIST_CONCODED(bdy, HCL_CONCODE_BLOCK)))
@ -2781,7 +2798,13 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
return -1; return -1;
} }
obj = HCL_CNODE_IS_ELIST(bdy)? HCL_NULL: bdy; hcl_logbfmt(hcl, HCL_LOG_FATAL, "bdy[%d.%d] blk[%d.%d] obj[%d.%d]\n",
HCL_CNODE_GET_LOC(bdy)->line, HCL_CNODE_GET_LOC(bdy)->colm,
HCL_CNODE_GET_LOC(blk)->line, HCL_CNODE_GET_LOC(blk)->colm,
HCL_CNODE_GET_LOC(obj)->line, HCL_CNODE_GET_LOC(obj)->colm);
//obj = HCL_CNODE_IS_ELIST(bdy)? HCL_NULL: blk /* bdy */;
obj = blk;
nlvars = 0; /* no known local variables until the actual block is processed */ nlvars = 0; /* no known local variables until the actual block is processed */
} }
else else
@ -3879,7 +3902,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj) static int compile_cons_block_expression (hcl_t* hcl, hcl_cnode_t* obj)
{ {
return compile_do_list(hcl, obj, obj); return compile_expression_block(hcl, obj, "block", 1);
} }
static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
@ -4253,9 +4276,13 @@ redo:
return -1; return -1;
case HCL_CONCODE_BLOCK: case HCL_CONCODE_BLOCK:
/* TODO: may have to allow it.. */ if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK))
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block list"); {
return -1; hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty block expression");
return -1;
}
if (compile_cons_block_expression(hcl, oprnd) <= -1) return -1;
break;
case HCL_CONCODE_ARRAY: case HCL_CONCODE_ARRAY:
if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
@ -4438,8 +4465,8 @@ static int compile_object_list (hcl_t* hcl)
* except the last. * except the last.
*/ */
int nextcop; int nextcop;
nextcop = (cop == COP_COMPILE_OBJECT_LIST)? COP_COMPILE_OBJECT_LIST_TAIL: nextcop = (cop == COP_COMPILE_OBJECT_LIST)? COP_COMPILE_OBJECT_LIST_TAIL:
(cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL: (cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL:
(cop == COP_COMPILE_TRY_OBJECT_LIST)? COP_COMPILE_TRY_OBJECT_LIST_TAIL: cop; (cop == COP_COMPILE_TRY_OBJECT_LIST)? COP_COMPILE_TRY_OBJECT_LIST_TAIL: cop;
PUSH_SUBCFRAME (hcl, nextcop, cdr); PUSH_SUBCFRAME (hcl, nextcop, cdr);
} }

11
lib/hcl-prv.h
View File

@ -637,6 +637,7 @@ struct hcl_frd_t
int expect_vlist_item; int expect_vlist_item;
int do_include_file; int do_include_file;
hcl_cnode_t* obj; hcl_cnode_t* obj;
hcl_loc_t list_loc;
}; };
struct hcl_compiler_t struct hcl_compiler_t
@ -756,6 +757,13 @@ struct hcl_compiler_t
hcl_clsblk_info_t* info; hcl_clsblk_info_t* info;
hcl_oow_t info_capa; hcl_oow_t info_capa;
} clsblk; /* class block */ } clsblk; /* class block */
struct
{
hcl_cnode_t cons_to_nil;
hcl_cnode_t nil;
} fake_cnode;
}; };
#endif #endif
@ -1715,11 +1723,12 @@ hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_loc_t* loc, const hc
hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok);
hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v); hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v);
hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v); hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v);
hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr); hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_loc_t* loc, const hcl_oocs_t* tok, hcl_cnode_t* car, hcl_cnode_t* cdr);
hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type); hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_loc_t* loc, hcl_concode_t type);
hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj); hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_loc_t* loc, hcl_cnode_t* obj);
void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c); void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c);
hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons); hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons);
void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* c, int newline);
/* ========================================================================= */ /* ========================================================================= */

52
lib/print.c
View File

@ -784,3 +784,55 @@ int hcl_print (hcl_t* hcl, hcl_oop_t obj)
/*return hcl_outfmtobj(hcl, HCL_LOG_APP | HCL_LOG_FATAL, obj);*/ /*return hcl_outfmtobj(hcl, HCL_LOG_APP | HCL_LOG_FATAL, obj);*/
return hcl_prbfmt(hcl, "%O", obj); return hcl_prbfmt(hcl, "%O", obj);
} }
void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline)
{
int t;
/* TODO: this is incomplete function. make it complete */
if (cnode)
{
t = HCL_CNODE_GET_TYPE(cnode);
switch (t)
{
case HCL_CNODE_CHARLIT:
case HCL_CNODE_SYMBOL:
case HCL_CNODE_DSYMBOL:
case HCL_CNODE_STRLIT:
case HCL_CNODE_NUMLIT:
case HCL_CNODE_RADNUMLIT:
case HCL_CNODE_FPDECLIT:
case HCL_CNODE_SMPTRLIT:
case HCL_CNODE_ERRLIT:
case HCL_CNODE_NIL:
case HCL_CNODE_TRUE:
case HCL_CNODE_FALSE:
case HCL_CNODE_SELF:
case HCL_CNODE_SUPER:
case HCL_CNODE_ELLIPSIS:
case HCL_CNODE_TRPCOLONS:
case HCL_CNODE_DCSTAR:
hcl_logbfmt (hcl, HCL_LOG_FATAL, " %.*js ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode));
break;
case HCL_CNODE_CONS:
hcl_logbfmt (hcl, HCL_LOG_FATAL, " (");
hcl_dumpcnode (hcl, HCL_CNODE_CONS_CAR(cnode), 0);
hcl_dumpcnode (hcl, HCL_CNODE_CONS_CDR(cnode),0);
hcl_logbfmt (hcl, HCL_LOG_FATAL, ") ");
break;
case HCL_CNODE_ELIST:
hcl_logbfmt (hcl, HCL_LOG_FATAL, " () ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode));
break;
case HCL_CNODE_SHELL:
hcl_logbfmt (hcl, HCL_LOG_FATAL, " () ", HCL_CNODE_GET_TOKLEN(cnode), HCL_CNODE_GET_TOKPTR(cnode));
break;
}
}
if (newline) hcl_logbfmt (hcl, HCL_LOG_FATAL, "\n");
}

181
lib/read.c
View File

@ -44,6 +44,7 @@ static struct voca_t
{ {
{ 8, { '#','i','n','c','l','u','d','e' } }, { 8, { '#','i','n','c','l','u','d','e' } },
{ 7, { '#','p','r','a','g','m','a' } }, { 7, { '#','p','r','a','g','m','a' } },
{ 11, { '#','\\','b','a','c','k','s','p','a','c','e' } }, { 11, { '#','\\','b','a','c','k','s','p','a','c','e' } },
{ 10, { '#','\\','l','i','n','e','f','e','e','d' } }, { 10, { '#','\\','l','i','n','e','f','e','e','d' } },
{ 9, { '#','\\','n','e','w','l','i','n','e' } }, { 9, { '#','\\','n','e','w','l','i','n','e' } },
@ -54,6 +55,22 @@ static struct voca_t
{ 7, { '#','\\','s','p','a','c','e' } }, { 7, { '#','\\','s','p','a','c','e' } },
{ 5, { '#','\\','t','a','b' } }, { 5, { '#','\\','t','a','b' } },
{ 6, { '#','\\','v','t','a','b' } }, { 6, { '#','\\','v','t','a','b' } },
{ 4, { 'n','u','l','l' } },
{ 4, { 't','r','u','e' } },
{ 5, { 'f','a','l','s','e' } },
{ 4, { 's','e','l','f' } },
{ 5, { 's','u','p','e','r' } },
{ 3, { '(',' ',')' } },
{ 4, { '(',':',' ',')' } },
{ 3, { '{',' ','}' } },
{ 3, { '[',' ',']' } },
{ 4, { '#','[',' ',']' } },
{ 4, { '#','{',' ','}' } },
{ 4, { '#','(',' ',')' } },
{ 3, { '|',' ','|' } },
{ 5, { '<','E','O','L','>' } }, { 5, { '<','E','O','L','>' } },
{ 5, { '<','E','O','F','>' } } { 5, { '<','E','O','F','>' } }
}; };
@ -63,16 +80,31 @@ enum voca_id_t
VOCA_INCLUDE, VOCA_INCLUDE,
VOCA_PRAGMA, VOCA_PRAGMA,
VOCA_BACKSPACE, VOCA_CHAR_BACKSPACE,
VOCA_LINEFEED, VOCA_CHAR_LINEFEED,
VOCA_NEWLINE, VOCA_CHAR_NEWLINE,
VOCA_NUL, VOCA_CHAR_NUL,
VOCA_PAGE, VOCA_CHAR_PAGE,
VOCA_RETURN, VOCA_CHAR_RETURN,
VOCA_RUBOUT, VOCA_CHAR_RUBOUT,
VOCA_SPACE, VOCA_CHAR_SPACE,
VOCA_TAB, VOCA_CHAR_TAB,
VOCA_VTAB, VOCA_CHAR_VTAB,
VOCA_KW_NULL,
VOCA_KW_TRUE,
VOCA_KW_FALSE,
VOCA_KW_SELF,
VOCA_KW_SUPER,
VOCA_XLIST,
VOCA_MLIST,
VOCA_BLOCK,
VOCA_ARRAY,
VOCA_BYTEARRAY,
VOCA_DIC,
VOCA_QLIST,
VOCA_VLIST,
VOCA_EOL, VOCA_EOL,
VOCA_EOF VOCA_EOF
@ -98,6 +130,25 @@ enum list_flag_t
#define LIST_FLAG_GET_CONCODE(x) (((x) >> 12) & 0x0FFF) #define LIST_FLAG_GET_CONCODE(x) (((x) >> 12) & 0x0FFF)
#define LIST_FLAG_SET_CONCODE(x,type) ((x) = ((x) & ~0xFF000) | ((type) << 12)) #define LIST_FLAG_SET_CONCODE(x,type) ((x) = ((x) & ~0xFF000) | ((type) << 12))
static struct
{
int closer;
hcl_synerrnum_t synerr;
int voca_id;
} cons_info[] =
{
/*[HCL_CONCODE_XLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_XLIST }, /* XLIST ( ) */
/*[HCL_CONCODE_MLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_MLIST }, /* MLIST (: ) */
/*[HCL_CONCODE_BLOCK] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_BLOCK }, /* BLOCK { } */
/*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_ARRAY }, /* ARRAY [ ] */
/*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_BYTEARRAY }, /* BYTEARRAY #[ ] */
/*[HCL_CONCODE_DIC] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_DIC }, /* DIC #{ } */
/*[HCL_CONCODE_QLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_QLIST }, /* QLIST #( ) */
/* VLIST's closer and synerr are not used. there is dedicated logic in feed_process_token(). only voca_id is used */
/*[HCL_CONCODE_VLIST] =*/ { HCL_TOK_VBAR, HCL_SYNERR_VBAR, VOCA_VLIST } /* VLIST | | */
};
static int init_compiler (hcl_t* hcl); static int init_compiler (hcl_t* hcl);
static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num) static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num)
@ -520,23 +571,23 @@ static int get_char (hcl_t* hcl)
static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v) static hcl_tok_type_t classify_ident_token (hcl_t* hcl, const hcl_oocs_t* v)
{ {
hcl_oow_t i; hcl_oow_t i;
struct static struct
{ {
hcl_oow_t len; int voca_id;
hcl_ooch_t name[10];
hcl_tok_type_t type; hcl_tok_type_t type;
} tab[] = } tab[] =
{ {
{ 4, { 'n','u','l','l' }, HCL_TOK_NIL }, { VOCA_KW_NULL, HCL_TOK_NIL },
{ 4, { 't','r','u','e' }, HCL_TOK_TRUE }, { VOCA_KW_TRUE, HCL_TOK_TRUE },
{ 5, { 'f','a','l','s','e' }, HCL_TOK_FALSE }, { VOCA_KW_FALSE, HCL_TOK_FALSE },
{ 4, { 's','e','l','f' }, HCL_TOK_SELF }, { VOCA_KW_SELF, HCL_TOK_SELF },
{ 5, { 's','u','p','e','r' }, HCL_TOK_SUPER } { VOCA_KW_SUPER, HCL_TOK_SUPER }
}; };
for (i = 0; i < HCL_COUNTOF(tab); i++) for (i = 0; i < HCL_COUNTOF(tab); i++)
{ {
if (hcl_comp_oochars(v->ptr, v->len, tab[i].name, tab[i].len) == 0) return tab[i].type; int vid = tab[i].voca_id;
if (hcl_comp_oochars(v->ptr, v->len, vocas[vid].str, vocas[vid].len) == 0) return tab[i].type;
} }
return HCL_TOK_IDENT; return HCL_TOK_IDENT;
@ -617,7 +668,7 @@ static HCL_INLINE int enter_list (hcl_t* hcl, const hcl_loc_t* loc, int flagv)
return 0; return 0;
} }
static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv) static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int* flagv, int* oldflagv)
{ {
hcl_rstl_t* rstl; hcl_rstl_t* rstl;
hcl_cnode_t* head; hcl_cnode_t* head;
@ -643,6 +694,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv
return HCL_NULL; return HCL_NULL;
} }
*list_loc = loc;
*oldflagv = fv; *oldflagv = fv;
if (!hcl->c->r.st) if (!hcl->c->r.st)
{ {
@ -657,9 +709,9 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv
*flagv = hcl->c->r.st->flagv; *flagv = hcl->c->r.st->flagv;
} }
/* NOTE: empty xlist will get translated to #nil. /* NOTE: empty xlist will get translated to `null`.
* this is useful when used in the lambda expression to express an empty argument. also in defun. * this is useful when used in the lambda expression to express an empty argument. also in defun.
* (lambda () ...) is equivalent to (lambda #nil ...) * (lambda () ...) is equivalent to (lambda null ...)
* (defun x() ...) */ * (defun x() ...) */
if (head) if (head)
@ -744,7 +796,7 @@ static HCL_INLINE void clear_comma_colon_flag (hcl_t* hcl)
rstl->flagv &= ~(COMMAED | COLONED); rstl->flagv &= ~(COMMAED | COLONED);
} }
static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj, hcl_loc_t* loc)
{ {
hcl_rstl_t* rstl; hcl_rstl_t* rstl;
int flagv; int flagv;
@ -806,6 +858,8 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
else else
{ {
hcl_cnode_t* cons, * tail; hcl_cnode_t* cons, * tail;
hcl_oocs_t fake_tok, * fake_tok_ptr = HCL_NULL;
int concode;
if ((flagv & JSON) && rstl->count > 0 && !(flagv & (COMMAED | COLONED))) if ((flagv & JSON) && rstl->count > 0 && !(flagv & (COMMAED | COLONED)))
{ {
@ -815,7 +869,20 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
return -1; return -1;
} }
cons = hcl_makecnodecons(hcl, HCL_CNODE_GET_LOC(obj), obj, HCL_NULL); /* `loc` may be passed in if the added `obj` is a cons cell for another list */
HCL_ASSERT (hcl, (loc && (HCL_CNODE_IS_CONS(obj) || HCL_CNODE_IS_ELIST(obj))) || (!loc && !HCL_CNODE_IS_CONS(obj)));
concode = HCL_CNODE_IS_CONS(obj)? HCL_CNODE_CONS_CONCODE(obj):
HCL_CNODE_IS_ELIST(obj)? HCL_CNODE_ELIST_CONCODE(obj): -1;
if (concode >= 0)
{
int vid = cons_info[concode].voca_id;
fake_tok.ptr = vocas[vid].str;
fake_tok.len = vocas[vid].len;
fake_tok_ptr = &fake_tok;
}
cons = hcl_makecnodecons(hcl, (loc? loc: HCL_CNODE_GET_LOC(obj)), fake_tok_ptr, obj, HCL_NULL);
if (HCL_UNLIKELY(!cons)) return -1; if (HCL_UNLIKELY(!cons)) return -1;
if (rstl->count <= 0) if (rstl->count <= 0)
@ -831,8 +898,7 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
} }
else else
{ {
/* the new cons cell is not the first element. /* the new cons cell is not the first element. append it to the list */
* append it to the list */
tail = rstl->tail; tail = rstl->tail;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail)); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail));
tail->u.cons.cdr = cons; tail->u.cons.cdr = cons;
@ -998,6 +1064,8 @@ static HCL_INLINE int is_at_block_beginning (hcl_t* hcl)
static int feed_process_token (hcl_t* hcl) static int feed_process_token (hcl_t* hcl)
{ {
hcl_frd_t* frd = &hcl->c->feed.rd; hcl_frd_t* frd = &hcl->c->feed.rd;
hcl_loc_t* list_loc = HCL_NULL;
/* TODO: frd->obj and frd->list_loc can become local variables in this function.. */
/* this function composes an s-expression non-recursively /* this function composes an s-expression non-recursively
* by manipulating its own stack. */ * by manipulating its own stack. */
@ -1058,9 +1126,10 @@ static int feed_process_token (hcl_t* hcl)
/* closer */ /* closer */
int oldflagv; int oldflagv;
frd->expect_vlist_item = 0; frd->expect_vlist_item = 0;
frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv);
frd->level--; frd->level--;
frd->flagv |= AT_BEGINNING; frd->flagv |= AT_BEGINNING;
list_loc = &frd->list_loc;
break; break;
} }
else else
@ -1132,7 +1201,7 @@ static int feed_process_token (hcl_t* hcl)
* a list literal or an array literal */ * a list literal or an array literal */
if (enter_list(hcl, TOKEN_LOC(hcl), frd->flagv) <= -1) goto oops; if (enter_list(hcl, TOKEN_LOC(hcl), frd->flagv) <= -1) goto oops;
frd->level++; frd->level++;
frd->flagv |= AT_BEGINNING; /* indicate that the reader is now at the beginning of a list */ frd->flagv |= AT_BEGINNING; /* the reader is now at the beginning of a list */
/* read the next token */ /* read the next token */
goto ok; goto ok;
@ -1189,9 +1258,10 @@ static int feed_process_token (hcl_t* hcl)
goto oops; goto oops;
} }
frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv);
frd->level--; frd->level--;
frd->flagv |= AT_BEGINNING; /* the current one is over. move on the beginning for the next expression */ frd->flagv |= AT_BEGINNING; /* the current one is over. move on the beginning for the next expression */
list_loc = &frd->list_loc;
break; break;
} }
@ -1199,21 +1269,6 @@ static int feed_process_token (hcl_t* hcl)
case HCL_TOK_RBRACK: /* bytearray #[], array [] */ case HCL_TOK_RBRACK: /* bytearray #[], array [] */
case HCL_TOK_RBRACE: /* dictionary #{}, block {} */ case HCL_TOK_RBRACE: /* dictionary #{}, block {} */
{ {
static struct
{
int closer;
hcl_synerrnum_t synerr;
} req[] =
{
/*[HCL_CONCODE_XLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST ( ) */
/*[HCL_CONCODE_MLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN }, /* MLIST (: ) */
/*[HCL_CONCODE_BLOCK] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE }, /* BLOCK { } */
/*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY [ ] */
/*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[ ] */
/*[HCL_CONCODE_DIC] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC #{ } */
/*[HCL_CONCODE_QLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN } /* QLIST #( ) */
};
int oldflagv; int oldflagv;
int concode; int concode;
@ -1232,9 +1287,9 @@ static int feed_process_token (hcl_t* hcl)
goto oops; goto oops;
} }
if (req[concode].closer != TOKEN_TYPE(hcl)) if (cons_info[concode].closer != TOKEN_TYPE(hcl))
{ {
hcl_setsynerr (hcl, req[concode].synerr, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); hcl_setsynerr (hcl, cons_info[concode].synerr, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
goto oops; goto oops;
} }
@ -1262,9 +1317,10 @@ static int feed_process_token (hcl_t* hcl)
goto oops; goto oops;
} }
#endif #endif
frd->obj = leave_list(hcl, &frd->flagv, &oldflagv); frd->obj = leave_list(hcl, &frd->list_loc, &frd->flagv, &oldflagv);
frd->level--; frd->level--;
frd->flagv |= AT_BEGINNING; frd->flagv |= AT_BEGINNING;
list_loc = &frd->list_loc;
break; break;
} }
@ -1445,7 +1501,7 @@ static int feed_process_token (hcl_t* hcl)
{ {
/* if not, append the element read into the current list. /* if not, append the element read into the current list.
* if we are not at the top frd->level, we must be in a list */ * if we are not at the top frd->level, we must be in a list */
if (chain_to_list(hcl, frd->obj) <= -1) goto oops; if (chain_to_list(hcl, frd->obj, list_loc) <= -1) goto oops;
/* because it has been chained to the list, it belongs to the current stack top. /* because it has been chained to the list, it belongs to the current stack top.
* mark that obj is not stand-alone by nullifying it. without this, if a jump * mark that obj is not stand-alone by nullifying it. without this, if a jump
@ -1915,16 +1971,16 @@ static int flx_hmarked_char (hcl_t* hcl, hcl_ooci_t c)
goto hexcharlit; goto hexcharlit;
} }
#endif #endif
else if (does_token_name_match(hcl, VOCA_BACKSPACE)) c = '\b'; else if (does_token_name_match(hcl, VOCA_CHAR_BACKSPACE)) c = '\b';
else if (does_token_name_match(hcl, VOCA_LINEFEED)) c = '\n'; else if (does_token_name_match(hcl, VOCA_CHAR_LINEFEED)) c = '\n';
else if (does_token_name_match(hcl, VOCA_NEWLINE)) c = '\n'; /* TODO: convert it to host newline convention. how to handle if it's composed of 2 letters like \r\n? */ else if (does_token_name_match(hcl, VOCA_CHAR_NEWLINE)) c = '\n'; /* TODO: convert it to host newline convention. how to handle if it's composed of 2 letters like \r\n? */
else if (does_token_name_match(hcl, VOCA_NUL)) c = '\0'; /* null character. not the object null */ else if (does_token_name_match(hcl, VOCA_CHAR_NUL)) c = '\0'; /* null character. not the object null */
else if (does_token_name_match(hcl, VOCA_PAGE)) c = '\f'; else if (does_token_name_match(hcl, VOCA_CHAR_PAGE)) c = '\f';
else if (does_token_name_match(hcl, VOCA_RETURN)) c = '\r'; else if (does_token_name_match(hcl, VOCA_CHAR_RETURN)) c = '\r';
else if (does_token_name_match(hcl, VOCA_RUBOUT)) c = '\x7F'; /* DEL */ else if (does_token_name_match(hcl, VOCA_CHAR_RUBOUT)) c = '\x7F'; /* DEL */
else if (does_token_name_match(hcl, VOCA_SPACE)) c = ' '; else if (does_token_name_match(hcl, VOCA_CHAR_SPACE)) c = ' ';
else if (does_token_name_match(hcl, VOCA_TAB)) c = '\t'; else if (does_token_name_match(hcl, VOCA_CHAR_TAB)) c = '\t';
else if (does_token_name_match(hcl, VOCA_VTAB)) c = '\v'; else if (does_token_name_match(hcl, VOCA_CHAR_VTAB)) c = '\v';
else else
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_CHARLIT, TOKEN_LOC(hcl), TOKEN_NAME(hcl), hcl_setsynerrbfmt (hcl, HCL_SYNERR_CHARLIT, TOKEN_LOC(hcl), TOKEN_NAME(hcl),
@ -2869,6 +2925,15 @@ static int init_compiler (hcl_t* hcl)
init_feed (hcl); init_feed (hcl);
hcl->c->cbp = cbp; hcl->c->cbp = cbp;
/* initialize the internal cons to represent a cell pointing to `null` in the `car` part */
hcl->c->fake_cnode.nil.cn_type = HCL_CNODE_NIL;
hcl->c->fake_cnode.nil.cn_tok.ptr = vocas[VOCA_KW_NULL].str;
hcl->c->fake_cnode.nil.cn_tok.len = vocas[VOCA_KW_NULL].len;
hcl->c->fake_cnode.cons_to_nil.cn_type = HCL_CNODE_CONS;
hcl->c->fake_cnode.cons_to_nil.u.cons.car = &hcl->c->fake_cnode.nil;
hcl->c->fake_cnode.cons_to_nil.u.cons.cdr = HCL_NULL;
return 0; return 0;
} }

8
lib/std.c
View File

@ -24,6 +24,10 @@
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/ */
#if !defined(_GNU_SOURCE)
# define _GNU_SOURCE
#endif
#include "hcl-prv.h" #include "hcl-prv.h"
#include <hcl-utl.h> #include <hcl-utl.h>
@ -129,10 +133,6 @@
#else #else
# if !defined(_GNU_SOURCE)
# define _GNU_SOURCE
# endif
# include <sys/types.h> # include <sys/types.h>
# include <unistd.h> # include <unistd.h>
# include <fcntl.h> # include <fcntl.h>