diff --git a/lib/Makefile.am b/lib/Makefile.am index acd9b94..2b84be5 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -66,6 +66,7 @@ libhcl_la_SOURCES = \ bigint.c \ cnode.c \ comp.c \ + comp2.c \ debug.c \ decode.c \ dic.c \ diff --git a/lib/Makefile.in b/lib/Makefile.in index 19ab6d9..9765a1e 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -151,14 +151,14 @@ am__DEPENDENCIES_5 = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_2) \ $(am__DEPENDENCIES_3) $(am__DEPENDENCIES_4) libhcl_la_DEPENDENCIES = $(am__DEPENDENCIES_5) $(am__append_6) am_libhcl_la_OBJECTS = libhcl_la-bigint.lo libhcl_la-cnode.lo \ - libhcl_la-comp.lo libhcl_la-debug.lo libhcl_la-decode.lo \ - libhcl_la-dic.lo libhcl_la-err.lo libhcl_la-exec.lo \ - libhcl_la-fmt.lo libhcl_la-gc.lo libhcl_la-hcl.lo \ - libhcl_la-heap.lo libhcl_la-number.lo libhcl_la-obj.lo \ - libhcl_la-opt.lo libhcl_la-prim.lo libhcl_la-print.lo \ - libhcl_la-rbt.lo libhcl_la-read.lo libhcl_la-read2.lo \ - libhcl_la-sym.lo libhcl_la-utf8.lo libhcl_la-utl.lo \ - libhcl_la-xma.lo + libhcl_la-comp.lo libhcl_la-comp2.lo libhcl_la-debug.lo \ + libhcl_la-decode.lo libhcl_la-dic.lo libhcl_la-err.lo \ + libhcl_la-exec.lo libhcl_la-fmt.lo libhcl_la-gc.lo \ + libhcl_la-hcl.lo libhcl_la-heap.lo libhcl_la-number.lo \ + libhcl_la-obj.lo libhcl_la-opt.lo libhcl_la-prim.lo \ + libhcl_la-print.lo libhcl_la-rbt.lo libhcl_la-read.lo \ + libhcl_la-read2.lo libhcl_la-sym.lo libhcl_la-utf8.lo \ + libhcl_la-utl.lo libhcl_la-xma.lo libhcl_la_OBJECTS = $(am_libhcl_la_OBJECTS) AM_V_lt = $(am__v_lt_@AM_V@) am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) @@ -198,6 +198,7 @@ depcomp = $(SHELL) $(top_srcdir)/ac/depcomp am__maybe_remake_depfiles = depfiles am__depfiles_remade = ./$(DEPDIR)/libhcl_la-bigint.Plo \ ./$(DEPDIR)/libhcl_la-cnode.Plo ./$(DEPDIR)/libhcl_la-comp.Plo \ + ./$(DEPDIR)/libhcl_la-comp2.Plo \ ./$(DEPDIR)/libhcl_la-debug.Plo \ ./$(DEPDIR)/libhcl_la-decode.Plo ./$(DEPDIR)/libhcl_la-dic.Plo \ ./$(DEPDIR)/libhcl_la-err.Plo ./$(DEPDIR)/libhcl_la-exec.Plo \ @@ -440,6 +441,7 @@ libhcl_la_SOURCES = \ bigint.c \ cnode.c \ comp.c \ + comp2.c \ debug.c \ decode.c \ dic.c \ @@ -578,6 +580,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-bigint.Plo@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-cnode.Plo@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-comp.Plo@am__quote@ # am--include-marker +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-comp2.Plo@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-debug.Plo@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-decode.Plo@am__quote@ # am--include-marker @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-dic.Plo@am__quote@ # am--include-marker @@ -657,6 +660,13 @@ libhcl_la-comp.lo: comp.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhcl_la-comp.lo `test -f 'comp.c' || echo '$(srcdir)/'`comp.c +libhcl_la-comp2.lo: comp2.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhcl_la-comp2.lo -MD -MP -MF $(DEPDIR)/libhcl_la-comp2.Tpo -c -o libhcl_la-comp2.lo `test -f 'comp2.c' || echo '$(srcdir)/'`comp2.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-comp2.Tpo $(DEPDIR)/libhcl_la-comp2.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='comp2.c' object='libhcl_la-comp2.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhcl_la-comp2.lo `test -f 'comp2.c' || echo '$(srcdir)/'`comp2.c + libhcl_la-debug.lo: debug.c @am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhcl_la-debug.lo -MD -MP -MF $(DEPDIR)/libhcl_la-debug.Tpo -c -o libhcl_la-debug.lo `test -f 'debug.c' || echo '$(srcdir)/'`debug.c @am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-debug.Tpo $(DEPDIR)/libhcl_la-debug.Plo @@ -1004,6 +1014,7 @@ distclean: distclean-am -rm -f ./$(DEPDIR)/libhcl_la-bigint.Plo -rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo -rm -f ./$(DEPDIR)/libhcl_la-comp.Plo + -rm -f ./$(DEPDIR)/libhcl_la-comp2.Plo -rm -f ./$(DEPDIR)/libhcl_la-debug.Plo -rm -f ./$(DEPDIR)/libhcl_la-decode.Plo -rm -f ./$(DEPDIR)/libhcl_la-dic.Plo @@ -1080,6 +1091,7 @@ maintainer-clean: maintainer-clean-am -rm -f ./$(DEPDIR)/libhcl_la-bigint.Plo -rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo -rm -f ./$(DEPDIR)/libhcl_la-comp.Plo + -rm -f ./$(DEPDIR)/libhcl_la-comp2.Plo -rm -f ./$(DEPDIR)/libhcl_la-debug.Plo -rm -f ./$(DEPDIR)/libhcl_la-decode.Plo -rm -f ./$(DEPDIR)/libhcl_la-dic.Plo diff --git a/lib/cnode.c b/lib/cnode.c index 880740f..746dd7d 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -26,119 +26,99 @@ #include "hcl-prv.h" -static hcl_cnode_t* make_cnode (hcl_t* hcl, hcl_cnode_type_t type, const hcl_ioloc_t* loc, hcl_oow_t extra_space) +static hcl_cnode_t* make_cnode (hcl_t* hcl, hcl_cnode_type_t type, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { hcl_cnode_t* cnode; + hcl_oocs_t empty; + hcl_ooch_t dummy; - cnode = hcl_callocmem(hcl, HCL_SIZEOF(*cnode) + extra_space); + if (!tok) + { + empty.ptr = &dummy; + empty.len = 0; + tok = ∅ + } + cnode = hcl_callocmem(hcl, HCL_SIZEOF(*cnode) + HCL_SIZEOF(*tok->ptr) * (tok->len + 1)); if (HCL_UNLIKELY(!cnode)) return HCL_NULL; - cnode->type = type; - cnode->loc = *loc; + cnode->cn_type = type; + cnode->cn_loc = *loc; + + cnode->cn_tok.ptr = (hcl_ooch_t*)(cnode + 1); + cnode->cn_tok.len = tok->len; + hcl_copy_oochars (cnode->cn_tok.ptr, tok->ptr, tok->len); + cnode->cn_tok.ptr[tok->len] = '\0'; + return cnode; } -hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc) +hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - return make_cnode(hcl, HCL_CNODE_NIL, loc, 0); + return make_cnode(hcl, HCL_CNODE_NIL, loc, tok); } -hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc) +hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - return make_cnode(hcl, HCL_CNODE_TRUE, loc, 0); + return make_cnode(hcl, HCL_CNODE_TRUE, loc, tok); } -hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc) +hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - return make_cnode(hcl, HCL_CNODE_FALSE, loc, 0); + return make_cnode(hcl, HCL_CNODE_FALSE, loc, tok); } -hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t ch) +hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, 0); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CHARLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.charlit.v = ch; + c->u.charlit.v = v; return c; } -hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, HCL_SIZEOF(*ptr) * (len + 1)); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.symbol.ptr = (hcl_ooch_t*)(c + 1); - c->u.symbol.len = len; - hcl_copy_oochars (c->u.symbol.ptr, ptr, len); - c->u.symbol.ptr[len] = '\0'; + c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok); return c; } -hcl_cnode_t* hcl_makecnodedsymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnodedsymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_DSYMBOL, loc, HCL_SIZEOF(*ptr) * (len + 1)); - if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.dsymbol.ptr = (hcl_ooch_t*)(c + 1); - c->u.dsymbol.len = len; - hcl_copy_oochars (c->u.dsymbol.ptr, ptr, len); - c->u.dsymbol.ptr[len] = '\0'; - return c; + return make_cnode(hcl, HCL_CNODE_DSYMBOL, loc, tok); } -hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_STRLIT, loc, HCL_SIZEOF(*ptr) * (len + 1)); - if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.strlit.ptr = (hcl_ooch_t*)(c + 1); - c->u.strlit.len = len; - hcl_copy_oochars (c->u.strlit.ptr, ptr, len); - c->u.strlit.ptr[len] = '\0'; - return c; + return make_cnode(hcl, HCL_CNODE_STRLIT, loc, tok); } -hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_NUMLIT, loc, HCL_SIZEOF(*ptr) * (len + 1)); - if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.numlit.ptr = (hcl_ooch_t*)(c + 1); - c->u.numlit.len = len; - hcl_copy_oochars (c->u.numlit.ptr, ptr, len); - c->u.numlit.ptr[len] = '\0'; - return c; + return make_cnode(hcl, HCL_CNODE_NUMLIT, loc, tok); } -hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_RADNUMLIT, loc, HCL_SIZEOF(*ptr) * (len + 1)); - if (HCL_UNLIKELY(!c)) return HCL_NULL; - - c->u.radnumlit.ptr = (hcl_ooch_t*)(c + 1); - c->u.radnumlit.len = len; - hcl_copy_oochars (c->u.radnumlit.ptr, ptr, len); - c->u.radnumlit.ptr[len] = '\0'; - return c; + return make_cnode(hcl, HCL_CNODE_RADNUMLIT, loc, tok); } -hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_FPDECLIT, loc, HCL_SIZEOF(*ptr) * (len + 1)); - if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.fpdeclit.ptr = (hcl_ooch_t*)(c + 1); - c->u.fpdeclit.len = len; - hcl_copy_oochars (c->u.fpdeclit.ptr, ptr, len); - c->u.fpdeclit.ptr[len] = '\0'; - return c; + return make_cnode(hcl, HCL_CNODE_FPDECLIT, loc, tok); } -hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_oow_t v) +hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, 0); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SMPTRLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.smptrlit.v = v; return c; } -hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_ooi_t v) +hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, 0); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_ERRLIT, loc, tok); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.errlit.v = v; return c; @@ -146,19 +126,18 @@ hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_ooi_t hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, 0); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_CONS, loc, HCL_NULL); if (HCL_UNLIKELY(!c)) return HCL_NULL; c->u.cons.car = car; c->u.cons.cdr = cdr; return c; } -hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type, hcl_cnode_t* head) +hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type) { - hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_LIST, loc, 0); + hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_LIST, loc, HCL_NULL); if (HCL_UNLIKELY(!c)) return HCL_NULL; - c->u.list.type = type; - c->u.list.head = head; + c->u.list.concode = type; return c; } @@ -170,22 +149,8 @@ void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c) void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c) { redo: - switch (c->type) + switch (c->cn_type) { - case HCL_CNODE_LIST: - { - hcl_cnode_t* tmp; - tmp = c->u.list.head; - hcl_freemem (hcl, c); - if (tmp) /* it's not set for an empty list */ - { - - c = tmp; - goto redo; - } - break; - } - case HCL_CNODE_CONS: { hcl_cnode_t* tmp1, * tmp2; @@ -196,7 +161,6 @@ redo: HCL_ASSERT (hcl, tmp1 != HCL_NULL); hcl_freemem (hcl, c); - hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */ if (tmp2) @@ -213,3 +177,21 @@ redo: break; } } + + +hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons) +{ + /* this function ignores the last cdr */ + hcl_oow_t count = 1; + + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(cons)); + do + { + cons = HCL_CNODE_CONS_CDR(cons); + if (!cons) break; + count++; + } + while (1); + + return count; +} diff --git a/lib/comp.c b/lib/comp.c index 825ed23..c13596d 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -804,7 +804,6 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in break - %O", src); /* TODO: error location */ - return -1; } return -1; } diff --git a/lib/comp2.c b/lib/comp2.c index 05c81d6..02f4445 100644 --- a/lib/comp2.c +++ b/lib/comp2.c @@ -35,12 +35,6 @@ enum #define TV_BUFFER_ALIGN 256 #define BLK_INFO_BUFFER_ALIGN 128 -#define EMIT_BYTE_INSTRUCTION(hcl,code) \ - do { if (emit_byte_instruction(hcl, code, HCL_NULL) <= -1) return -1; } while(0) - -#define EMIT_SINGLE_PARAM_INSTRUCTION(hcl,code) \ - do { if (emit_byte_instruction(hcl, code, HCL_NULL) <= -1) return -1; } while(0) - /* -------------------------------------------- @@ -863,33 +857,31 @@ enum }; /* ========================================================================= */ -#if 0 + static int compile_and (hcl_t* hcl, hcl_cnode_t* src) { - hcl_oop_t expr, obj; + hcl_cnode_t* obj, * expr; - HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); - HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_and); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_AND)); - obj = HCL_CONS_CDR(src); + obj = HCL_CNODE_CONS_CDR(src); - if (HCL_IS_NIL(hcl, obj)) + if (!obj) { /* no value */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, src->loc, HCL_NULL, - "no expression specified in and - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in and"); return -1; } - else if (!HCL_IS_CONS(hcl, obj)) + else if (!HCL_CNODE_IS_CONS(obj)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, src->loc, HCL_NULL, - "redundant cdr in and - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and"); return -1; } /* TODO: optimization - eat away all true expressions */ - expr = HCL_CONS_CAR(obj); - obj = HCL_CONS_CDR(obj); + expr = HCL_CNODE_CONS_CAR(obj); + obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */ @@ -897,32 +889,30 @@ static int compile_and (hcl_t* hcl, hcl_cnode_t* src) return 0; } -static int compile_or (hcl_t* hcl, hcl_oop_t src) +static int compile_or (hcl_t* hcl, hcl_cnode_t* src) { - hcl_oop_t expr, obj; + hcl_cnode_t* obj, * expr; - HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); - HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_or); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_OR)); - obj = HCL_CONS_CDR(src); + obj = HCL_CNODE_CONS_CDR(src); - if (HCL_IS_NIL(hcl, obj)) + if (!obj) { /* no value */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, - "no expression specified in or - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in or"); return -1; } - else if (!HCL_IS_CONS(hcl, obj)) + else if (!HCL_CNODE_IS_CONS(obj)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in or - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and"); return -1; } /* TODO: optimization - eat away all false expressions */ - expr = HCL_CONS_CAR(obj); - obj = HCL_CONS_CDR(obj); + expr = HCL_CNODE_CONS_CAR(obj); + obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_OR_EXPR, obj); /* 2 */ @@ -930,28 +920,25 @@ static int compile_or (hcl_t* hcl, hcl_oop_t src) return 0; } -static int compile_break (hcl_t* hcl, hcl_oop_t src) +static int compile_break (hcl_t* hcl, hcl_cnode_t* src) { /* (break) */ - hcl_oop_t obj; + hcl_cnode_t* obj; hcl_ooi_t i; - HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); - HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_break); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_BREAK)); - obj = HCL_CONS_CDR(src); - if (!HCL_IS_NIL(hcl,obj)) + obj = HCL_CNODE_CONS_CDR(src); + if (obj) { - if (HCL_IS_CONS(hcl,obj)) + if (HCL_CNODE_IS_CONS(obj)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, - "redundant argument in break - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(obj), HCL_NULL, "redundant argument in break"); } else { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in break - %O", src); /* TODO: error location */ - return -1; + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in break"); } return -1; } @@ -985,11 +972,11 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src) } } - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BREAK, HCL_NULL, HCL_NULL, - "break outside loop - %O", src); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BREAK, HCL_CNODE_GET_LOC(src), HCL_NULL, "break outside loop"); return -1; } +#if 0 static int compile_if (hcl_t* hcl, hcl_oop_t src) { hcl_oop_t obj, cond; @@ -1488,9 +1475,10 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop) return 0; } +#endif /* ========================================================================= */ -static int compile_cons_array_expression (hcl_t* hcl, hcl_oop_t obj) +static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj) { /* [ ] */ hcl_ooi_t nargs; @@ -1500,11 +1488,11 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_oop_t obj) * many operations can be performed without taking GC into account */ SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_ARRAY, HCL_SMOOI_TO_OOP(0)); - nargs = hcl_countcons(hcl, obj); + nargs = hcl_countcnodecons(hcl, obj); if (nargs > MAX_CODE_PARAM) { /* TODO: change to syntax error */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) elements into array - %O", nargs, obj); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements into array", nargs); return -1; } @@ -1521,7 +1509,7 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_oop_t obj) return 0; } -static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_oop_t obj) +static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj) { /* #[ ] - e.g. #[1, 2, 3] or #[ 1 2 3 ] */ hcl_ooi_t nargs; @@ -1531,11 +1519,11 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_oop_t obj) * many operations can be performed without taking GC into account */ SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_BYTEARRAY, HCL_SMOOI_TO_OOP(0)); - nargs = hcl_countcons(hcl, obj); + nargs = hcl_countcnodecons(hcl, obj); if (nargs > MAX_CODE_PARAM) { /* TODO: change to syntax error */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) elements into byte-array - %O", nargs, obj); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements into byte-array", nargs); return -1; } @@ -1552,7 +1540,7 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_oop_t obj) return 0; } -static int compile_cons_dic_expression (hcl_t* hcl, hcl_oop_t obj) +static int compile_cons_dic_expression (hcl_t* hcl, hcl_cnode_t* obj) { /* { } - e.g. {1:2, 3:4,"abc":def, "hwaddr":"00:00:00:01"} or { 1 2 3 4 } */ hcl_ooi_t nargs; @@ -1560,11 +1548,11 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_oop_t obj) SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DIC, HCL_SMOOI_TO_OOP(0)); - nargs = hcl_countcons(hcl, obj); + nargs = hcl_countcnodecons(hcl, obj); if (nargs > MAX_CODE_PARAM) { /* TODO: change to syntax error */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) elements into dictionary - %O", nargs, obj); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements into dictionary", nargs); return -1; } @@ -1579,7 +1567,8 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_oop_t obj) return 0; } -static int compile_cons_qlist_expression (hcl_t* hcl, hcl_oop_t obj) +#if 0 +static int compile_cons_qlist_expression (hcl_t* hcl, hcl_cnode_t* obj) { /* #( 1 2 3 ) * #(1 (+ 2 3) 5) @@ -1592,11 +1581,11 @@ static int compile_cons_qlist_expression (hcl_t* hcl, hcl_oop_t obj) * many operations can be performed without taking GC into account */ SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DLIST, HCL_SMOOI_TO_OOP(0)); - nargs = hcl_countcons(hcl, obj); + nargs = hcl_countcnodecons(hcl, obj); if (nargs > MAX_CODE_PARAM) { /* TODO: change to syntax error */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) elements into array - %O", nargs, obj); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) elements into list - %O", nargs, obj); return -1; } @@ -1616,7 +1605,6 @@ static int compile_cons_qlist_expression (hcl_t* hcl, hcl_oop_t obj) static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) { - hcl_cnode_t* head; hcl_cnode_t* car; int syncode; /* syntax code of the first element */ @@ -1628,18 +1616,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) * if the name is another function call, i can't know if the * function name will be valid at the compile time. */ - HCL_ASSERT (hcl, obj->type == HCL_CNODE_LIST); - HCL_ASSERT (hcl, obj->u.list.type == HCL_CONCODE_XLIST); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_XLIST)); - head = obj->u.list.head; - if (!head) - { - /* empty list */ - } - - HCL_ASSERT (hcl, head->type == HCL_CNODE_CONS); - car = head->u.cons.car; - if (car->type == HCL_CNODE_SYMBOL && (syncode = hcl_getsyncodebyoocs_noseterr(hcl, &car->u.symbol)) > 0) + car = HCL_CNODE_CONS_CAR(obj); + if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car))) { switch (syncode) { @@ -1652,6 +1632,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) if (compile_break(hcl, obj) <= -1) return -1; break; +#if 0 case HCL_SYNCODE_DEFUN: if (compile_lambda(hcl, obj, 1) <= -1) return -1; break; @@ -1676,11 +1657,12 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) /* (lambda (x y) (+ x y)) */ if (compile_lambda(hcl, obj, 0) <= -1) return -1; break; - +#endif case HCL_SYNCODE_OR: if (compile_or(hcl, obj) <= -1) return -1; break; +#if 0 case HCL_SYNCODE_SET: /* (set x 10) * (set x (lambda (x y) (+ x y)) */ @@ -1704,23 +1686,23 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) case HCL_SYNCODE_WHILE: if (compile_while(hcl, obj, COP_POST_WHILE_COND) <= -1) return -1; break; +#endif default: HCL_DEBUG3 (hcl, "Internal error - unknown syncode %d at %s:%d\n", syncode, __FILE__, __LINE__); - hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, &car->loc, HCL_NULL, "internal error - unknown syncode %d", syncode); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(car), HCL_NULL, "internal error - unknown syncode %d", syncode); return -1; } } - //else if (car->type == HCL_CNODE_SYMBOL || HCL_IS_CONS_CONCODED(hcl,car,HCL_CONCODE_XLIST)) - else if (car->type == HCL_CNODE_SYMBOL || (car->type == HCL_CNODE_LIST && car->u.list.type == HCL_CONCODE_XLIST)) + else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST)) { /* normal function call * ( ...) */ hcl_ooi_t nargs; hcl_ooi_t oldtop; hcl_cframe2_t* cf; - hcl_oop_t cdr; - hcl_oop_cons_t sdc; + hcl_cnode_t* cdr; + hcl_cnode_t* sdc; /* NOTE: cframe management functions don't use the object memory. * many operations can be performed without taking GC into account */ @@ -1737,22 +1719,22 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car); /* compile ... etc */ - cdr = HCL_CONS_CDR(obj); + cdr = HCL_CNODE_CONS_CDR(obj); - if (HCL_IS_NIL(hcl, cdr)) + if (!cdr) { nargs = 0; } else { - if (!HCL_IS_NIL(hcl, cdr) && !HCL_IS_CONS(hcl, cdr)) + if (!HCL_CNODE_IS_CONS(cdr)) { /* (funname . 10) */ - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in function call - %O", obj); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(cdr), HCL_CNODE_GET_TOK(cdr), "redundant cdr in function call"); return -1; } - nargs = hcl_countcons(hcl, cdr); + nargs = hcl_countcnodecons(hcl, cdr); if (nargs > MAX_CODE_PARAM) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) parameters in function call - %O", nargs, obj); @@ -1760,7 +1742,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) } } - if (HCL_IS_SYMBOL(hcl, car)) + if (HCL_CNODE_IS_SYMBOL(car)) { /* only symbols are added to the system dictionary. * perform this lookup only if car is a symbol */ @@ -1791,7 +1773,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) } else { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_CALLABLE, HCL_NULL, HCL_NULL, "invalid callable %O in function call - %O", car, obj); /* error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_CALLABLE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "invalid callable in function call"); return -1; } @@ -1802,23 +1784,23 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) { hcl_oow_t index; - HCL_ASSERT (hcl, obj->type == HCL_CNODE_SYMBOL); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(obj)); - if (hcl_getsyncodebyoocs_noseterr(hcl, &obj->u.symbol) > 0) + if (hcl_getsyncodebyoocs_noseterr(hcl, HCL_CNODE_GET_TOK(obj)) > 0) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, &obj->loc, HCL_NULL, - "special symbol not to be used as a variable name - %.*js", obj->u.symbol.len, obj->u.symbol.ptr); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(obj), HCL_NULL, + "special symbol not to be used as a variable name - %.*js", HCL_CNODE_GET_TOKLEN(obj), HCL_CNODE_GET_TOKPTR(obj)); return -1; } /* check if a symbol is a local variable */ - if (find_temporary_variable_backward(hcl, &obj->u.symbol, &index) <= -1) + if (find_temporary_variable_backward(hcl, HCL_CNODE_GET_TOK(obj), &index) <= -1) { hcl_oop_t sym, cons; /* TODO: if i require all variables to be declared, this part is not needed and should handle it as an error */ /* TODO: change the scheme... allow declaration??? */ /* global variable */ - sym = hcl_makesymbol(hcl, obj->u.symbol.ptr, obj->u.symbol.len); + sym = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(obj), HCL_CNODE_GET_TOKLEN(obj)); if (HCL_UNLIKELY(!sym)) return -1; cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym); @@ -1883,7 +1865,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, const hcl_ioloc_t* if (*ptr != '#') { - hcl_setsynerrbfmt(hcl, HCL_SYNERR_RADIX, loc, HCL_NULL, "radixed number not starting with # - %.*js", str->len, str->ptr); + hcl_setsynerrbfmt(hcl, HCL_SYNERR_RADIX, loc, str, "radixed number not starting with #"); return HCL_NULL; } ptr++; /* skip '#' */ @@ -1893,7 +1875,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, const hcl_ioloc_t* else if (*ptr == 'b') base = 2; else { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_RADIX, loc, HCL_NULL, "invalid radix specifier - %c", *ptr); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_RADIX, loc, str, "invalid radix specifier %c", *ptr); return HCL_NULL; } ptr++; @@ -1940,7 +1922,6 @@ static hcl_oop_t string_to_fpdec (hcl_t* hcl, hcl_oocs_t* str, const hcl_ioloc_t return hcl_makefpdec(hcl, v, scale); } - static int compile_object (hcl_t* hcl) { hcl_cframe2_t* cf; @@ -1951,18 +1932,18 @@ static int compile_object (hcl_t* hcl) HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT); oprnd = cf->operand; - switch (oprnd->type) + switch (HCL_CNODE_GET_TYPE(oprnd)) { case HCL_CNODE_NIL: - EMIT_BYTE_INSTRUCTION (hcl, HCL_CODE_PUSH_NIL); + if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_NULL) <= -1) return -1; goto done; case HCL_CNODE_TRUE: - EMIT_BYTE_INSTRUCTION (hcl, HCL_CODE_PUSH_TRUE); + if (emit_byte_instruction(hcl, HCL_CODE_PUSH_TRUE, HCL_NULL) <= -1) return -1; goto done; case HCL_CNODE_FALSE: - EMIT_BYTE_INSTRUCTION (hcl, HCL_CODE_PUSH_FALSE); + if (emit_byte_instruction(hcl, HCL_CODE_PUSH_FALSE, HCL_NULL) <= -1) return -1; goto done; case HCL_CNODE_CHARLIT: @@ -1970,22 +1951,22 @@ static int compile_object (hcl_t* hcl) goto literal; case HCL_CNODE_STRLIT: - lit = hcl_makestring(hcl, oprnd->u.strlit.ptr, oprnd->u.strlit.len, 0); + lit = hcl_makestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd), 0); if (HCL_UNLIKELY(!lit)) return -1; goto literal; case HCL_CNODE_NUMLIT: - lit = string_to_num(hcl, &oprnd->u.numlit, &oprnd->loc, 0); + lit = string_to_num(hcl, HCL_CNODE_GET_TOK(oprnd), HCL_CNODE_GET_LOC(oprnd), 0); if (HCL_UNLIKELY(!lit)) return -1; goto literal; case HCL_CNODE_RADNUMLIT: - lit = string_to_num(hcl, &oprnd->u.radnumlit, &oprnd->loc, 1); + lit = string_to_num(hcl, HCL_CNODE_GET_TOK(oprnd), HCL_CNODE_GET_LOC(oprnd), 1); if (HCL_UNLIKELY(!lit)) return -1; goto literal; case HCL_CNODE_FPDECLIT: - lit = string_to_fpdec(hcl, &oprnd->u.fpdeclit, &oprnd->loc); + lit = string_to_fpdec(hcl, HCL_CNODE_GET_TOK(oprnd), HCL_CNODE_GET_LOC(oprnd)); if (HCL_UNLIKELY(!lit)) return -1; goto literal; @@ -2001,44 +1982,89 @@ static int compile_object (hcl_t* hcl) if (compile_symbol(hcl, oprnd) <= -1) return -1; goto done; -#if 0 +#if 0 + +// TODO: ... case HCL_CNODE_DSYMBOL: if (compile_dsymbol(hcl, oprnd) <= -1) return -1; goto done; #endif - case HCL_CNODE_LIST: + case HCL_CNODE_CONS: { - switch (oprnd->u.list.type) + switch (HCL_CNODE_CONS_CONCODE(oprnd)) { case HCL_CONCODE_XLIST: if (compile_cons_xlist_expression(hcl, oprnd) <= -1) return -1; break; case HCL_CONCODE_ARRAY: - //if (compile_cons_array_expression(hcl, oprnd) <= -1) return -1; + if (compile_cons_array_expression(hcl, oprnd) <= -1) return -1; break; case HCL_CONCODE_BYTEARRAY: - //if (compile_cons_bytearray_expression(hcl, oprnd) <= -1) return -1; + if (compile_cons_bytearray_expression(hcl, oprnd) <= -1) return -1; break; case HCL_CONCODE_DIC: - //if (compile_cons_dic_expression(hcl, oprnd) <= -1) return -1; + if (compile_cons_dic_expression(hcl, oprnd) <= -1) return -1; break; case HCL_CONCODE_QLIST: + #if 0 //if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1; - break; + // break; + #else + hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - qlist not implemented"); + return -1; + #endif case HCL_CONCODE_VLIST: - hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, &oprnd->loc, HCL_NULL, "variable declaration disallowed"); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "variable declaration disallowed"); return -1; default: - hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, &oprnd->loc, HCL_NULL, "internal error - unknown list type %d ", oprnd->u.list.type); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - unknown cons type %d", HCL_CNODE_CONS_CONCODE(oprnd)); return -1; } + + break; } - case HCL_CNODE_CONS: /* this type can never start a list. it should never be seen here. */ - //default: - hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, &oprnd->loc, HCL_NULL, "internal error - unexpected object type %d ", oprnd->type); + case HCL_CNODE_LIST: + { + /* empty list */ + switch (HCL_CNODE_LIST_CONCODE(oprnd)) + { + case HCL_CONCODE_XLIST: + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty executable list"); + return -1; + + case HCL_CONCODE_ARRAY: + if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0) <= -1) return -1; + goto done; + + case HCL_CONCODE_BYTEARRAY: + if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_BYTEARRAY, 0) <= -1) return -1; + goto done; + + case HCL_CONCODE_DIC: + if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_DIC, 16) <= -1) return -1; + goto done; + + case HCL_CONCODE_QLIST: + if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_NULL) <= -1) return -1; + goto done; + + case HCL_CONCODE_VLIST: + hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "variable declaration disallowed"); + return -1; + + default: + hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - unknown list type %d", HCL_CNODE_CONS_CONCODE(oprnd)); + return -1; + } + + break; + } + + default: + hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "internal error - unexpected object type %d", HCL_CNODE_GET_TYPE(oprnd)); return -1; } @@ -2055,7 +2081,7 @@ done: static int compile_object_list (hcl_t* hcl) { hcl_cframe2_t* cf; - hcl_oop_t coprnd; + hcl_cnode_t* oprnd; int cop; cf = GET_TOP_CFRAME(hcl); @@ -2066,68 +2092,66 @@ static int compile_object_list (hcl_t* hcl) cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL); cop = cf->opcode; - coprnd = cf->operand; + oprnd = cf->operand; - if (HCL_IS_NIL(hcl, coprnd)) + if (!oprnd) { POP_CFRAME (hcl); } else { - hcl_oop_t car, cdr; + hcl_cnode_t* car, * cdr; if (cop != COP_COMPILE_ARGUMENT_LIST) { /* eliminate unnecessary non-function calls. keep the last one */ - while (HCL_IS_CONS(hcl, coprnd)) + while (HCL_CNODE_IS_CONS(oprnd)) { - cdr = HCL_CONS_CDR(coprnd); - if (HCL_IS_NIL(hcl,cdr)) break; /* keep the last one */ + cdr = HCL_CNODE_CONS_CDR(oprnd); + if (!cdr) break; /* keep the last one */ - if (HCL_IS_CONS(hcl, cdr)) + if (HCL_CNODE_IS_CONS(cdr)) { /* look ahead */ /* keep the last one before elif or else... */ - car = HCL_CONS_CAR(cdr); - if (HCL_IS_SYMBOL(hcl, car) && HCL_OBJ_GET_FLAGS_SYNCODE(car)) break; + car = HCL_CNODE_CONS_CAR(cdr); + if (HCL_CNODE_IS_SYMBOL(car) && HCL_CNODE_SYMBOL_SYNCODE(car)) break; } - car = HCL_CONS_CAR(coprnd); - if (HCL_IS_CONS(hcl, car) || (HCL_IS_SYMBOL(hcl, car) && HCL_OBJ_GET_FLAGS_SYNCODE(car))) break; - coprnd = cdr; + car = HCL_CNODE_CONS_CAR(oprnd); + if (HCL_CNODE_IS_CONS(car) || (HCL_CNODE_IS_SYMBOL(car) && HCL_CNODE_SYMBOL_SYNCODE(car))) break; + oprnd = cdr; } - HCL_ASSERT (hcl, !HCL_IS_NIL(hcl, coprnd)); + HCL_ASSERT (hcl, oprnd != HCL_NULL); } - if (!HCL_IS_CONS(hcl, coprnd)) + if (!HCL_CNODE_IS_CONS(oprnd)) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in the object list - %O", coprnd); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the object list"); return -1; } - car = HCL_CONS_CAR(coprnd); - cdr = HCL_CONS_CDR(coprnd); + car = HCL_CNODE_CONS_CAR(oprnd); + cdr = HCL_CNODE_CONS_CDR(oprnd); if (cop == COP_COMPILE_IF_OBJECT_LIST || cop == COP_COMPILE_IF_OBJECT_LIST_TAIL) { - if (car == hcl->_elif) + if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELIF)) { - SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELIF, coprnd); + SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELIF, oprnd); goto done; } - else if (car == hcl->_else) + else if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_ELSE)) { - SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELSE, coprnd); + SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_ELSE, oprnd); goto done; } } SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); - if (!HCL_IS_NIL(hcl, cdr)) + if (cdr) { /* there is a next statement to compile * @@ -2152,7 +2176,7 @@ static int compile_object_list (hcl_t* hcl) { /* emit POP_STACKTOP before evaluating the second objects * and onwards. this goes above COP_COMPILE_OBJECT */ - PUSH_CFRAME (hcl, COP_EMIT_POP_STACKTOP, hcl->_nil); + PUSH_CFRAME (hcl, COP_EMIT_POP_STACKTOP, HCL_NULL); } } @@ -2163,37 +2187,35 @@ done: static int compile_array_list (hcl_t* hcl) { hcl_cframe2_t* cf; - hcl_oop_t coprnd; + hcl_cnode_t* oprnd; cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARRAY_LIST); - coprnd = cf->operand; + oprnd = cf->operand; - if (HCL_IS_NIL(hcl, coprnd)) + if (!oprnd) { POP_CFRAME (hcl); } else { - hcl_oop_t car, cdr; + hcl_cnode_t* car, * cdr; hcl_ooi_t oldidx; - if (!HCL_IS_CONS(hcl, coprnd)) + if (!HCL_CNODE_IS_CONS(oprnd)) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in the array list - %O", coprnd); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the array list"); return -1; } - car = HCL_CONS_CAR(coprnd); - cdr = HCL_CONS_CDR(coprnd); + car = HCL_CNODE_CONS_CAR(oprnd); + cdr = HCL_CNODE_CONS_CDR(oprnd); oldidx = cf->u.array_list.index; SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); - if (!HCL_IS_NIL(hcl, cdr)) + if (cdr) { PUSH_SUBCFRAME (hcl, COP_COMPILE_ARRAY_LIST, cdr); cf = GET_SUBCFRAME(hcl); @@ -2210,37 +2232,35 @@ static int compile_array_list (hcl_t* hcl) static int compile_bytearray_list (hcl_t* hcl) { hcl_cframe2_t* cf; - hcl_oop_t coprnd; + hcl_cnode_t* oprnd; cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_BYTEARRAY_LIST); - coprnd = cf->operand; + oprnd = cf->operand; - if (HCL_IS_NIL(hcl, coprnd)) + if (!oprnd) { POP_CFRAME (hcl); } else { - hcl_oop_t car, cdr; + hcl_cnode_t* car, * cdr; hcl_ooi_t oldidx; - if (!HCL_IS_CONS(hcl, coprnd)) + if (!HCL_CNODE_IS_CONS(oprnd)) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in the byte-array list - %O", coprnd); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the byte-array list"); return -1; } - car = HCL_CONS_CAR(coprnd); - cdr = HCL_CONS_CDR(coprnd); + car = HCL_CNODE_CONS_CAR(oprnd); + cdr = HCL_CNODE_CONS_CDR(oprnd); oldidx = cf->u.bytearray_list.index; SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); - if (!HCL_IS_NIL(hcl, cdr)) + if (cdr) { PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, cdr); cf = GET_SUBCFRAME(hcl); @@ -2257,45 +2277,41 @@ static int compile_bytearray_list (hcl_t* hcl) static int compile_dic_list (hcl_t* hcl) { hcl_cframe2_t* cf; - hcl_oop_t coprnd; + hcl_cnode_t* oprnd; cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_DIC_LIST); - coprnd = cf->operand; + oprnd = cf->operand; - if (HCL_IS_NIL(hcl, coprnd)) + if (!oprnd) { POP_CFRAME (hcl); } else { - hcl_oop_t car, cdr, cadr, cddr; + hcl_cnode_t* car, * cdr, * cadr, * cddr; - if (!HCL_IS_CONS(hcl, coprnd)) + if (!HCL_CNODE_IS_CONS(oprnd)) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in the dictionary list - %O", coprnd); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the dictionary list"); return -1; } - car = HCL_CONS_CAR(coprnd); - cdr = HCL_CONS_CDR(coprnd); + car = HCL_CNODE_CONS_CAR(oprnd); + cdr = HCL_CNODE_CONS_CDR(oprnd); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); - if (HCL_IS_NIL(hcl, cdr)) + if (!cdr) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_UNBALKV, HCL_NULL, HCL_NULL, - "no value for key %O", car); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_UNBALKV, HCL_CNODE_GET_LOC(car), HCL_NULL, "no value for key %.*js", HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car)); return -1; } - cadr = HCL_CONS_CAR(cdr); - cddr = HCL_CONS_CDR(cdr); + cadr = HCL_CNODE_CONS_CAR(cdr); + cddr = HCL_CNODE_CONS_CDR(cdr); - if (!HCL_IS_NIL(hcl, cddr)) + if (cddr) { PUSH_SUBCFRAME (hcl, COP_COMPILE_DIC_LIST, cddr); } @@ -2310,37 +2326,39 @@ static int compile_dic_list (hcl_t* hcl) static int compile_qlist (hcl_t* hcl) { hcl_cframe2_t* cf; - hcl_oop_t coprnd; + hcl_cnode_t* oprnd; cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_QLIST); - coprnd = cf->operand; + oprnd = cf->operand; - if (HCL_IS_NIL(hcl, coprnd)) + if (!oprnd) { POP_CFRAME (hcl); } else { - hcl_oop_t car, cdr; + hcl_cnode_t* car, * cdr; hcl_ooi_t oldidx; - if (!HCL_IS_CONS(hcl, coprnd)) +// TODO: correct this function in pair with compile_cons_qlist_expression() +#if 0 +//qlist allows non-nil cdr... + if (!HCL_CNODE_IS_CONS(oprnd)) { - hcl_setsynerrbfmt ( - hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in the qlist list - %O", coprnd); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the q-list"); return -1; } +#endif - car = HCL_CONS_CAR(coprnd); - cdr = HCL_CONS_CDR(coprnd); + car = HCL_CNODE_CONS_CAR(oprnd); + cdr = HCL_CNODE_CONS_CDR(oprnd); /*oldidx = cf->u.qlist.index;*/ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); - if (!HCL_IS_NIL(hcl, cdr)) + if (!cdr) { PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr); cf = GET_SUBCFRAME(hcl); @@ -2479,7 +2497,7 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl) static HCL_INLINE int subcompile_and_expr (hcl_t* hcl) { - hcl_oop_t obj, expr; + hcl_cnode_t* obj, * expr; hcl_cframe2_t* cf; hcl_ooi_t jump_inst_pos; @@ -2489,16 +2507,15 @@ static HCL_INLINE int subcompile_and_expr (hcl_t* hcl) obj = cf->operand; /* TODO: optimization - eat away all true expressions */ - if (HCL_IS_NIL(hcl, obj)) + if (!obj) { /* no more */ POP_CFRAME (hcl); return 0; } - else if (!HCL_IS_CONS(hcl, obj)) + else if (!HCL_CNODE_IS_CONS(obj)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in and - %O", obj); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and"); return -1; } @@ -2508,8 +2525,8 @@ static HCL_INLINE int subcompile_and_expr (hcl_t* hcl) if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1; - expr = HCL_CONS_CAR(obj); - obj = HCL_CONS_CDR(obj); + expr = HCL_CNODE_CONS_CAR(obj); + obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ @@ -2546,7 +2563,7 @@ static HCL_INLINE int post_and_expr (hcl_t* hcl) static HCL_INLINE int subcompile_or_expr (hcl_t* hcl) { - hcl_oop_t obj, expr; + hcl_cnode_t* obj, * expr; hcl_cframe2_t* cf; hcl_ooi_t jump_inst_pos; @@ -2556,16 +2573,15 @@ static HCL_INLINE int subcompile_or_expr (hcl_t* hcl) obj = cf->operand; /* TODO: optimization - eat away all false expressions */ - if (HCL_IS_NIL(hcl, obj)) + if (!obj) { /* no more */ POP_CFRAME (hcl); return 0; } - else if (!HCL_IS_CONS(hcl, obj)) + else if (!HCL_CNODE_IS_CONS(obj)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, - "redundant cdr in or - %O", obj); /* TODO: error location */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in or"); return -1; } @@ -2575,8 +2591,8 @@ static HCL_INLINE int subcompile_or_expr (hcl_t* hcl) if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1; - expr = HCL_CONS_CAR(obj); - obj = HCL_CONS_CDR(obj); + expr = HCL_CNODE_CONS_CAR(obj); + obj = HCL_CNODE_CONS_CDR(obj); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ @@ -3007,8 +3023,7 @@ static HCL_INLINE int emit_set (hcl_t* hcl) hcl_oow_t index; hcl_oop_t cons; - //HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, cf->operand)); - HCL_ASSERT (hcl, cf->operand->type == HCL_CNODE_SYMBOL); + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(cf->operand)); /* TODO: make a symbol now */ cons = (hcl_oop_t)hcl_getatsysdic(hcl, cf->operand); diff --git a/lib/gc.c b/lib/gc.c index 4564069..159fb75 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -840,6 +840,7 @@ int hcl_ignite (hcl_t* hcl) } + int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name) { hcl_oow_t i; @@ -850,3 +851,24 @@ int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name) } return 0; /* 0 indicates no syntax code found */ } + +int hcl_getsyncode_noseterr (hcl_t* hcl, const hcl_ooch_t* ptr, const hcl_oow_t len) +{ + hcl_oow_t i; + for (i = 0; i < HCL_COUNTOF(syminfo); i++) + { + if (hcl_comp_oochars(syminfo[i].ptr, syminfo[i].len, ptr, len) == 0) + return syminfo[i].syncode; + } + return 0; /* 0 indicates no syntax code found */ +} + +const hcl_ooch_t* hcl_getsyncodename_noseterr (hcl_t* hcl, hcl_syncode_t syncode) +{ + hcl_oow_t i; + for (i = 0; i < HCL_COUNTOF(syminfo); i++) + { + if (syncode == syminfo[i].syncode) return syminfo[i].ptr; + } + return HCL_NULL; +} diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 45e1a96..12a7107 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -196,33 +196,38 @@ enum hcl_cnode_type_t HCL_CNODE_TRUE, HCL_CNODE_FALSE, -#if 0 - HCL_CNODE_AND, - HCL_CNODE_BREAK, - HCL_CNODE_DEFUN, - HCL_CNODE_DO, - HCL_CNODE_ELIF, - HCL_CNODE_ELSE, - HCL_CNODE_IF, - HCL_CNODE_LAMBDA, - HCL_CNODE_OR, - HCL_CNODE_RETURN, - HCL_CNODE_RETURN_FROM_HOME, - HCL_CNODE_SET, - HCL_CNODE_UNTIL, - HCL_CNODE_WHILE, -#endif - HCL_CNODE_CONS, HCL_CNODE_LIST }; typedef enum hcl_cnode_type_t hcl_cnode_type_t; +#define HCL_CNODE_GET_TYPE(x) ((x)->cn_type) +#define HCL_CNODE_GET_LOC(x) (&(x)->cn_loc) +#define HCL_CNODE_GET_TOK(x) (&(x)->cn_tok) +#define HCL_CNODE_GET_TOKPTR(x) ((x)->cn_tok.ptr) +#define HCL_CNODE_GET_TOKLEN(x) ((x)->cn_tok.len) + +#define HCL_CNODE_IS_SYMBOL(x) ((x)->cn_type == HCL_CNODE_SYMBOL) +#define HCL_CNODE_IS_SYMBOL_SYNCODED(x, code) ((x)->cn_type == HCL_CNODE_SYMBOL && (x)->u.symbol.syncode == (code)) +#define HCL_CNODE_SYMBOL_SYNCODE(x) ((x)->u.symbol.syncode) + +#define HCL_CNODE_IS_CONS(x) ((x)->cn_type == HCL_CNODE_CONS) +#define HCL_CNODE_IS_CONS_CONCODED(x, code) ((x)->cn_type == HCL_CNODE_CONS && (x)->u.cons.concode == (code)) +#define HCL_CNODE_CONS_CONCODE(x) ((x)->u.cons.concode) +#define HCL_CNODE_CONS_CAR(x) ((x)->u.cons.car) +#define HCL_CNODE_CONS_CDR(x) ((x)->u.cons.cdr) + + +#define HCL_CNODE_IS_LIST(x) ((x)->cn_type == HCL_CNODE_LIST) +#define HCL_CNODE_IS_LIST_CONCODED(x) ((x)->cn_type == HCL_CNODE_LIST && (x)->u.list.concode == (code)) +#define HCL_CNODE_LIST_CONCODE(x) ((x)->u.list.concode) + /* NOTE: hcl_cnode_t used by the built-in compiler is not an OOP object */ struct hcl_cnode_t { - hcl_cnode_type_t type; - hcl_ioloc_t loc; + hcl_cnode_type_t cn_type; + hcl_ioloc_t cn_loc; + hcl_oocs_t cn_tok; union { @@ -231,12 +236,10 @@ struct hcl_cnode_t hcl_ooch_t v; } charlit; - hcl_oocs_t symbol; - hcl_oocs_t dsymbol; - hcl_oocs_t strlit; - hcl_oocs_t numlit; - hcl_oocs_t radnumlit; - hcl_oocs_t fpdeclit; + struct + { + hcl_syncode_t syncode; /* special if non-zero */ + } symbol; struct { @@ -248,13 +251,13 @@ struct hcl_cnode_t } errlit; struct { + hcl_concode_t concode; hcl_cnode_t* car; hcl_cnode_t* cdr; } cons; struct { - hcl_cnode_t* head; /* its type must be HCL_CNODE_CONS */ - hcl_concode_t type; + hcl_concode_t concode; } list; } u; }; @@ -955,6 +958,18 @@ int hcl_getsyncodebyoocs_noseterr ( const hcl_oocs_t* name ); +int hcl_getsyncode_noseterr ( + hcl_t* hcl, + const hcl_ooch_t* ptr, + const hcl_oow_t len +); + +const hcl_ooch_t* hcl_getsyncodename_noseterr ( + hcl_t* hcl, + hcl_syncode_t syncode +); + + /* ========================================================================= */ /* utf8.c */ /* ========================================================================= */ @@ -1307,22 +1322,23 @@ int hcl_emitbyteinstruction ( /* ========================================================================= */ /* cnode.c */ /* ========================================================================= */ -hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc); -hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc); -hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc); -hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t ch); -hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnodedsymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); -hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_oow_t v); -hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_ooi_t v); +hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, const hcl_ooch_t v); +hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodedsymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, hcl_oow_t v); +hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_oocs_t* tok, hcl_ooi_t v); hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr); -hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type, hcl_cnode_t* head); +hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type); void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c); void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c); +hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons); #if defined(__cplusplus) } diff --git a/lib/read2.c b/lib/read2.c index ebe7a5b..adf9d53 100644 --- a/lib/read2.c +++ b/lib/read2.c @@ -1461,10 +1461,15 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv * (lambda () ...) is equivalent to (lambda #nil ...) * (defun x() ...) */ - /* [NOTE] the head is NULL if the list is empty */ - list = hcl_makecnodelist(hcl, &loc, concode, head); - if (HCL_UNLIKELY(!list)) hcl_freecnode (hcl, head); - return list; + if (head) + { + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(head)); + HCL_CNODE_CONS_CONCODE(head) = concode; + return head; + } + + /* the list is empty */ + return hcl_makecnodelist(hcl, &loc, concode); } static HCL_INLINE int can_dot_list (hcl_t* hcl) @@ -1569,7 +1574,7 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) /* chain the object via 'cdr' of the tail cell */ tail = rstl->tail; HCL_ASSERT (hcl, tail != HCL_NULL); - HCL_ASSERT (hcl, tail->type == HCL_CNODE_CONS); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail)); tail->u.cons.cdr = obj; /* update the flag to CLOSED so that you can have more than @@ -1591,7 +1596,7 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) return -1; } - cons = hcl_makecnodecons(hcl, &obj->loc, obj, HCL_NULL); + cons = hcl_makecnodecons(hcl, HCL_CNODE_GET_LOC(obj), obj, HCL_NULL); if (HCL_UNLIKELY(!cons)) return -1; if (rstl->count <= 0) @@ -1610,7 +1615,7 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) /* the new cons cell is not the first element. * append it to the list */ tail = rstl->tail; - HCL_ASSERT (hcl, tail->type == HCL_CNODE_CONS); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail)); tail->u.cons.cdr = cons; rstl->tail = cons; } @@ -1624,13 +1629,13 @@ static int chain_to_list (hcl_t* hcl, hcl_cnode_t* obj) static hcl_cnode_t* read_vlist (hcl_t* hcl) { - hcl_cnode_t* l; - hcl_cnode_t* ve; + hcl_cnode_t* vh, * ve; + hcl_ioloc_t start_loc; HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR); - l = hcl_makecnodelist(hcl, TOKEN_LOC(hcl), HCL_CONCODE_VLIST, HCL_NULL); - if (HCL_UNLIKELY(!l)) goto oops; + vh = ve = HCL_NULL; + start_loc = *TOKEN_LOC(hcl); GET_TOKEN_WITH_GOTO(hcl, oops); @@ -1638,7 +1643,7 @@ static hcl_cnode_t* read_vlist (hcl_t* hcl) { hcl_cnode_t* sym, * cons; - sym = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + sym = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); if (HCL_UNLIKELY(!sym)) goto oops; #if 0 @@ -1651,21 +1656,21 @@ static hcl_cnode_t* read_vlist (hcl_t* hcl) /* TODO: exclude special symbols.... or do the above check in the compiler code?? */ #endif - cons = hcl_makecnodecons(hcl, &sym->loc, sym, HCL_NULL); + cons = hcl_makecnodecons(hcl, HCL_CNODE_GET_LOC(sym), sym, HCL_NULL); if (HCL_UNLIKELY(!cons)) { hcl_freesinglecnode (hcl, sym); /* manual disposal because sym is not chained to the list */ goto oops; } - if (!l->u.list.head) + if (!vh) { - l->u.list.head = cons; + vh = cons; ve = cons; } else { - HCL_ASSERT (hcl, ve->type == HCL_CNODE_CONS); + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(ve)); ve->u.cons.cdr = cons; ve = cons; } @@ -1679,10 +1684,17 @@ static hcl_cnode_t* read_vlist (hcl_t* hcl) goto oops; } - return l; + if (vh) + { + HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(vh)); + HCL_CNODE_CONS_CONCODE(vh) = HCL_CONCODE_VLIST; + return vh; + } + + return hcl_makecnodelist(hcl, &start_loc, HCL_CONCODE_VLIST); oops: - if (l) hcl_freecnode (hcl, l); + if (vh) hcl_freecnode (hcl, vh); return HCL_NULL; } @@ -1735,14 +1747,9 @@ static hcl_cnode_t* read_object (hcl_t* hcl) goto start_list; case HCL_IOTOK_QLPAREN: /* #() */ -#if 1 - hcl_setsynerr (hcl, HCL_SYNERR_ILTOK, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); - goto oops; -#else flagv = 0; LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST); goto start_list; -#endif case HCL_IOTOK_LPAREN: /* () */ flagv = 0; @@ -1771,7 +1778,7 @@ static hcl_cnode_t* read_object (hcl_t* hcl) /* cannot have a period: * 1. at the top level - not inside () * 2. at the beginning of a list - * 3. inside an #(), #[], #{}, () */ + * 3. inside an array, byte-array, dictionary, xlist */ hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, TOKEN_LOC(hcl), HCL_NULL); goto oops; } @@ -1876,15 +1883,15 @@ static hcl_cnode_t* read_object (hcl_t* hcl) break; case HCL_IOTOK_NIL: - obj = hcl_makecnodenil(hcl, TOKEN_LOC(hcl)); + obj = hcl_makecnodenil(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_TRUE: - obj = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl)); + obj = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_FALSE: - obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl)); + obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_SMPTRLIT: @@ -1905,7 +1912,7 @@ static hcl_cnode_t* read_object (hcl_t* hcl) goto oops; } - obj = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), v); + obj = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl), v); break; } @@ -1927,24 +1934,24 @@ static hcl_cnode_t* read_object (hcl_t* hcl) } } - obj = hcl_makecnodeerrlit(hcl, TOKEN_LOC(hcl), v); + obj = hcl_makecnodeerrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl), v); break; } case HCL_IOTOK_CHARLIT: - obj = hcl_makecnodecharlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_CHAR(hcl, 0)); + obj = hcl_makecnodecharlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl), TOKEN_NAME_CHAR(hcl, 0)); break; case HCL_IOTOK_NUMLIT: - obj = hcl_makecnodenumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnodenumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_RADNUMLIT: - obj = hcl_makecnoderadnumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnoderadnumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_FPDECLIT: - obj = hcl_makecnodefpdeclit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnodefpdeclit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; /* @@ -1954,15 +1961,15 @@ static hcl_cnode_t* read_object (hcl_t* hcl) */ case HCL_IOTOK_STRLIT: - obj = hcl_makecnodestrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnodestrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_IDENT: - obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; case HCL_IOTOK_IDENT_DOTTED: - obj = hcl_makecnodedsymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + obj = hcl_makecnodedsymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); break; }