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

simplified the block expression checking in processing defun by calling the common checker function
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2023-11-15 09:58:02 +09:00
parent 8085fb7725
commit 84660b6e79
2 changed files with 29 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lib/comp.c
View File

@ -2828,35 +2828,9 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK) if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
{ {
hcl_cnode_t* blk, * bdy, * trl; hcl_cnode_t* blk;
blk = HCL_CNODE_CONS_CDR(obj); blk = HCL_CNODE_CONS_CDR(obj);
if (!blk || !HCL_CNODE_IS_CONS(blk)) if (check_block_expression_as_body(hcl, blk, cmd, 0) <= -1) return -1;
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BLOCK, (blk? HCL_CNODE_GET_LOC(blk): 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;
}
bdy = HCL_CNODE_CONS_CAR(blk); /* {} must be the last item. bdy is the expression inside */
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)))
{
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BLOCK, (bdy? HCL_CNODE_GET_LOC(bdy): 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 (trl)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(trl), HCL_NULL, "redundant code prohibited after body in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
obj = blk; 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 */
} }

31
t/fun-01.hcl
View File

@ -6,8 +6,8 @@ defun aaa(a b) {
set k (aaa 10 20); set k (aaa 10 20);
if (= k 30) { printf "OK\n"; } if (= k 30) { printf "OK - %d\n" k; }
else { printf "ERROR\n"; }; else { printf "ERROR - %d\n" k; };
## -------------------------------------- ## --------------------------------------
@ -19,5 +19,28 @@ defun mkfun(t) {
set f (mkfun 20); set f (mkfun 20);
set k (f 50); set k (f 50);
if (= k 50) { printf "OK\n"; } if (= k 70) { printf "OK - %d\n" k; }
else { printf "ERROR\n"; }; else { printf "ERROR - %d\n" k; };
## --------------------------------------
defclass A
| a b c |
{
defun ::* newInstance(x y z) {
(set a x)
(set b y)
(set c z)
(return self)
};
defun get-a() { return a; };
##defun get-b() b;
##defun get-c() c;
};
set k (:A newInstance 11 22 33);
set v (:k get-a);
if (= v 11) { printf "OK - %d\n" v; }
else { printf "ERROR - %d\n" v; };