From eff4be881f822f19aeafc0785647977aeb792d42 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 9 Feb 2018 16:10:29 +0000 Subject: [PATCH] implemented (do ...) --- lib/comp.c | 58 +++++++++++++++++++++++++++++++++++++++--------------- lib/main.c | 4 ++-- lib/obj.c | 2 +- 3 files changed, 45 insertions(+), 19 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index d860b56..2a501f9 100644 --- a/lib/comp.c +++ b/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: diff --git a/lib/main.c b/lib/main.c index 8e95aa6..673dbf3 100644 --- a/lib/main.c +++ b/lib/main.c @@ -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); diff --git a/lib/obj.c b/lib/obj.c index b422bff..cce3d08 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -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),