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

implemented (do ...)

Browse Source
This commit is contained in:
hyung-hwan 2018-02-09 16:10:29 +00:00
parent d684f0c1db
commit eff4be881f
3 changed files with 45 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
lib/comp.c
View File

@ -664,13 +664,13 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src)
{ {
if (HCL_IS_CONS(hcl,obj)) if (HCL_IS_CONS(hcl,obj))
{ {
HCL_DEBUG1 (hcl, "Syntax error - redundant argument in break - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */ "redundant argument in break - %O", src); /* TODO: error location */
} }
else else
{ {
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in break - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */ "redundant cdr in break - %O", src); /* TODO: error location */
return -1; return -1;
} }
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_setsynerrbfmt (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL); /* TODO: error location */ "break outside loop - %O", src); /* TODO: error location */
return -1; return -1;
} }
@ -732,14 +732,14 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
if (HCL_IS_NIL(hcl, obj)) if (HCL_IS_NIL(hcl, obj))
{ {
/* no value */ /* no value */
HCL_DEBUG1 (hcl, "Syntax error - no condition specified in if - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */ "no condition specified in if - %O", src); /* TODO: error location */
return -1; return -1;
} }
else if (!HCL_IS_CONS(hcl, obj)) else if (!HCL_IS_CONS(hcl, obj))
{ {
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in if - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */ "redundant cdr in if - %O", src); /* TODO: error location */
return -1; return -1;
} }
@ -1111,6 +1111,33 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
return 0; 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) static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
{ {
/* (while (xxxx) ... ) */ /* (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)) if (HCL_IS_NIL(hcl, obj))
{ {
/* no value */ /* no value */
HCL_DEBUG1 (hcl, "Syntax error - no condition specified in while - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL); /* TODO: error location */ "no loop condition specified - %O", src); /* TODO: error location */
return -1; return -1;
} }
else if (!HCL_IS_CONS(hcl, obj)) else if (!HCL_IS_CONS(hcl, obj))
{ {
HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in while - %O\n", src); hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */ "redundant cdr in loop - %O", src); /* TODO: error location */
return -1; return -1;
} }
@ -1273,8 +1300,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
break; break;
case HCL_SYNCODE_DO: case HCL_SYNCODE_DO:
HCL_DEBUG0 (hcl, "DO NOT IMPLEMENTED...\n"); if (compile_do(hcl, obj) <= -1) return -1;
/* TODO: not implemented yet */
break; break;
case HCL_SYNCODE_ELSE: case HCL_SYNCODE_ELSE:

4
lib/main.c
View File

@ -1518,8 +1518,8 @@ int main (int argc, char* argv[])
hcl_setoption (hcl, HCL_TRAIT, &trait); hcl_setoption (hcl, HCL_TRAIT, &trait);
/* disable GC logs */ /* disable GC logs */
trait = ~HCL_LOG_GC; /*trait = ~HCL_LOG_GC;
hcl_setoption (hcl, HCL_LOG_MASK, &trait); hcl_setoption (hcl, HCL_LOG_MASK, &trait);*/
} }
xtn = hcl_getxtn (hcl); xtn = hcl_getxtn (hcl);

2
lib/obj.c
View File

@ -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)) if (!ptr && hcl->errnum == HCL_EOOMEM && !(hcl->option.trait & HCL_NOGC))
{ {
hcl_gc (hcl); 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", "GC completed - current heap ptr %p limit %p size %zd free %zd\n",
hcl->curheap->ptr, hcl->curheap->limit, hcl->curheap->ptr, hcl->curheap->limit,
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->base), (hcl_oow_t)(hcl->curheap->limit - hcl->curheap->base),