diff --git a/lib/exec.c b/lib/exec.c index 7deae29..70ddaf9 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -972,7 +972,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs) return -1; } - return ((hcl_pfimpl_t)rcv->slot[0]) (hcl, nargs); + return ((hcl_pfimpl_t)rcv->slot[0]) (hcl, (hcl_mod_t*)rcv->slot[4], nargs); } /* ------------------------------------------------------------------------- */ diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 0bc71c9..88429b8 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -1028,7 +1028,8 @@ void hcl_closemod ( hcl_pfbase_t* hcl_querymod ( hcl_t* hcl, const hcl_ooch_t* pfid, - hcl_oow_t pfidlen + hcl_oow_t pfidlen, + hcl_mod_t** mod ); /* ========================================================================= */ diff --git a/lib/hcl.c b/lib/hcl.c index d338b5a..3bf4385 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -619,7 +619,7 @@ void hcl_closemod (hcl_t* hcl, hcl_mod_data_t* mdp) } } -hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidlen) +hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidlen, hcl_mod_t** mod) { /* primitive function identifier * _funcname @@ -650,7 +650,7 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle * module id. the last segment is the primitive function name. * for instance, in con.window.open, con.window is a module id and * open is the primitive function name. */ - pair = hcl_rbt_search (&hcl->modtab, pfid, mod_name_len); + pair = hcl_rbt_search(&hcl->modtab, pfid, mod_name_len); if (pair) { mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair); @@ -659,11 +659,11 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle else { /* open a module using the part before the last period */ - mdp = hcl_openmod (hcl, pfid, mod_name_len); + mdp = hcl_openmod(hcl, pfid, mod_name_len); if (!mdp) return HCL_NULL; } - if ((pfbase = mdp->mod.query (hcl, &mdp->mod, sep + 1, pfidlen - mod_name_len - 1)) == HCL_NULL) + if ((pfbase = mdp->mod.query(hcl, &mdp->mod, sep + 1, pfidlen - mod_name_len - 1)) == HCL_NULL) { /* the primitive function is not found. but keep the module open even if it's opened above */ HCL_DEBUG3 (hcl, "Cannot find a primitive function [%.*js] in a module [%js]\n", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name); @@ -671,6 +671,8 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle return HCL_NULL; } + *mod = &mdp->mod; + HCL_DEBUG4 (hcl, "Found a primitive function [%.*js] in a module [%js] - %p\n", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name, pfbase); return pfbase; diff --git a/lib/hcl.h b/lib/hcl.h index e0a5a63..c93900b 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -35,6 +35,10 @@ /* ========================================================================== */ +typedef struct hcl_mod_t hcl_mod_t; + +/* ========================================================================== */ + /** * The hcl_errnum_t type defines the error codes. */ @@ -835,7 +839,10 @@ enum hcl_pfrc_t }; typedef enum hcl_pfrc_t hcl_pfrc_t; -typedef hcl_pfrc_t (*hcl_pfimpl_t) (hcl_t* hcl, hcl_ooi_t nargs); +typedef hcl_pfrc_t (*hcl_pfimpl_t) ( + hcl_t* hcl, + hcl_mod_t* mod, + hcl_ooi_t nargs); typedef struct hcl_pfbase_t hcl_pfbase_t; @@ -858,8 +865,6 @@ struct hcl_pfinfo_t * ========================================================================= */ #define HCL_MOD_NAME_LEN_MAX 120 -typedef struct hcl_mod_t hcl_mod_t; - typedef int (*hcl_mod_load_t) ( hcl_t* hcl, hcl_mod_t* mod @@ -1692,7 +1697,8 @@ HCL_EXPORT hcl_oop_t hcl_makeprim ( hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, - hcl_oow_t maxargs + hcl_oow_t maxargs, + hcl_mod_t* mod ); diff --git a/lib/main.c b/lib/main.c index b1cf6cc..4769c1d 100644 --- a/lib/main.c +++ b/lib/main.c @@ -1623,7 +1623,6 @@ int main (int argc, char* argv[]) else { hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot read object - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); - } goto oops; } diff --git a/lib/prim.c b/lib/prim.c index 031482d..80949bb 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -39,16 +39,17 @@ typedef struct pf_t pf_t; /* ------------------------------------------------------------------------- */ -hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs) +hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs, hcl_mod_t* mod) { hcl_oop_word_t obj; - obj = (hcl_oop_word_t)hcl_allocwordobj (hcl, HCL_BRAND_PRIM, HCL_NULL, 3); + obj = (hcl_oop_word_t)hcl_allocwordobj (hcl, HCL_BRAND_PRIM, HCL_NULL, 4); if (obj) { obj->slot[0] = (hcl_oow_t)primimpl; obj->slot[1] = minargs; obj->slot[2] = maxargs; + obj->slot[4] = (hcl_oow_t)mod; } return (hcl_oop_t)obj; @@ -94,7 +95,7 @@ start_over: } } -static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { /* TODO: accept log level */ hcl_oop_t msg; @@ -166,7 +167,7 @@ static hcl_pfrc_t pf_log (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_gc (hcl); HCL_STACK_SETRET (hcl, nargs, hcl->_nil); @@ -174,7 +175,7 @@ static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_ooi_t nargs) } /* ------------------------------------------------------------------------- */ -static hcl_pfrc_t pf_eqv (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_eqv (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t a0, a1, rv; @@ -187,7 +188,7 @@ static hcl_pfrc_t pf_eqv (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_eql (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_eql (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { int n; n = hcl_equalobjs(hcl, HCL_STACK_GETARG(hcl, nargs, 0), HCL_STACK_GETARG(hcl, nargs, 1)); @@ -197,7 +198,7 @@ static hcl_pfrc_t pf_eql (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_eqk (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_eqk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { /* equal kind? */ hcl_oop_t a0, a1, rv; @@ -211,7 +212,7 @@ static hcl_pfrc_t pf_eqk (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_not (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_not (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t arg, rv; @@ -228,7 +229,7 @@ static hcl_pfrc_t pf_not (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_and (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_and (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t arg, rv; hcl_ooi_t i; @@ -257,7 +258,7 @@ static hcl_pfrc_t pf_and (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_or (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_or (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t arg, rv; hcl_ooi_t i; @@ -288,7 +289,7 @@ static hcl_pfrc_t pf_or (hcl_t* hcl, hcl_ooi_t nargs) /* ------------------------------------------------------------------------- */ -static hcl_pfrc_t pf_integer_add (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_integer_add (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_ooi_t i; hcl_oop_t arg, ret; @@ -305,7 +306,7 @@ static hcl_pfrc_t pf_integer_add (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_integer_sub (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_integer_sub (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_ooi_t i; hcl_oop_t arg, ret; @@ -322,7 +323,7 @@ static hcl_pfrc_t pf_integer_sub (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_integer_mul (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_integer_mul (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_ooi_t i; hcl_oop_t arg, ret; @@ -339,7 +340,7 @@ static hcl_pfrc_t pf_integer_mul (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_integer_quo (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_integer_quo (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_ooi_t i; hcl_oop_t arg, ret; @@ -356,7 +357,7 @@ static hcl_pfrc_t pf_integer_quo (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_integer_rem (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_integer_rem (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_ooi_t i; hcl_oop_t arg, ret, rem; @@ -377,7 +378,7 @@ static hcl_pfrc_t pf_integer_rem (hcl_t* hcl, hcl_ooi_t nargs) /* ------------------------------------------------------------------------- */ -static hcl_pfrc_t pf_printf (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_printf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_char_t fmt; @@ -444,7 +445,7 @@ int hcl_addbuiltinprims (hcl_t* hcl) for (i = 0; i < HCL_COUNTOF(builtin_prims); i++) { - prim = hcl_makeprim(hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs); + prim = hcl_makeprim(hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs, HCL_NULL); if (!prim) return -1; hcl_pushtmp (hcl, &prim); diff --git a/lib/read.c b/lib/read.c index a4814db..73826dd 100644 --- a/lib/read.c +++ b/lib/read.c @@ -2077,9 +2077,10 @@ static int read_object (hcl_t* hcl) if (obj) { hcl_pfbase_t* pfbase; + hcl_mod_t* mod; hcl_oop_t prim; - pfbase = hcl_querymod(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); + pfbase = hcl_querymod(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl), &mod); if (!pfbase) { /* TODO switch to syntax error */ @@ -2087,7 +2088,7 @@ static int read_object (hcl_t* hcl) } hcl_pushtmp (hcl, &obj); - prim = hcl_makeprim(hcl, pfbase->handler, pfbase->minargs, pfbase->maxargs); + prim = hcl_makeprim(hcl, pfbase->handler, pfbase->minargs, pfbase->maxargs, mod); if (!prim || !hcl_putatsysdic(hcl, obj, prim)) { diff --git a/mod/arr.c b/mod/arr.c index 41195f0..11786a5 100644 --- a/mod/arr.c +++ b/mod/arr.c @@ -27,7 +27,7 @@ #include "_arr.h" -static hcl_pfrc_t pf_arr_get (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_arr_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_oop_t arr; hcl_oop_t idx; @@ -54,7 +54,7 @@ static hcl_pfrc_t pf_arr_get (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_arr_put (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_arr_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_oop_t arr; hcl_oop_t idx, val; @@ -83,7 +83,7 @@ static hcl_pfrc_t pf_arr_put (hcl_t* hcl, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -static hcl_pfrc_t pf_arr_size (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_arr_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_oop_t arr; hcl_oop_t size; diff --git a/mod/dic.c b/mod/dic.c index b90bed6..ed84a75 100644 --- a/mod/dic.c +++ b/mod/dic.c @@ -27,7 +27,7 @@ #include "_dic.h" -static hcl_pfrc_t pf_dic_get (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_dic_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t dic; hcl_oop_t key; @@ -54,7 +54,7 @@ static hcl_pfrc_t pf_dic_get (hcl_t* hcl, hcl_ooi_t nargs) } -static hcl_pfrc_t pf_dic_put (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_dic_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t dic; hcl_oop_t key, val; @@ -88,7 +88,7 @@ static int walker (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cons_t pair, void* ctx return 0; } -static hcl_pfrc_t pf_dic_walk (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_dic_walk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { /* TODO: write a proper function * (dic.apply #{ ... } callable-or-lambda) diff --git a/mod/str.c b/mod/str.c index b6b769f..4ceca9b 100644 --- a/mod/str.c +++ b/mod/str.c @@ -27,7 +27,7 @@ #include "_str.h" -static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_ooi_t nargs) +static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_t str; hcl_ooi_t size;