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

compiler improvement to support out-of-class class method or calss instance method definitions. pending more tests
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-05-26 23:18:26 +09:00
parent c219d073ca
commit b4d435a593
14 changed files with 201 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
README.md
View File

@ -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))

5
lib/cnode.c
View File

@ -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);

72
lib/comp.c
View File

@ -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,22 +2839,35 @@ 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))
{
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 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... */
/* 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? */
/* 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;
}
}
}
}
}
if (!HCL_CNODE_IS_SYMBOL(defun_name))
{
@ -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);
}

12
lib/exec.c
View File

@ -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 */

5
lib/hcl-prv.h
View File

@ -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);

2
lib/hcl.h
View File

@ -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; \

26
lib/obj.c
View File

@ -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)

36
lib/prim.c
View File

@ -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'} },

1
lib/print.c
View File

@ -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:

21
lib/read.c
View File

@ -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 },

17
mod/arr.c
View File

@ -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 } },
};

35
t/class-5001.err
View File

@ -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

4
t/insta-01.hcl
View File

@ -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);

5
t/var-5001.err
View File

@ -23,3 +23,8 @@ defclass A | a | {
return self;
};
};
---
defun String length() { ##ERROR: syntax error - no argument list
}