diff --git a/lib/comp.c b/lib/comp.c index dc0afd9..ebcfd3e 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -2715,6 +2715,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) hcl_ooi_t jump_inst_pos, lfbase_pos, lfsize_pos; hcl_oow_t saved_tv_wcount, tv_dup_start; hcl_cnode_t* defun_name; + hcl_cnode_t* class_name; hcl_cframe_t* cf; int fun_type = FUN_PLAIN; @@ -2786,11 +2787,13 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) if (!obj) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "no argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + no_arg_list: + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(src), HCL_NULL, "argument list missing in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } else if (!HCL_CNODE_IS_CONS(obj)) { + redundant_cdr: hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } @@ -2801,13 +2804,40 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) nrvars = 0; args = HCL_CNODE_CONS_CAR(obj); HCL_ASSERT (hcl, args != HCL_NULL); + + class_name = HCL_NULL; + if (defun_name && HCL_CNODE_IS_SYMBOL_PLAIN(args)) + { + /* 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.... */ + + class_name = defun_name; + defun_name = args; + obj = HCL_CNODE_CONS_CDR(obj); + if (!obj) goto no_arg_list; + else if (!HCL_CNODE_IS_CONS(obj)) goto redundant_cdr; + args = HCL_CNODE_CONS_CAR(obj); + + if (is_in_class_init_scope(hcl)) + { + /* you must not speicfy the class name when defining a method in the class initialization scope. + * however, it's allowed to do so in another method (class method scope) for the class or in a + * normal function outside class defintion. */ + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name), "class name prohibited in this scope"); + return -1; + } + } + if (HCL_CNODE_IS_ELIST_CONCODED(args, HCL_CONCODE_XLIST)) { /* empty list - no argument - (lambda () (+ 10 20)) */ } else if (!HCL_CNODE_IS_CONS_CONCODED(args, HCL_CONCODE_XLIST)) { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not an argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "no argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); return -1; } else @@ -4867,7 +4897,7 @@ static int compile_bytearray_list (hcl_t* hcl) oldidx = cf->u.bytearray_list.index; elem_type = cf->u.bytearray_list.index; -/* TODO: compile type check if the data element is literal... +/* TODO: compile type check if the data element is literal... runtime check if the data is a variable or something... */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); diff --git a/lib/read.c b/lib/read.c index c784dbc..7560f42 100644 --- a/lib/read.c +++ b/lib/read.c @@ -831,8 +831,12 @@ 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)) { - /* TODO: handling for out-of-class method definition. - * e.g. defun String:length() { ... } */ + /* handling of a coloe sign in out-of-class method definition. + * e.g. defun String:length() { return (str.length self). } */ + if (HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(rstl->head), HCL_SYNCODE_DEFUN)) + { + if (rstl->count == 2) return 1; + } return 0; /* the first key is not colon-delimited. so not allowed to colon-delimit other keys */ } diff --git a/t/class-5001.err b/t/class-5001.err index 2d2a817..99f4f9f 100644 --- a/t/class-5001.err +++ b/t/class-5001.err @@ -21,3 +21,19 @@ defclass X :: B | a b | { } }; + +--- + +defclass X { + defun :* xxx() { + return X; + } + defun :* qqq() { + return "hello" + } + + defun String:length() { ##ERROR: syntax error - class name prohibited + return (str.length self) + } +} + diff --git a/t/va-01.hcl b/t/va-01.hcl index 01d12ac..169747a 100644 --- a/t/va-01.hcl +++ b/t/va-01.hcl @@ -1,54 +1,56 @@ defun fn-y (t1 t2 va-ctx) { - | i | - i := 0; - while (< i (va-count va-ctx)) { - printf "fn-y=>Y-VA[%d]=>[%d]\n" i (va-get i va-ctx); - i := (+ i 1); - }; -}; + | i | + i := 0 + while (< i (va-count va-ctx)) { + printf "fn-y=>Y-VA[%d]=>[%d]\n" i (va-get i va-ctx) + i := (+ i 1) + } +} defun x(a b ... :: x y z) { - |i| + |i| - set x (va-count); - set y (* a b); - set z (+ a b); + x := (va-count) + y := (a * b) + z := (a + b) - set i 0; - while (< i (va-count)) { - printf "VA[%d]=>[%d]\n" i (va-get i); - set i (+ i 1); - }; - fn-y "hello" "world" (va-context); + i := 0; + while (i < (va-count)) { + printf "VA[%d]=>[%d]\n" i (va-get i) + i := (i + 1) + } + fn-y "hello" "world" (va-context) - return; -}; + return; +} -set t (x 10 20 30); +t := (x 10 20 30); if (/= t 1) { printf "ERROR: t is not 1\n" } else { printf "OK: %d\n" t -}; +} -set t (set-r a b c (x 10 20 30 40 50)); +t := ([a b c] := (x 10 20 30 40 50)); if (/= t 3) { printf "ERROR: t is not 3\n" } else { printf "OK: %d\n" t -}; +} + if (/= a 3) { printf "ERROR: a is not 3\n" } else { printf "OK: %d\n" a -}; +} + if (/= b 200) { printf "ERROR: b is not 200\n" } else { printf "OK: %d\n" b -}; +} if (/= c 30) { printf "ERROR: c is not 30\n" } else { printf "OK: %d\n" c -}; +}