implemented (do ...)
This commit is contained in:
parent
d684f0c1db
commit
eff4be881f
58
lib/comp.c
58
lib/comp.c
@ -664,13 +664,13 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src)
|
||||
{
|
||||
if (HCL_IS_CONS(hcl,obj))
|
||||
{
|
||||
HCL_DEBUG1 (hcl, "Syntax error - redundant argument in break - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
|
||||
"redundant argument in break - %O", src); /* TODO: error location */
|
||||
}
|
||||
else
|
||||
{
|
||||
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in break - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
|
||||
"redundant cdr in break - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
return -1;
|
||||
@ -705,8 +705,8 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src)
|
||||
}
|
||||
}
|
||||
|
||||
HCL_DEBUG1 (hcl, "Syntax error - break outside loop - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL,
|
||||
"break outside loop - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -732,14 +732,14 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
|
||||
if (HCL_IS_NIL(hcl, obj))
|
||||
{
|
||||
/* no value */
|
||||
HCL_DEBUG1 (hcl, "Syntax error - no condition specified in if - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
|
||||
"no condition specified in if - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
else if (!HCL_IS_CONS(hcl, obj))
|
||||
{
|
||||
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in if - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
|
||||
"redundant cdr in if - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -1111,6 +1111,33 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int compile_do (hcl_t* hcl, hcl_oop_t src)
|
||||
{
|
||||
hcl_oop_t obj;
|
||||
|
||||
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_do);
|
||||
|
||||
obj = HCL_CONS_CDR(src);
|
||||
|
||||
if (HCL_IS_NIL(hcl, obj))
|
||||
{
|
||||
/* no value */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
|
||||
"no expression specified in do - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
else if (!HCL_IS_CONS(hcl, obj))
|
||||
{
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
|
||||
"redundant cdr in do - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
|
||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
|
||||
{
|
||||
/* (while (xxxx) ... ) */
|
||||
@ -1127,14 +1154,14 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
|
||||
if (HCL_IS_NIL(hcl, obj))
|
||||
{
|
||||
/* no value */
|
||||
HCL_DEBUG1 (hcl, "Syntax error - no condition specified in while - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
|
||||
"no loop condition specified - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
else if (!HCL_IS_CONS(hcl, obj))
|
||||
{
|
||||
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in while - %O\n", src);
|
||||
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
|
||||
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
|
||||
"redundant cdr in loop - %O", src); /* TODO: error location */
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -1273,8 +1300,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
|
||||
break;
|
||||
|
||||
case HCL_SYNCODE_DO:
|
||||
HCL_DEBUG0 (hcl, "DO NOT IMPLEMENTED...\n");
|
||||
/* TODO: not implemented yet */
|
||||
if (compile_do(hcl, obj) <= -1) return -1;
|
||||
break;
|
||||
|
||||
case HCL_SYNCODE_ELSE:
|
||||
|
@ -1518,8 +1518,8 @@ int main (int argc, char* argv[])
|
||||
hcl_setoption (hcl, HCL_TRAIT, &trait);
|
||||
|
||||
/* disable GC logs */
|
||||
trait = ~HCL_LOG_GC;
|
||||
hcl_setoption (hcl, HCL_LOG_MASK, &trait);
|
||||
/*trait = ~HCL_LOG_GC;
|
||||
hcl_setoption (hcl, HCL_LOG_MASK, &trait);*/
|
||||
}
|
||||
|
||||
xtn = hcl_getxtn (hcl);
|
||||
|
@ -39,7 +39,7 @@ void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size)
|
||||
if (!ptr && hcl->errnum == HCL_EOOMEM && !(hcl->option.trait & HCL_NOGC))
|
||||
{
|
||||
hcl_gc (hcl);
|
||||
HCL_LOG4 (hcl, HCL_LOG_INFO,
|
||||
HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO,
|
||||
"GC completed - current heap ptr %p limit %p size %zd free %zd\n",
|
||||
hcl->curheap->ptr, hcl->curheap->limit,
|
||||
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->base),
|
||||
|
Loading…
Reference in New Issue
Block a user