diff --git a/README.md b/README.md index 72dbb18..7e7f772 100644 --- a/README.md +++ b/README.md @@ -12,8 +12,8 @@ A HCL program is composed of expressions. ## Special Form Expression - and - break -- defclass -- defun +- class +- fun - do - elif - else @@ -81,7 +81,7 @@ do { | k | set k 20; printf "k=%d\n" k; }; ## Defining a function ``` -(defun function-name (arguments) +(fun function-name (arguments) | local variables | function body ) @@ -97,12 +97,12 @@ do { | k | set k 20; printf "k=%d\n" k; }; ## Class ``` -(defclass T +(class T :: | A B C | ## class variables (printf "initializing....\n") - (defun :: dump() + (fun :: dump() (printf "%d %d %d\n" A B C) ) @@ -120,7 +120,7 @@ do { | k | set k 20; printf "k=%d\n" k; }; ``` (set prim-plus +) -(defun + (a b ...) +(fun + (a b ...) (prim-plus a b 9999) ) @@ -130,7 +130,7 @@ do { | k | set k 20; printf "k=%d\n" k; }; ## Variadic arguments ``` -(defun fn-y (t1 t2 va-ctx) +(fun fn-y (t1 t2 va-ctx) | i | (set i 0) (while (< i (va-count va-ctx)) @@ -139,7 +139,7 @@ do { | k | set k 20; printf "k=%d\n" k; }; ) ) -(defun x(a b ... :: x y z) +(fun x(a b ... :: x y z) |i| ## (printf "VA_COUNT(x) = %d\n" (va-count)) diff --git a/lib/cnode.c b/lib/cnode.c index 89026c2..59c5d00 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -91,6 +91,11 @@ hcl_cnode_t* hcl_makecnodedblcolons (hcl_t* hcl, int flags, const hcl_loc_t* loc return make_cnode(hcl, HCL_CNODE_DBLCOLONS, flags, loc, tok); } +hcl_cnode_t* hcl_makecnodecolon (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok) +{ + return make_cnode(hcl, HCL_CNODE_COLON, flags, loc, tok); +} + hcl_cnode_t* hcl_makecnodecolongt (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok) { return make_cnode(hcl, HCL_CNODE_COLONGT, flags, loc, tok); diff --git a/lib/comp.c b/lib/comp.c index 4aac594..4766df5 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -344,8 +344,10 @@ static int find_variable_backward_with_word (hcl_t* hcl, const hcl_oocs_t* name, vi->type = VAR_INST; vi->ctx_offset = 0; vi->index_in_ctx = index; +/* HCL_INFO6 (hcl, "FOUND INST VAR [%.*js]...[%.*js]................ ===> ctx_offset %d index %d\n", haystack.len, haystack.ptr, name->len, name->ptr, (int)(vi->ctx_offset), (int)vi->index_in_ctx); +*/ return 1; } } @@ -1236,7 +1238,8 @@ static void pop_fnblk (hcl_t* hcl) HCL_ASSERT (hcl, fbi->tmprcnt - hcl->c->tv.wcount == fbi->tmpr_nargs + fbi->tmpr_nrvars + fbi->tmpr_nlvars); /* the temporaries mask is a bit-mask that encodes the counts of different temporary variables. - * and it's split to two intruction parameters when used with MAKE_LAMBDA and MAKE_FUNCTION */ + * and it's split to two intruction parameters when used with MAKE_LAMBDA and MAKE_FUNCTION. + * the INSTA bit is on if fbi->fun_type == FUN_CIM */ attr_mask = ENCODE_BLK_MASK((fbi->fun_type == FUN_CIM), fbi->tmpr_va, fbi->tmpr_nargs, fbi->tmpr_nrvars, fbi->tmpr_nlvars); patch_double_long_params_with_oow (hcl, fbi->make_inst_pos + 1, attr_mask); } @@ -2334,7 +2337,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl) /* ========================================================================= */ /* - (defclass A + (class A | x y | ; instance variables :: | x y z | ; class variables <--- how to initialize the class variables??? @@ -2353,7 +2356,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl) ) ) - (defclass B :: A ; A is a parent class + (class B :: A ; A is a parent class | p q | .... ) @@ -2403,6 +2406,8 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src, int defclass) return -1; } +/* TODO: check if a class name is one of the kernel classes. arrange to emit CLASS_LOAD instead of CLASS_ENTER */ + obj = HCL_CNODE_CONS_CDR(obj); } else @@ -2817,7 +2822,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) if (tmp && HCL_CNODE_IS_CONS(tmp)) { tmp = HCL_CNODE_CONS_CAR(tmp); - if (HCL_CNODE_IS_SYMBOL_PLAIN(tmp)) + if (HCL_CNODE_IS_COLON(tmp) /*(HCL_CNODE_IS_SYMBOL_PLAIN(tmp)*/) { hcl_setsynerrbfmt ( hcl, HCL_SYNERR_VARNAME, @@ -2834,20 +2839,33 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) } else if (HCL_CNODE_IS_SYMBOL_PLAIN(defun_name)) { - hcl_cnode_t* tmp; + hcl_cnode_t* tmp, marker; tmp = HCL_CNODE_CONS_CDR(obj); - if (tmp && HCL_CNODE_IS_CONS(tmp) && HCL_CNODE_IS_SYMBOL_PLAIN(HCL_CNODE_CONS_CAR(tmp))) + if (tmp && HCL_CNODE_IS_CONS(tmp)) { - /* out-of-class method definition - * for defun String:length() { ... }, class_name is String, defun_name is length. */ -/* TODO: this must be treated as an error - defun String length() { ... } - for this, the reader must be able to tell between String:length and String length... - or it must inject a special symbol between String and length or must use a different list type... */ + hcl_cnode_t* marker; + marker = HCL_CNODE_CONS_CAR(tmp); + if (HCL_CNODE_IS_COLON(marker) || HCL_CNODE_IS_DBLCOLONS(marker) || HCL_CNODE_IS_COLONSTAR(marker)) + { + tmp = HCL_CNODE_CONS_CDR(tmp); + if (tmp && HCL_CNODE_IS_CONS(tmp)) + { + hcl_cnode_t* cand; + cand = HCL_CNODE_CONS_CAR(tmp); + if (HCL_CNODE_IS_SYMBOL_PLAIN(cand)) + { + /* out-of-class method definition + * for defun String:length() { ... }, class_name is String, defun_name is length. */ /* TODO: this must not be allowed at the in-class definition level.... */ -/* TODO: can we use fun_type to indicate different types of out-of-class methods? */ - class_name = defun_name; - defun_name = HCL_CNODE_CONS_CAR(tmp); - obj = tmp; +/* TODO: can we use fun_type to indicate different types of out-of-class methods? use marker.... */ + fun_type = HCL_CNODE_IS_DBLCOLONS(marker)? FUN_CM: + HCL_CNODE_IS_COLONSTAR(marker)? FUN_CIM: FUN_IM; + class_name = defun_name; + defun_name = HCL_CNODE_CONS_CAR(tmp); + obj = tmp; + } + } + } } } @@ -3049,9 +3067,9 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) /* MAKE_FUNCTION attr_mask_1 attr_mask_2 lfbase lfsize */ if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_FUNCTION, 0, 0, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1; lfbase_pos = hcl->code.bc.len; - if (emit_long_param(hcl, hcl->code.lit.len - hcl->c->fnblk.info[hcl->c->fnblk.depth - 1].lfbase) <= -1) return -1; /* literal frame base */ + if (emit_long_param(hcl, hcl->code.lit.len - hcl->c->fnblk.info[hcl->c->fnblk.depth - 1].lfbase) <= -1) return -1; /* lfbase(literal frame base) */ lfsize_pos = hcl->code.bc.len; /* literal frame size */ - if (emit_long_param(hcl, 0) <= -1) return -1; + if (emit_long_param(hcl, 0) <= -1) return -1; /* place holder for lfsize */ } else { @@ -4712,6 +4730,7 @@ redo: return -1; case HCL_CNODE_DBLCOLONS: + case HCL_CNODE_COLON: case HCL_CNODE_COLONLT: case HCL_CNODE_COLONGT: case HCL_CNODE_COLONSTAR: @@ -5527,7 +5546,7 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl) } else { - /* class methods */ + /* in-class methods */ if (block_code_size == 1) { /* simple optimization not to skip emitting POP_STACKTOP */ @@ -5635,7 +5654,7 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) /* in the class initialization scope, the type must not be other than the listed above */ HCL_DEBUG1 (hcl, "Internal error - invalid method type %d\n", cf->u.lambda.fun_type); hcl_seterrbfmt (hcl, HCL_EINTERN, "internal error - invalid method type %d", cf->u.lambda.fun_type); - break; + return -1; } cf = GET_TOP_CFRAME(hcl); } @@ -5671,6 +5690,7 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) /* TODO: - other types of out-of-class definition - CIM_STORE, CM_STORE... use different marker? */ hcl_oow_t index; hcl_oop_t lit, cons; + int inst; /* treat the class name part as a normal variable. * it can be a global variable like 'String' or a local variable declared */ @@ -5682,9 +5702,29 @@ static HCL_INLINE int post_lambda (hcl_t* hcl) lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(defun_name), HCL_CNODE_GET_TOKLEN(defun_name)); if (HCL_UNLIKELY(!lit)) return -1; if (add_literal(hcl, lit, &index) <= -1) return -1; - if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_IMSTORE, index, HCL_CNODE_GET_LOC(defun_name)) <= -1) return -1; -/* TDOO: CLASS_CMSTORE..., CLASS_CIMSTORE.. */ + switch (cf->u.lambda.fun_type) + { + case FUN_CM: /* class method */ + inst = HCL_CODE_CLASS_CMSTORE; + break; + + case FUN_CIM: /* class instantiation method */ + inst = HCL_CODE_CLASS_CIMSTORE; + break; + + case FUN_IM: /* instance method */ + inst = HCL_CODE_CLASS_IMSTORE; + break; + + default: + /* in the class initialization scope, the type must not be other than the listed above */ + HCL_DEBUG1 (hcl, "Internal error - invalid function type %d\n", cf->u.lambda.fun_type); + hcl_seterrbfmt (hcl, HCL_EINTERN, "internal error - invalid function type %d", cf->u.lambda.fun_type); + return -1; + } + + if (emit_single_param_instruction(hcl, inst, index, HCL_CNODE_GET_LOC(defun_name)) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_CLASS_EXIT, HCL_CNODE_GET_LOC(class_name)) <= -1) return -1; POP_CFRAME (hcl); } diff --git a/lib/exec.c b/lib/exec.c index 5c2b23c..bb9d2f5 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -3833,7 +3833,7 @@ static int execute (hcl_t* hcl) push cvars class_enter nsuperclasses nivars ncvars */ - hcl_oop_t t, sc, ivars_str, cvars_str; + hcl_oop_t t, superclass, ivars_str, cvars_str; hcl_oow_t b3; FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */ @@ -3858,17 +3858,17 @@ static int execute (hcl_t* hcl) if (b1 > 0) { - HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 superclass later when the compiler supports more */ - if (!HCL_IS_CLASS(hcl, sc)) + HCL_STACK_POP_TO (hcl, superclass); /* TODO: support more than 1 superclass later when the compiler supports more */ + if (!HCL_IS_CLASS(hcl, superclass)) { - hcl_seterrbfmt (hcl, HCL_ECALL, "invalid superclass %O", sc); + hcl_seterrbfmt (hcl, HCL_ECALL, "invalid superclass %O", superclass); if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; goto oops_with_errmsg_supplement; } } - else sc = hcl->_nil; + else superclass = hcl->_nil; - t = hcl_makeclass(hcl, sc, b2, b3, ivars_str, cvars_str); /* TOOD: pass variable information... */ + t = hcl_makeclass(hcl, superclass, b2, b3, ivars_str, cvars_str); /* TOOD: pass variable information... */ if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; /* push the class created to the class stack. but don't push to the normal operation stack */ diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index d537cbf..1f1457d 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -382,6 +382,7 @@ enum hcl_cnode_type_t HCL_CNODE_ELLIPSIS, HCL_CNODE_TRPCOLONS, HCL_CNODE_DBLCOLONS, /* :: */ + HCL_CNODE_COLON, /* : */ HCL_CNODE_COLONGT, /* :> */ HCL_CNODE_COLONLT, /* :< */ HCL_CNODE_COLONSTAR, /* :* */ @@ -408,6 +409,7 @@ typedef enum hcl_cnode_flag_t hcl_cnode_flag_t; #define HCL_CNODE_IS_ELLIPSIS(x) ((x)->cn_type == HCL_CNODE_ELLIPSIS) #define HCL_CNODE_IS_TRPCOLONS(x) ((x)->cn_type == HCL_CNODE_TRPCOLONS) #define HCL_CNODE_IS_DBLCOLONS(x) ((x)->cn_type == HCL_CNODE_DBLCOLONS) +#define HCL_CNODE_IS_COLON(x) ((x)->cn_type == HCL_CNODE_COLON) #define HCL_CNODE_IS_COLONGT(x) ((x)->cn_type == HCL_CNODE_COLONGT) #define HCL_CNODE_IS_COLONLT(x) ((x)->cn_type == HCL_CNODE_COLONLT) #define HCL_CNODE_IS_COLONSTAR(x) ((x)->cn_type == HCL_CNODE_COLONSTAR) @@ -978,7 +980,7 @@ struct hcl_compiler_t * 1 1 4 4 6 <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params) * 1 1 8 8 11 <= 32 (HCL_CODE_LONG_PARAM_SIZE 2, two params, use 29 bits to avoid collection when converted to a smooi) * - * + * INSTA indicates the class instantiation method. * NARGS and NRVARS are also used for the CALL and CALL2 instructions. * CALL encodes NARGS in one parameter. * CALLR encodes NARGS in one parameter and NRVARS in another parameter. @@ -1944,6 +1946,7 @@ hcl_cnode_t* hcl_makecnodesuper (hcl_t* hcl, int flags, const hcl_loc_t* loc, co hcl_cnode_t* hcl_makecnodeellipsis (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodetrpcolons (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodedblcolons (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); +hcl_cnode_t* hcl_makecnodecolon (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodecolongt (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodecolonlt (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); hcl_cnode_t* hcl_makecnodecolonstar (hcl_t* hcl, int flags, const hcl_loc_t* loc, const hcl_oocs_t* tok); diff --git a/lib/hcl.h b/lib/hcl.h index 7530706..863c6d0 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1905,7 +1905,7 @@ struct hcl_t /* TODO: stack bound check when pushing */ #define HCL_STACK_PUSH(hcl,v) \ do { \ - if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->st)) \ + if (HCL_UNLIKELY((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->st))) \ { \ hcl_seterrbfmt (hcl, HCL_EOOMEM, "process stack overflow"); \ (hcl)->abort_req = -1; \ diff --git a/lib/obj.c b/lib/obj.c index ab54062..5468b54 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -317,6 +317,7 @@ hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) { +/* TODO: use hcl_instantiate() */ hcl_oop_cons_t cons; hcl_pushvolat (hcl, &car); @@ -337,6 +338,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc) { +/* TODO: use hcl_instantiate() */ hcl_oop_t v; v = hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size); if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_array); @@ -345,6 +347,7 @@ hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc) hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size) { +/* TODO: use hcl_instantiate() */ hcl_oop_t v; v = hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size); if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_byte_array); @@ -353,7 +356,28 @@ hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size) hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len, int ngc) { - return alloc_numeric_array(hcl, HCL_BRAND_BYTE_ARRAY, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 1, ngc); + hcl_oop_byte_t b; + hcl_oow_t i; + hcl_oob_t v; + + b = (hcl_oop_byte_t)alloc_numeric_array(hcl, HCL_BRAND_BYTE_ARRAY, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 1, ngc); + if (HCL_UNLIKELY(!b)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make bytestring - %js", orgmsg); + } + else + { + for (i = 0; i < len; i++) + { + v = ptr[i]; + HCL_OBJ_SET_BYTE_VAL(b, i, v); + } + + HCL_OBJ_SET_CLASS (b, (hcl_oop_t)hcl->c_byte_array); + } + + return (hcl_oop_t)b; } hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int ngc) diff --git a/lib/prim.c b/lib/prim.c index b8eab1f..4c5a770 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -1137,6 +1137,8 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) hcl_oop_context_t ctx; hcl_ooi_t attr_mask, /*va,*/ fixed_nargs, nrvars, nlvars, nvaargs; hcl_oow_t index; + hcl_oop_t idx; + int n; if (nargs >= 2) { @@ -1158,8 +1160,11 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) nrvars = GET_BLK_MASK_NRVARS(attr_mask); nlvars = GET_BLK_MASK_NLVARS(attr_mask); - if (hcl_inttooow(hcl, HCL_STACK_GETARG(hcl, nargs, 0), &index) == 0) + idx = HCL_STACK_GETARG(hcl, nargs, 0); + n = hcl_inttooow(hcl, idx, &index); + if (n <= 0) { + if (n <= -1) hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid index - %O", idx); return HCL_PF_FAILURE; } @@ -1182,18 +1187,33 @@ static hcl_pfrc_t pf_va_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfrc_t pf_object_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { -/* TODO: accept the object size if the class is variable-sized. */ hcl_oop_t obj; - hcl_oop_t class_; + hcl_oop_t _class; + hcl_oow_t size = 0; - class_ = HCL_STACK_GETARG(hcl, nargs, 0); - if (!HCL_IS_CLASS(hcl, class_)) + _class = HCL_STACK_GETARG(hcl, nargs, 0); + if (!HCL_IS_CLASS(hcl, _class)) { - hcl_seterrbfmt (hcl, HCL_EINVAL, "not a class - %O", class_); + hcl_seterrbfmt (hcl, HCL_EINVAL, "not a class - %O", _class); return HCL_PF_FAILURE; } - obj = hcl_instantiate(hcl, (hcl_oop_class_t)class_, HCL_NULL, 0); + if (nargs >= 1) + { + int n; + hcl_oop_t sz; + + sz = HCL_STACK_GETARG(hcl, nargs, 1); + n = hcl_inttooow(hcl, sz, &size); + if (n == 0) return HCL_PF_FAILURE; + if (n <= -1) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid size - %O", sz); + return HCL_PF_FAILURE; + } + } + + obj = hcl_instantiate(hcl, (hcl_oop_class_t)_class, HCL_NULL, size); if (HCL_UNLIKELY(!obj)) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, obj); @@ -1278,7 +1298,7 @@ static pf_t builtin_prims[] = { 0, 1, pf_va_count, 8, { 'v','a','-','c','o','u','n','t' } }, { 1, 2, pf_va_get, 6, { 'v','a','-','g','e','t' } }, - { 1, 1, pf_object_new, 10, { 'o','b','j','e','c','t','-','n','e','w' } }, + { 1, 2, pf_object_new, 10, { 'o','b','j','e','c','t','-','n','e','w' } }, { 0, 0, hcl_pf_process_current, 15, { 'c','u','r','r','e','n','t','-','p','r','o','c','e','s','s'} }, { 1, HCL_TYPE_MAX(hcl_oow_t), hcl_pf_process_fork, 4, { 'f','o','r','k'} }, diff --git a/lib/print.c b/lib/print.c index b629729..3f35c4f 100644 --- a/lib/print.c +++ b/lib/print.c @@ -804,6 +804,7 @@ void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline) case HCL_CNODE_ELLIPSIS: case HCL_CNODE_TRPCOLONS: case HCL_CNODE_DBLCOLONS: + case HCL_CNODE_COLON: case HCL_CNODE_COLONGT: case HCL_CNODE_COLONLT: case HCL_CNODE_COLONSTAR: diff --git a/lib/read.c b/lib/read.c index 5ae43a2..83b517d 100644 --- a/lib/read.c +++ b/lib/read.c @@ -837,16 +837,16 @@ static HCL_INLINE int can_colon_list (hcl_t* hcl) if (rstl->count == 1) rstl->flagv |= JSON; /* mark that the first key is colon-delimited */ else if (!(rstl->flagv & JSON)) { - /* handling of a coloe sign in out-of-class instance method definition. + /* handling of a colon sign in out-of-class instance method definition. * e.g. defun String:length() { return (str.length self). } - * TODO: inject a symbol ':' to differenticate form '::' or ':*' methods. + * TODO: inject a symbol ':' to differentiate form '::' or ':*' methods. * these class methods and class instantiation methods are supposed to be * implemented elsewhere because ':' has dual use while '::' or ':*' are * independent tokens */ if (HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(rstl->head), HCL_SYNCODE_DEFUN) || HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(rstl->head), HCL_SYNCODE_LAMBDA)) { - if (rstl->count == 2) return 1; + if (rstl->count == 2) return 2; } return 0; /* the first key is not colon-delimited. so not allowed to colon-delimit other keys */ @@ -1458,12 +1458,23 @@ static int feed_process_token (hcl_t* hcl) goto ok; case HCL_TOK_COLON: - if (frd->level <= 0 || !can_colon_list(hcl)) + { + int n; + if (frd->level <= 0 || !(n = can_colon_list(hcl))) { hcl_setsynerr (hcl, HCL_SYNERR_COLONBANNED, TOKEN_LOC(hcl), HCL_NULL); goto oops; } + if (n == 2) + { + /* this is colon between the class name and the function name for + * out-of-class method defintion */ + frd->obj = hcl_makecnodecolon(hcl, 0, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); + goto auto_xlist; + } + goto ok; + } case HCL_TOK_COLONEQ: if (frd->level <= 0 || !can_coloneq_list(hcl)) @@ -1896,7 +1907,7 @@ static delim_token_t delim_token_tab[] = { "..", 2, HCL_TOK_DBLDOTS }, { "...", 3, HCL_TOK_ELLIPSIS }, /* for variable arguments */ - { ":", 1, HCL_TOK_COLON }, /* key-value separator in dictionary */ + { ":", 1, HCL_TOK_COLON }, /* key-value separator in dictionary or for method call or definition */ { ":=", 2, HCL_TOK_COLONEQ }, /* assignment */ { ":>", 2, HCL_TOK_COLONGT }, { ":<", 2, HCL_TOK_COLONLT }, diff --git a/mod/arr.c b/mod/arr.c index 16a4088..def7f13 100644 --- a/mod/arr.c +++ b/mod/arr.c @@ -27,6 +27,21 @@ #include "_arr.h" +static hcl_pfrc_t pf_arr_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_t sz, arr; + hcl_oow_t size; + + sz = (hcl_oop_t)HCL_STACK_GETARG(hcl, nargs, 0); + if (hcl_inttooow(hcl, sz, &size) == 0) return HCL_PF_FAILURE; + + arr = hcl_makearray(hcl, size, 0); + if (HCL_UNLIKELY(!arr)) return HCL_PF_FAILURE; + + HCL_STACK_SETRET (hcl, nargs, arr); + return HCL_PF_SUCCESS; +} + static hcl_pfrc_t pf_arr_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { hcl_oop_oop_t arr; @@ -106,7 +121,7 @@ static hcl_pfrc_t pf_arr_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfinfo_t pfinfos[] = { { { 'g','e','t','\0' }, { HCL_PFBASE_FUNC, pf_arr_get, 2, 2 } }, -/* { { 'm','a','k','e','\0' }, { HCL_PFBASE_FUNC, pf_arr_make, 1, 1 } },*/ + { { 'n','e','w','\0' }, { HCL_PFBASE_FUNC, pf_arr_new, 1, 1 } }, { { 'p','u','t','\0' }, { HCL_PFBASE_FUNC, pf_arr_put, 3, 3 } }, { { 's','i','z','e','\0' }, { HCL_PFBASE_FUNC, pf_arr_size, 1, 1 } }, }; diff --git a/t/class-5001.err b/t/class-5001.err index acb3877..2406964 100644 --- a/t/class-5001.err +++ b/t/class-5001.err @@ -1,9 +1,9 @@ -defclass B | x y | { +class B | x y | { }; -defclass X :: B | a b | { - defun :* new(t) { +class X :: B | a b | { + fun :* new(t) { | a | set self.a t; set a 100; @@ -15,7 +15,7 @@ defclass X :: B | a b | { return self; }; - defun print() { + fun print() { self.c (+ self.a self.b); printf "a=%d b=%d\n" self.a self.b; } @@ -24,30 +24,41 @@ defclass X :: B | a b | { --- -defclass X { - defun :* xxx() { +class X { + fun :* xxx() { return X; } - defun :* qqq() { + fun :* qqq() { return "hello" } - defun String:length() { ##ERROR: syntax error - function name not valid + fun String:length() { ##ERROR: syntax error - function name not valid return (str.length self) } } --- -defclass X { - defun :* xxx() { +class X { + fun :* xxx() { return X; } - defun :* qqq() { + fun :* qqq() { return "hello" } } ## this will trigger a runtime error as J isn't a class name -defun J:ccc() { ##ERROR: exception not handled +fun J:ccc() { ##ERROR: exception not handled return 999 } + +--- +## this must not be very useful as Array is an index item +## and the clase instantiation method can't specify the size +## you can't place an item in the arrya at all. + +fun Array:*boom() { + arr.put self 0 10 ##ERROR: exception not handled + printf "%O" self +} +Array:boom diff --git a/t/insta-01.hcl b/t/insta-01.hcl index 7e7e3ac..c2c2827 100644 --- a/t/insta-01.hcl +++ b/t/insta-01.hcl @@ -1,6 +1,6 @@ ## test class instantiation methods -defclass A | a b c | { +class A | a b c | { defun :*newInstance(x y z) { set a x; @@ -14,7 +14,7 @@ defclass A | a b c | { defun get-c() { return self.c; }; }; -defclass B :: A | d e f | { +class B :: A | d e f | { defun :*newInstance(x y z) { super:newInstance (* x 2) (* y 2) (* z 2); diff --git a/t/var-5001.err b/t/var-5001.err index c69935c..c4e9948 100644 --- a/t/var-5001.err +++ b/t/var-5001.err @@ -23,3 +23,8 @@ defclass A | a | { return self; }; }; + +--- + +defun String length() { ##ERROR: syntax error - no argument list +}