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

yet implementing the new compiler

Browse Source
This commit is contained in:
hyung-hwan
2021-01-19 14:07:42 +00:00
parent 919ab8f57e
commit 0fa279fa1c
8 changed files with 428 additions and 374 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
hcl/lib/Makefile.am
View File

@ -66,6 +66,7 @@ libhcl_la_SOURCES = \
bigint.c \ bigint.c \
cnode.c \ cnode.c \
comp.c \ comp.c \
comp2.c \
debug.c \ debug.c \
decode.c \ decode.c \
dic.c \ dic.c \

28
hcl/lib/Makefile.in
View File

@ -151,14 +151,14 @@ am__DEPENDENCIES_5 = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_2) \
$(am__DEPENDENCIES_3) $(am__DEPENDENCIES_4) $(am__DEPENDENCIES_3) $(am__DEPENDENCIES_4)
libhcl_la_DEPENDENCIES = $(am__DEPENDENCIES_5) $(am__append_6) libhcl_la_DEPENDENCIES = $(am__DEPENDENCIES_5) $(am__append_6)
am_libhcl_la_OBJECTS = libhcl_la-bigint.lo libhcl_la-cnode.lo \ 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-comp.lo libhcl_la-comp2.lo libhcl_la-debug.lo \
libhcl_la-dic.lo libhcl_la-err.lo libhcl_la-exec.lo \ libhcl_la-decode.lo libhcl_la-dic.lo libhcl_la-err.lo \
libhcl_la-fmt.lo libhcl_la-gc.lo libhcl_la-hcl.lo \ libhcl_la-exec.lo libhcl_la-fmt.lo libhcl_la-gc.lo \
libhcl_la-heap.lo libhcl_la-number.lo libhcl_la-obj.lo \ libhcl_la-hcl.lo libhcl_la-heap.lo libhcl_la-number.lo \
libhcl_la-opt.lo libhcl_la-prim.lo libhcl_la-print.lo \ libhcl_la-obj.lo libhcl_la-opt.lo libhcl_la-prim.lo \
libhcl_la-rbt.lo libhcl_la-read.lo libhcl_la-read2.lo \ libhcl_la-print.lo libhcl_la-rbt.lo libhcl_la-read.lo \
libhcl_la-sym.lo libhcl_la-utf8.lo libhcl_la-utl.lo \ libhcl_la-read2.lo libhcl_la-sym.lo libhcl_la-utf8.lo \
libhcl_la-xma.lo libhcl_la-utl.lo libhcl_la-xma.lo
libhcl_la_OBJECTS = $(am_libhcl_la_OBJECTS) libhcl_la_OBJECTS = $(am_libhcl_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@) AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_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__maybe_remake_depfiles = depfiles
am__depfiles_remade = ./$(DEPDIR)/libhcl_la-bigint.Plo \ am__depfiles_remade = ./$(DEPDIR)/libhcl_la-bigint.Plo \
./$(DEPDIR)/libhcl_la-cnode.Plo ./$(DEPDIR)/libhcl_la-comp.Plo \ ./$(DEPDIR)/libhcl_la-cnode.Plo ./$(DEPDIR)/libhcl_la-comp.Plo \
./$(DEPDIR)/libhcl_la-comp2.Plo \
./$(DEPDIR)/libhcl_la-debug.Plo \ ./$(DEPDIR)/libhcl_la-debug.Plo \
./$(DEPDIR)/libhcl_la-decode.Plo ./$(DEPDIR)/libhcl_la-dic.Plo \ ./$(DEPDIR)/libhcl_la-decode.Plo ./$(DEPDIR)/libhcl_la-dic.Plo \
./$(DEPDIR)/libhcl_la-err.Plo ./$(DEPDIR)/libhcl_la-exec.Plo \ ./$(DEPDIR)/libhcl_la-err.Plo ./$(DEPDIR)/libhcl_la-exec.Plo \
@ -440,6 +441,7 @@ libhcl_la_SOURCES = \
bigint.c \ bigint.c \
cnode.c \ cnode.c \
comp.c \ comp.c \
comp2.c \
debug.c \ debug.c \
decode.c \ decode.c \
dic.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-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-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-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-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-decode.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-dic.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@ @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 @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 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_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 @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-bigint.Plo
-rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo -rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo
-rm -f ./$(DEPDIR)/libhcl_la-comp.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-debug.Plo
-rm -f ./$(DEPDIR)/libhcl_la-decode.Plo -rm -f ./$(DEPDIR)/libhcl_la-decode.Plo
-rm -f ./$(DEPDIR)/libhcl_la-dic.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-bigint.Plo
-rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo -rm -f ./$(DEPDIR)/libhcl_la-cnode.Plo
-rm -f ./$(DEPDIR)/libhcl_la-comp.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-debug.Plo
-rm -f ./$(DEPDIR)/libhcl_la-decode.Plo -rm -f ./$(DEPDIR)/libhcl_la-decode.Plo
-rm -f ./$(DEPDIR)/libhcl_la-dic.Plo -rm -f ./$(DEPDIR)/libhcl_la-dic.Plo

152
hcl/lib/cnode.c
View File

@ -26,119 +26,99 @@
#include "hcl-prv.h" #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_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; if (HCL_UNLIKELY(!cnode)) return HCL_NULL;
cnode->type = type; cnode->cn_type = type;
cnode->loc = *loc; 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; 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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.charlit.v = ch; c->u.charlit.v = v;
return c; 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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.symbol.ptr = (hcl_ooch_t*)(c + 1); c->u.symbol.syncode = hcl_getsyncodebyoocs_noseterr(hcl, tok);
c->u.symbol.len = len;
hcl_copy_oochars (c->u.symbol.ptr, ptr, len);
c->u.symbol.ptr[len] = '\0';
return c; 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)); return make_cnode(hcl, HCL_CNODE_DSYMBOL, loc, tok);
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;
} }
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)); return make_cnode(hcl, HCL_CNODE_STRLIT, loc, tok);
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;
} }
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)); return make_cnode(hcl, HCL_CNODE_NUMLIT, loc, tok);
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;
} }
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)); return make_cnode(hcl, HCL_CNODE_RADNUMLIT, loc, tok);
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;
} }
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)); return make_cnode(hcl, HCL_CNODE_FPDECLIT, loc, tok);
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;
} }
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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.smptrlit.v = v; c->u.smptrlit.v = v;
return c; 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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.errlit.v = v; c->u.errlit.v = v;
return c; 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* 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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.cons.car = car; c->u.cons.car = car;
c->u.cons.cdr = cdr; c->u.cons.cdr = cdr;
return c; 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; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.list.type = type; c->u.list.concode = type;
c->u.list.head = head;
return c; 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) void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c)
{ {
redo: 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: case HCL_CNODE_CONS:
{ {
hcl_cnode_t* tmp1, * tmp2; hcl_cnode_t* tmp1, * tmp2;
@ -196,7 +161,6 @@ redo:
HCL_ASSERT (hcl, tmp1 != HCL_NULL); HCL_ASSERT (hcl, tmp1 != HCL_NULL);
hcl_freemem (hcl, c); hcl_freemem (hcl, c);
hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */ hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */
if (tmp2) if (tmp2)
@ -213,3 +177,21 @@ redo:
break; 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;
}

1
hcl/lib/comp.c
View File

@ -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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in break - %O", src); /* TODO: error location */ "redundant cdr in break - %O", src); /* TODO: error location */
return -1;
} }
return -1; return -1;
} }

423
hcl/lib/comp2.c
View File

@ -35,12 +35,6 @@ enum
#define TV_BUFFER_ALIGN 256 #define TV_BUFFER_ALIGN 256
#define BLK_INFO_BUFFER_ALIGN 128 #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) 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_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_and); 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 */ /* no value */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, src->loc, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in and");
"no expression specified in and - %O", src); /* TODO: error location */
return -1; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and");
"redundant cdr in and - %O", src); /* TODO: error location */
return -1; return -1;
} }
/* TODO: optimization - eat away all true expressions */ /* TODO: optimization - eat away all true expressions */
expr = HCL_CONS_CAR(obj); expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */ 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; 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_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_or); 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 */ /* no value */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in or");
"no expression specified in or - %O", src); /* TODO: error location */
return -1; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and");
"redundant cdr in or - %O", src); /* TODO: error location */
return -1; return -1;
} }
/* TODO: optimization - eat away all false expressions */ /* TODO: optimization - eat away all false expressions */
expr = HCL_CONS_CAR(obj); expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_OR_EXPR, obj); /* 2 */ 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; 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) */ /* (break) */
hcl_oop_t obj; hcl_cnode_t* obj;
hcl_ooi_t i; hcl_ooi_t i;
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src)); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_break); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_BREAK));
obj = HCL_CONS_CDR(src); obj = HCL_CNODE_CONS_CDR(src);
if (!HCL_IS_NIL(hcl,obj)) if (obj)
{ {
if (HCL_IS_CONS(hcl,obj)) if (HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(obj), HCL_NULL, "redundant argument in break");
"redundant argument in break - %O", src); /* TODO: error location */
} }
else else
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in break");
"redundant cdr in break - %O", src); /* TODO: error location */
return -1;
} }
return -1; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BREAK, HCL_CNODE_GET_LOC(src), HCL_NULL, "break outside loop");
"break outside loop - %O", src); /* TODO: error location */
return -1; return -1;
} }
#if 0
static int compile_if (hcl_t* hcl, hcl_oop_t src) static int compile_if (hcl_t* hcl, hcl_oop_t src)
{ {
hcl_oop_t obj, cond; 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; 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; 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 */ * many operations can be performed without taking GC into account */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_ARRAY, HCL_SMOOI_TO_OOP(0)); 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) if (nargs > MAX_CODE_PARAM)
{ {
/* TODO: change to syntax error */ /* 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; return -1;
} }
@ -1521,7 +1509,7 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_oop_t obj)
return 0; 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 ] */ /* #[ ] - e.g. #[1, 2, 3] or #[ 1 2 3 ] */
hcl_ooi_t nargs; 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 */ * many operations can be performed without taking GC into account */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_BYTEARRAY, HCL_SMOOI_TO_OOP(0)); 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) if (nargs > MAX_CODE_PARAM)
{ {
/* TODO: change to syntax error */ /* 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; return -1;
} }
@ -1552,7 +1540,7 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_oop_t obj)
return 0; 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 } */ /* { } - e.g. {1:2, 3:4,"abc":def, "hwaddr":"00:00:00:01"} or { 1 2 3 4 } */
hcl_ooi_t nargs; 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)); 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) if (nargs > MAX_CODE_PARAM)
{ {
/* TODO: change to syntax error */ /* 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; return -1;
} }
@ -1579,7 +1567,8 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_oop_t obj)
return 0; 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 )
* #(1 (+ 2 3) 5) * #(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 */ * many operations can be performed without taking GC into account */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DLIST, HCL_SMOOI_TO_OOP(0)); 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) if (nargs > MAX_CODE_PARAM)
{ {
/* TODO: change to syntax error */ /* 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; 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) static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
{ {
hcl_cnode_t* head;
hcl_cnode_t* car; hcl_cnode_t* car;
int syncode; /* syntax code of the first element */ 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 * if the name is another function call, i can't know if the
* function name will be valid at the compile time. * function name will be valid at the compile time.
*/ */
HCL_ASSERT (hcl, obj->type == HCL_CNODE_LIST); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_XLIST));
HCL_ASSERT (hcl, obj->u.list.type == HCL_CONCODE_XLIST);
head = obj->u.list.head; car = HCL_CNODE_CONS_CAR(obj);
if (!head) if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
{
/* 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)
{ {
switch (syncode) 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; if (compile_break(hcl, obj) <= -1) return -1;
break; break;
#if 0
case HCL_SYNCODE_DEFUN: case HCL_SYNCODE_DEFUN:
if (compile_lambda(hcl, obj, 1) <= -1) return -1; if (compile_lambda(hcl, obj, 1) <= -1) return -1;
break; break;
@ -1676,11 +1657,12 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
/* (lambda (x y) (+ x y)) */ /* (lambda (x y) (+ x y)) */
if (compile_lambda(hcl, obj, 0) <= -1) return -1; if (compile_lambda(hcl, obj, 0) <= -1) return -1;
break; break;
#endif
case HCL_SYNCODE_OR: case HCL_SYNCODE_OR:
if (compile_or(hcl, obj) <= -1) return -1; if (compile_or(hcl, obj) <= -1) return -1;
break; break;
#if 0
case HCL_SYNCODE_SET: case HCL_SYNCODE_SET:
/* (set x 10) /* (set x 10)
* (set x (lambda (x y) (+ x y)) */ * (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: case HCL_SYNCODE_WHILE:
if (compile_while(hcl, obj, COP_POST_WHILE_COND) <= -1) return -1; if (compile_while(hcl, obj, COP_POST_WHILE_COND) <= -1) return -1;
break; break;
#endif
default: default:
HCL_DEBUG3 (hcl, "Internal error - unknown syncode %d at %s:%d\n", syncode, __FILE__, __LINE__); 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; return -1;
} }
} }
//else if (car->type == HCL_CNODE_SYMBOL || HCL_IS_CONS_CONCODED(hcl,car,HCL_CONCODE_XLIST)) else if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST))
else if (car->type == HCL_CNODE_SYMBOL || (car->type == HCL_CNODE_LIST && car->u.list.type == HCL_CONCODE_XLIST))
{ {
/* normal function call /* normal function call
* (<operator> <operand1> ...) */ * (<operator> <operand1> ...) */
hcl_ooi_t nargs; hcl_ooi_t nargs;
hcl_ooi_t oldtop; hcl_ooi_t oldtop;
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t cdr; hcl_cnode_t* cdr;
hcl_oop_cons_t sdc; hcl_cnode_t* sdc;
/* NOTE: cframe management functions don't use the object memory. /* NOTE: cframe management functions don't use the object memory.
* many operations can be performed without taking GC into account */ * 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); PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
/* compile <operand1> ... etc */ /* compile <operand1> ... etc */
cdr = HCL_CONS_CDR(obj); cdr = HCL_CNODE_CONS_CDR(obj);
if (HCL_IS_NIL(hcl, cdr)) if (!cdr)
{ {
nargs = 0; nargs = 0;
} }
else else
{ {
if (!HCL_IS_NIL(hcl, cdr) && !HCL_IS_CONS(hcl, cdr)) if (!HCL_CNODE_IS_CONS(cdr))
{ {
/* (funname . 10) */ /* (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; return -1;
} }
nargs = hcl_countcons(hcl, cdr); nargs = hcl_countcnodecons(hcl, cdr);
if (nargs > MAX_CODE_PARAM) 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); 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. /* only symbols are added to the system dictionary.
* perform this lookup only if car is a symbol */ * 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 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; return -1;
} }
@ -1802,23 +1784,23 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
{ {
hcl_oow_t index; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(obj), HCL_NULL,
"special symbol not to be used as a variable name - %.*js", obj->u.symbol.len, obj->u.symbol.ptr); "special symbol not to be used as a variable name - %.*js", HCL_CNODE_GET_TOKLEN(obj), HCL_CNODE_GET_TOKPTR(obj));
return -1; return -1;
} }
/* check if a symbol is a local variable */ /* 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; 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: 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??? */ /* TODO: change the scheme... allow declaration??? */
/* global variable */ /* 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; if (HCL_UNLIKELY(!sym)) return -1;
cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym); 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 != '#') 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; return HCL_NULL;
} }
ptr++; /* skip '#' */ 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 if (*ptr == 'b') base = 2;
else 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; return HCL_NULL;
} }
ptr++; 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); return hcl_makefpdec(hcl, v, scale);
} }
static int compile_object (hcl_t* hcl) static int compile_object (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
@ -1951,18 +1932,18 @@ static int compile_object (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT);
oprnd = cf->operand; oprnd = cf->operand;
switch (oprnd->type) switch (HCL_CNODE_GET_TYPE(oprnd))
{ {
case HCL_CNODE_NIL: 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; goto done;
case HCL_CNODE_TRUE: 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; goto done;
case HCL_CNODE_FALSE: 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; goto done;
case HCL_CNODE_CHARLIT: case HCL_CNODE_CHARLIT:
@ -1970,22 +1951,22 @@ static int compile_object (hcl_t* hcl)
goto literal; goto literal;
case HCL_CNODE_STRLIT: 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; if (HCL_UNLIKELY(!lit)) return -1;
goto literal; goto literal;
case HCL_CNODE_NUMLIT: 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; if (HCL_UNLIKELY(!lit)) return -1;
goto literal; goto literal;
case HCL_CNODE_RADNUMLIT: 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; if (HCL_UNLIKELY(!lit)) return -1;
goto literal; goto literal;
case HCL_CNODE_FPDECLIT: 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; if (HCL_UNLIKELY(!lit)) return -1;
goto literal; goto literal;
@ -2001,44 +1982,89 @@ static int compile_object (hcl_t* hcl)
if (compile_symbol(hcl, oprnd) <= -1) return -1; if (compile_symbol(hcl, oprnd) <= -1) return -1;
goto done; goto done;
#if 0 #if 0
// TODO: ...
case HCL_CNODE_DSYMBOL: case HCL_CNODE_DSYMBOL:
if (compile_dsymbol(hcl, oprnd) <= -1) return -1; if (compile_dsymbol(hcl, oprnd) <= -1) return -1;
goto done; goto done;
#endif #endif
case HCL_CNODE_LIST: case HCL_CNODE_CONS:
{ {
switch (oprnd->u.list.type) switch (HCL_CNODE_CONS_CONCODE(oprnd))
{ {
case HCL_CONCODE_XLIST: case HCL_CONCODE_XLIST:
if (compile_cons_xlist_expression(hcl, oprnd) <= -1) return -1; if (compile_cons_xlist_expression(hcl, oprnd) <= -1) return -1;
break; break;
case HCL_CONCODE_ARRAY: 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; break;
case HCL_CONCODE_BYTEARRAY: 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; break;
case HCL_CONCODE_DIC: 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; break;
case HCL_CONCODE_QLIST: case HCL_CONCODE_QLIST:
#if 0
//if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1; //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: 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; return -1;
default: 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; return -1;
} }
break;
} }
case HCL_CNODE_CONS: /* this type can never start a list. it should never be seen here. */ case HCL_CNODE_LIST:
//default: {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, &oprnd->loc, HCL_NULL, "internal error - unexpected object type %d ", oprnd->type); /* 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; return -1;
} }
@ -2055,7 +2081,7 @@ done:
static int compile_object_list (hcl_t* hcl) static int compile_object_list (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t coprnd; hcl_cnode_t* oprnd;
int cop; int cop;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
@ -2066,68 +2092,66 @@ static int compile_object_list (hcl_t* hcl)
cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL); cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL);
cop = cf->opcode; cop = cf->opcode;
coprnd = cf->operand; oprnd = cf->operand;
if (HCL_IS_NIL(hcl, coprnd)) if (!oprnd)
{ {
POP_CFRAME (hcl); POP_CFRAME (hcl);
} }
else else
{ {
hcl_oop_t car, cdr; hcl_cnode_t* car, * cdr;
if (cop != COP_COMPILE_ARGUMENT_LIST) if (cop != COP_COMPILE_ARGUMENT_LIST)
{ {
/* eliminate unnecessary non-function calls. keep the last one */ /* 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); cdr = HCL_CNODE_CONS_CDR(oprnd);
if (HCL_IS_NIL(hcl,cdr)) break; /* keep the last one */ if (!cdr) break; /* keep the last one */
if (HCL_IS_CONS(hcl, cdr)) if (HCL_CNODE_IS_CONS(cdr))
{ {
/* look ahead */ /* look ahead */
/* keep the last one before elif or else... */ /* keep the last one before elif or else... */
car = HCL_CONS_CAR(cdr); car = HCL_CNODE_CONS_CAR(cdr);
if (HCL_IS_SYMBOL(hcl, car) && HCL_OBJ_GET_FLAGS_SYNCODE(car)) break; if (HCL_CNODE_IS_SYMBOL(car) && HCL_CNODE_SYMBOL_SYNCODE(car)) break;
} }
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
if (HCL_IS_CONS(hcl, car) || (HCL_IS_SYMBOL(hcl, car) && HCL_OBJ_GET_FLAGS_SYNCODE(car))) break; if (HCL_CNODE_IS_CONS(car) || (HCL_CNODE_IS_SYMBOL(car) && HCL_CNODE_SYMBOL_SYNCODE(car))) break;
coprnd = cdr; 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_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the object list");
hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in the object list - %O", coprnd); /* TODO: error location */
return -1; return -1;
} }
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CONS_CDR(coprnd); cdr = HCL_CNODE_CONS_CDR(oprnd);
if (cop == COP_COMPILE_IF_OBJECT_LIST || cop == COP_COMPILE_IF_OBJECT_LIST_TAIL) 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; 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; goto done;
} }
} }
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!HCL_IS_NIL(hcl, cdr)) if (cdr)
{ {
/* there is a next statement to compile /* 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 /* emit POP_STACKTOP before evaluating the second objects
* and onwards. this goes above COP_COMPILE_OBJECT */ * 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) static int compile_array_list (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t coprnd; hcl_cnode_t* oprnd;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARRAY_LIST); 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); POP_CFRAME (hcl);
} }
else else
{ {
hcl_oop_t car, cdr; hcl_cnode_t* car, * cdr;
hcl_ooi_t oldidx; hcl_ooi_t oldidx;
if (!HCL_IS_CONS(hcl, coprnd)) if (!HCL_CNODE_IS_CONS(oprnd))
{ {
hcl_setsynerrbfmt ( hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the array list");
hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in the array list - %O", coprnd); /* TODO: error location */
return -1; return -1;
} }
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CONS_CDR(coprnd); cdr = HCL_CNODE_CONS_CDR(oprnd);
oldidx = cf->u.array_list.index; oldidx = cf->u.array_list.index;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!HCL_IS_NIL(hcl, cdr)) if (cdr)
{ {
PUSH_SUBCFRAME (hcl, COP_COMPILE_ARRAY_LIST, cdr); PUSH_SUBCFRAME (hcl, COP_COMPILE_ARRAY_LIST, cdr);
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
@ -2210,37 +2232,35 @@ static int compile_array_list (hcl_t* hcl)
static int compile_bytearray_list (hcl_t* hcl) static int compile_bytearray_list (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t coprnd; hcl_cnode_t* oprnd;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_BYTEARRAY_LIST); 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); POP_CFRAME (hcl);
} }
else else
{ {
hcl_oop_t car, cdr; hcl_cnode_t* car, * cdr;
hcl_ooi_t oldidx; hcl_ooi_t oldidx;
if (!HCL_IS_CONS(hcl, coprnd)) if (!HCL_CNODE_IS_CONS(oprnd))
{ {
hcl_setsynerrbfmt ( hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the byte-array list");
hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in the byte-array list - %O", coprnd); /* TODO: error location */
return -1; return -1;
} }
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CONS_CDR(coprnd); cdr = HCL_CNODE_CONS_CDR(oprnd);
oldidx = cf->u.bytearray_list.index; oldidx = cf->u.bytearray_list.index;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!HCL_IS_NIL(hcl, cdr)) if (cdr)
{ {
PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, cdr); PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, cdr);
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
@ -2257,45 +2277,41 @@ static int compile_bytearray_list (hcl_t* hcl)
static int compile_dic_list (hcl_t* hcl) static int compile_dic_list (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t coprnd; hcl_cnode_t* oprnd;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_DIC_LIST); 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); POP_CFRAME (hcl);
} }
else 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_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the dictionary list");
hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in the dictionary list - %O", coprnd); /* TODO: error location */
return -1; return -1;
} }
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CONS_CDR(coprnd); cdr = HCL_CNODE_CONS_CDR(oprnd);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (HCL_IS_NIL(hcl, cdr)) if (!cdr)
{ {
hcl_setsynerrbfmt ( 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));
hcl, HCL_SYNERR_UNBALKV, HCL_NULL, HCL_NULL,
"no value for key %O", car);
return -1; return -1;
} }
cadr = HCL_CONS_CAR(cdr); cadr = HCL_CNODE_CONS_CAR(cdr);
cddr = HCL_CONS_CDR(cdr); cddr = HCL_CNODE_CONS_CDR(cdr);
if (!HCL_IS_NIL(hcl, cddr)) if (cddr)
{ {
PUSH_SUBCFRAME (hcl, COP_COMPILE_DIC_LIST, 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) static int compile_qlist (hcl_t* hcl)
{ {
hcl_cframe2_t* cf; hcl_cframe2_t* cf;
hcl_oop_t coprnd; hcl_cnode_t* oprnd;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_QLIST); 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); POP_CFRAME (hcl);
} }
else else
{ {
hcl_oop_t car, cdr; hcl_cnode_t* car, * cdr;
hcl_ooi_t oldidx; 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_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the q-list");
hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL,
"redundant cdr in the qlist list - %O", coprnd); /* TODO: error location */
return -1; return -1;
} }
#endif
car = HCL_CONS_CAR(coprnd); car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CONS_CDR(coprnd); cdr = HCL_CNODE_CONS_CDR(oprnd);
/*oldidx = cf->u.qlist.index;*/ /*oldidx = cf->u.qlist.index;*/
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!HCL_IS_NIL(hcl, cdr)) if (!cdr)
{ {
PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr); PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr);
cf = GET_SUBCFRAME(hcl); 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) 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_cframe2_t* cf;
hcl_ooi_t jump_inst_pos; hcl_ooi_t jump_inst_pos;
@ -2489,16 +2507,15 @@ static HCL_INLINE int subcompile_and_expr (hcl_t* hcl)
obj = cf->operand; obj = cf->operand;
/* TODO: optimization - eat away all true expressions */ /* TODO: optimization - eat away all true expressions */
if (HCL_IS_NIL(hcl, obj)) if (!obj)
{ {
/* no more */ /* no more */
POP_CFRAME (hcl); POP_CFRAME (hcl);
return 0; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and");
"redundant cdr in and - %O", obj); /* TODO: error location */
return -1; 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_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; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1;
expr = HCL_CONS_CAR(obj); expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ 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) 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_cframe2_t* cf;
hcl_ooi_t jump_inst_pos; hcl_ooi_t jump_inst_pos;
@ -2556,16 +2573,15 @@ static HCL_INLINE int subcompile_or_expr (hcl_t* hcl)
obj = cf->operand; obj = cf->operand;
/* TODO: optimization - eat away all false expressions */ /* TODO: optimization - eat away all false expressions */
if (HCL_IS_NIL(hcl, obj)) if (!obj)
{ {
/* no more */ /* no more */
POP_CFRAME (hcl); POP_CFRAME (hcl);
return 0; 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, hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in or");
"redundant cdr in or - %O", obj); /* TODO: error location */
return -1; 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_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; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1;
expr = HCL_CONS_CAR(obj); expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ 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_oow_t index;
hcl_oop_t cons; hcl_oop_t cons;
//HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, cf->operand)); HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(cf->operand));
HCL_ASSERT (hcl, cf->operand->type == HCL_CNODE_SYMBOL);
/* TODO: make a symbol now */ /* TODO: make a symbol now */
cons = (hcl_oop_t)hcl_getatsysdic(hcl, cf->operand); cons = (hcl_oop_t)hcl_getatsysdic(hcl, cf->operand);

22
hcl/lib/gc.c
View File

@ -840,6 +840,7 @@ int hcl_ignite (hcl_t* hcl)
} }
int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name) int hcl_getsyncodebyoocs_noseterr (hcl_t* hcl, const hcl_oocs_t* name)
{ {
hcl_oow_t i; 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 */ 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;
}

96
hcl/lib/hcl-prv.h
View File

@ -196,33 +196,38 @@ enum hcl_cnode_type_t
HCL_CNODE_TRUE, HCL_CNODE_TRUE,
HCL_CNODE_FALSE, 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_CONS,
HCL_CNODE_LIST HCL_CNODE_LIST
}; };
typedef enum hcl_cnode_type_t hcl_cnode_type_t; 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 */ /* NOTE: hcl_cnode_t used by the built-in compiler is not an OOP object */
struct hcl_cnode_t struct hcl_cnode_t
{ {
hcl_cnode_type_t type; hcl_cnode_type_t cn_type;
hcl_ioloc_t loc; hcl_ioloc_t cn_loc;
hcl_oocs_t cn_tok;
union union
{ {
@ -231,12 +236,10 @@ struct hcl_cnode_t
hcl_ooch_t v; hcl_ooch_t v;
} charlit; } charlit;
hcl_oocs_t symbol; struct
hcl_oocs_t dsymbol; {
hcl_oocs_t strlit; hcl_syncode_t syncode; /* special if non-zero */
hcl_oocs_t numlit; } symbol;
hcl_oocs_t radnumlit;
hcl_oocs_t fpdeclit;
struct struct
{ {
@ -248,13 +251,13 @@ struct hcl_cnode_t
} errlit; } errlit;
struct struct
{ {
hcl_concode_t concode;
hcl_cnode_t* car; hcl_cnode_t* car;
hcl_cnode_t* cdr; hcl_cnode_t* cdr;
} cons; } cons;
struct struct
{ {
hcl_cnode_t* head; /* its type must be HCL_CNODE_CONS */ hcl_concode_t concode;
hcl_concode_t type;
} list; } list;
} u; } u;
}; };
@ -955,6 +958,18 @@ int hcl_getsyncodebyoocs_noseterr (
const hcl_oocs_t* name 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 */ /* utf8.c */
/* ========================================================================= */ /* ========================================================================= */
@ -1307,22 +1322,23 @@ int hcl_emitbyteinstruction (
/* ========================================================================= */ /* ========================================================================= */
/* cnode.c */ /* cnode.c */
/* ========================================================================= */ /* ========================================================================= */
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);
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);
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);
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* 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* 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* 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* 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* 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* 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* 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* 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* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr); 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_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c);
void hcl_freecnode (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) #if defined(__cplusplus)
} }

79
hcl/lib/read2.c
View File

@ -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 ...) * (lambda () ...) is equivalent to (lambda #nil ...)
* (defun x() ...) */ * (defun x() ...) */
/* [NOTE] the head is NULL if the list is empty */ if (head)
list = hcl_makecnodelist(hcl, &loc, concode, head); {
if (HCL_UNLIKELY(!list)) hcl_freecnode (hcl, head); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(head));
return list; 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) 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 */ /* chain the object via 'cdr' of the tail cell */
tail = rstl->tail; tail = rstl->tail;
HCL_ASSERT (hcl, tail != HCL_NULL); 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; tail->u.cons.cdr = obj;
/* update the flag to CLOSED so that you can have more than /* 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; 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 (HCL_UNLIKELY(!cons)) return -1;
if (rstl->count <= 0) 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. /* the new cons cell is not the first element.
* append it to the list */ * append it to the list */
tail = rstl->tail; tail = rstl->tail;
HCL_ASSERT (hcl, tail->type == HCL_CNODE_CONS); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(tail));
tail->u.cons.cdr = cons; tail->u.cons.cdr = cons;
rstl->tail = 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) static hcl_cnode_t* read_vlist (hcl_t* hcl)
{ {
hcl_cnode_t* l; hcl_cnode_t* vh, * ve;
hcl_cnode_t* ve; hcl_ioloc_t start_loc;
HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR); HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR);
l = hcl_makecnodelist(hcl, TOKEN_LOC(hcl), HCL_CONCODE_VLIST, HCL_NULL); vh = ve = HCL_NULL;
if (HCL_UNLIKELY(!l)) goto oops; start_loc = *TOKEN_LOC(hcl);
GET_TOKEN_WITH_GOTO(hcl, oops); GET_TOKEN_WITH_GOTO(hcl, oops);
@ -1638,7 +1643,7 @@ static hcl_cnode_t* read_vlist (hcl_t* hcl)
{ {
hcl_cnode_t* sym, * cons; 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 (HCL_UNLIKELY(!sym)) goto oops;
#if 0 #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?? */ /* TODO: exclude special symbols.... or do the above check in the compiler code?? */
#endif #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)) if (HCL_UNLIKELY(!cons))
{ {
hcl_freesinglecnode (hcl, sym); /* manual disposal because sym is not chained to the list */ hcl_freesinglecnode (hcl, sym); /* manual disposal because sym is not chained to the list */
goto oops; goto oops;
} }
if (!l->u.list.head) if (!vh)
{ {
l->u.list.head = cons; vh = cons;
ve = cons; ve = cons;
} }
else else
{ {
HCL_ASSERT (hcl, ve->type == HCL_CNODE_CONS); HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(ve));
ve->u.cons.cdr = cons; ve->u.cons.cdr = cons;
ve = cons; ve = cons;
} }
@ -1679,10 +1684,17 @@ static hcl_cnode_t* read_vlist (hcl_t* hcl)
goto oops; 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: oops:
if (l) hcl_freecnode (hcl, l); if (vh) hcl_freecnode (hcl, vh);
return HCL_NULL; return HCL_NULL;
} }
@ -1735,14 +1747,9 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
goto start_list; goto start_list;
case HCL_IOTOK_QLPAREN: /* #() */ case HCL_IOTOK_QLPAREN: /* #() */
#if 1
hcl_setsynerr (hcl, HCL_SYNERR_ILTOK, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
goto oops;
#else
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
goto start_list; goto start_list;
#endif
case HCL_IOTOK_LPAREN: /* () */ case HCL_IOTOK_LPAREN: /* () */
flagv = 0; flagv = 0;
@ -1771,7 +1778,7 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
/* cannot have a period: /* cannot have a period:
* 1. at the top level - not inside () * 1. at the top level - not inside ()
* 2. at the beginning of a list * 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); hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, TOKEN_LOC(hcl), HCL_NULL);
goto oops; goto oops;
} }
@ -1876,15 +1883,15 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
break; break;
case HCL_IOTOK_NIL: case HCL_IOTOK_NIL:
obj = hcl_makecnodenil(hcl, TOKEN_LOC(hcl)); obj = hcl_makecnodenil(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break; break;
case HCL_IOTOK_TRUE: case HCL_IOTOK_TRUE:
obj = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl)); obj = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break; break;
case HCL_IOTOK_FALSE: case HCL_IOTOK_FALSE:
obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl)); obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
break; break;
case HCL_IOTOK_SMPTRLIT: case HCL_IOTOK_SMPTRLIT:
@ -1905,7 +1912,7 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
goto oops; goto oops;
} }
obj = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), v); obj = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME(hcl), v);
break; 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; break;
} }
case HCL_IOTOK_CHARLIT: 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; break;
case HCL_IOTOK_NUMLIT: 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; break;
case HCL_IOTOK_RADNUMLIT: 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; break;
case HCL_IOTOK_FPDECLIT: 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; break;
/* /*
@ -1954,15 +1961,15 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
*/ */
case HCL_IOTOK_STRLIT: 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; break;
case HCL_IOTOK_IDENT: 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; break;
case HCL_IOTOK_IDENT_DOTTED: 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; break;
} }