From 0128fe88dcd4e6e0fd1b36f94deda44076174c01 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 26 Sep 2025 00:32:33 +0900 Subject: [PATCH] change the way to read a token beginning with a colon. added more primitive functions to the core module --- README.md | 7 ++-- lib/cnode.c | 10 ----- lib/comp.c | 18 ++++++--- lib/fmt.c | 11 ++++++ lib/hak-prv.h | 27 +++++++++----- lib/prim.c | 85 +++++++++++++++++++++++++++++-------------- lib/print.c | 2 - lib/read.c | 95 +++++++++++++++++++++++++++++++++++++++--------- mod/core.c | 20 ++++++++++ t/Makefile.am | 1 + t/Makefile.in | 1 + t/class-5001.err | 9 +++++ t/prim-01.hak | 39 ++++++++++++++++++++ 13 files changed, 250 insertions(+), 75 deletions(-) create mode 100644 t/prim-01.hak diff --git a/README.md b/README.md index c65fdfc..e48a507 100644 --- a/README.md +++ b/README.md @@ -83,6 +83,8 @@ do { | k | set k 20; printf "k=%d\n" k; }; * bit-xor * bit-not * bit-shift +* bit-left-shift +* bit-right-shift ## Defining a function @@ -149,9 +151,8 @@ x:print ## Redefining a primitive function ``` -set prim-plus + -fun + (a b ...) - prim-plus a b 9999 +fun + (a b) { + core.+ a b 9999 ) printf "%d\n" (+ 10 20) ``` diff --git a/lib/cnode.c b/lib/cnode.c index c366cdc..4fc6e0f 100644 --- a/lib/cnode.c +++ b/lib/cnode.c @@ -96,16 +96,6 @@ hak_cnode_t* hak_makecnodecolon (hak_t* hak, int flags, const hak_loc_t* loc, co return hak_makecnode(hak, HAK_CNODE_COLON, flags, loc, tok); } -hak_cnode_t* hak_makecnodecolongt (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok) -{ - return hak_makecnode(hak, HAK_CNODE_COLONGT, flags, loc, tok); -} - -hak_cnode_t* hak_makecnodecolonlt (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok) -{ - return hak_makecnode(hak, HAK_CNODE_COLONLT, flags, loc, tok); -} - hak_cnode_t* hak_makecnodecharlit (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok, hak_ooch_t v) { hak_cnode_t* c = hak_makecnode(hak, HAK_CNODE_CHARLIT, flags, loc, tok); diff --git a/lib/comp.c b/lib/comp.c index fd5139a..a2196f7 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -3237,6 +3237,16 @@ static int check_fun_attr_list (hak_t* hak, hak_cnode_t* attr_list, unsigned int return 0; } +static int is_cnode_eligible_for_fun_name (const hak_cnode_t* tmp) +{ + return HAK_CNODE_IS_SYMBOL(tmp) || HAK_CNODE_IS_BINOP(tmp); +} + +static int is_cnode_eligible_for_fun_name_after_colon (const hak_cnode_t* tmp) +{ + return HAK_CNODE_IS_SYMBOL(tmp) || HAK_CNODE_IS_BINOP(tmp) || (HAK_CNODE_IS_STRLIT(tmp) && hak_is_binop_string(HAK_CNODE_GET_TOK(tmp))); +} + static int compile_fun (hak_t* hak, hak_cnode_t* src) { hak_cnode_t* cmd, * next; @@ -3298,7 +3308,7 @@ static int compile_fun (hak_t* hak, hak_cnode_t* src) tmp = HAK_CNODE_CONS_CAR(next); } - if (HAK_CNODE_IS_SYMBOL(tmp) || HAK_CNODE_IS_BINOP(tmp)) + if (is_cnode_eligible_for_fun_name(tmp)) { /* 'fun' followed by name */ fun_got_name: @@ -3335,7 +3345,7 @@ static int compile_fun (hak_t* hak, hak_cnode_t* src) } tmp = HAK_CNODE_CONS_CAR(next); - if (!HAK_CNODE_IS_SYMBOL(tmp) && !HAK_CNODE_IS_BINOP(tmp)) + if (!is_cnode_eligible_for_fun_name_after_colon(tmp)) { hak_setsynerrbfmt( hak, HAK_SYNERR_FUN, HAK_CNODE_GET_LOC(tmp), HAK_NULL, @@ -5746,8 +5756,6 @@ redo: case HAK_CNODE_TRPCOLONS: case HAK_CNODE_DBLCOLONS: case HAK_CNODE_COLON: - case HAK_CNODE_COLONLT: - case HAK_CNODE_COLONGT: default: /* hak_setsynerrbfmt(hak, HAK_SYNERR_INTERN, HAK_CNODE_GET_LOC(oprnd), HAK_CNODE_GET_TOK(oprnd), "internal error - unexpected object type %d", HAK_CNODE_GET_TYPE(oprnd)); @@ -6640,7 +6648,7 @@ static HAK_INLINE int post_fun (hak_t* hak) hak_var_info_t vi; int x; - HAK_ASSERT(hak, HAK_CNODE_IS_SYMBOL(fun_name) || HAK_CNODE_IS_BINOP(fun_name)); + HAK_ASSERT(hak, is_cnode_eligible_for_fun_name_after_colon(fun_name)); if (is_in_class_init_scope(hak)) { diff --git a/lib/fmt.c b/lib/fmt.c index bb80d83..d049d60 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -2248,17 +2248,28 @@ static HAK_INLINE int format_stack_args (hak_t* hak, hak_fmtout_t* fmtout, hak_o goto print_integer; case 'o': radix = 8; + sign = 1; goto print_integer; + /* Showing a negative number in 2's complement bit patterns is not + * proper when dealing with arbitrary precision. + * if you want the output in 2's complement, you will have to perform + * some bit manipulation. For example, to print -10 in 2's complement in 2 byte width: + * (core.bit-and -10 (- (core.bit-left-shift 1 16) 1)) + * printf "%b\n" (core.bit-and -10 (- (core.bit-left-shift 1 16) 1)) + * case 'u': radix = 10; goto print_integer; + */ case 'x': radix_flags |= HAK_INTTOSTR_LOWERCASE; case 'X': radix = 16; + sign = 1; goto print_integer; case 'b': radix = 2; + sign = 1; goto print_integer; /* end of integer conversions */ diff --git a/lib/hak-prv.h b/lib/hak-prv.h index a0fdd02..32a5e28 100644 --- a/lib/hak-prv.h +++ b/lib/hak-prv.h @@ -343,8 +343,6 @@ enum hak_tok_type_t HAK_TOK_DBLCOLONS, /* :: */ HAK_TOK_TRPCOLONS, /* ::: */ HAK_TOK_COLONEQ, /* := */ - HAK_TOK_COLONGT, /* :+ */ - HAK_TOK_COLONLT, /* :+ */ HAK_TOK_SEMICOLON, /* ; */ HAK_TOK_COMMA, /* , */ HAK_TOK_LPAREN, /* ( */ @@ -452,8 +450,6 @@ enum hak_cnode_type_t HAK_CNODE_TRPCOLONS, /* ::: */ HAK_CNODE_DBLCOLONS, /* :: */ HAK_CNODE_COLON, /* : */ - HAK_CNODE_COLONGT, /* :> */ - HAK_CNODE_COLONLT /* :< */ }; typedef enum hak_cnode_type_t hak_cnode_type_t; @@ -484,8 +480,6 @@ typedef enum hak_cnode_flag_t hak_cnode_flag_t; #define HAK_CNODE_IS_TRPCOLONS(x) ((x)->cn_type == HAK_CNODE_TRPCOLONS) #define HAK_CNODE_IS_DBLCOLONS(x) ((x)->cn_type == HAK_CNODE_DBLCOLONS) #define HAK_CNODE_IS_COLON(x) ((x)->cn_type == HAK_CNODE_COLON) -#define HAK_CNODE_IS_COLONGT(x) ((x)->cn_type == HAK_CNODE_COLONGT) -#define HAK_CNODE_IS_COLONLT(x) ((x)->cn_type == HAK_CNODE_COLONLT) #define HAK_CNODE_IS_SYMBOL(x) ((x)->cn_type == HAK_CNODE_SYMBOL) #define HAK_CNODE_IS_BINOP(x) ((x)->cn_type == HAK_CNODE_BINOP) @@ -880,6 +874,8 @@ enum hak_flx_state_t HAK_FLX_START, HAK_FLX_BACKSLASHED, HAK_FLX_COMMENT, + HAK_FLX_COLON_TOKEN, /* token beginning with : */ + HAK_FLX_COLONEQ_TOKEN, /* token beginning with := */ HAK_FLX_DELIM_TOKEN, HAK_FLX_DOLLARED_IDENT, HAK_FLX_HMARKED_TOKEN, /* hash-marked token */ @@ -2017,8 +2013,6 @@ hak_cnode_t* hak_makecnodeellipsis (hak_t* hak, int flags, const hak_loc_t* loc, hak_cnode_t* hak_makecnodetrpcolons (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); hak_cnode_t* hak_makecnodedblcolons (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); hak_cnode_t* hak_makecnodecolon (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); -hak_cnode_t* hak_makecnodecolongt (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); -hak_cnode_t* hak_makecnodecolonlt (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); hak_cnode_t* hak_makecnodecharlit (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok, hak_ooch_t v); hak_cnode_t* hak_makecnodebchrlit (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok, hak_oob_t v); hak_cnode_t* hak_makecnodesymbol (hak_t* hak, int flags, const hak_loc_t* loc, const hak_oocs_t* tok); @@ -2043,7 +2037,7 @@ void hak_dumpcnode (hak_t* hak, hak_cnode_t* c, int newline); /* ========================================================================= */ /* read.c */ /* ========================================================================= */ -int hak_is_binop_char (hak_ooci_t c); +int hak_is_binop_string (const hak_oocs_t* v); /* ========================================================================= */ /* exec.c */ @@ -2058,6 +2052,14 @@ hak_pfrc_t hak_pf_number_div (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_sqrt (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_abs (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_band (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_blshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_bnot (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_bor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_brshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_bshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_integer_bxor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); + hak_pfrc_t hak_pf_number_gt (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_ge (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_lt (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); @@ -2065,6 +2067,13 @@ hak_pfrc_t hak_pf_number_le (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_eq (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_number_ne (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_eqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_eql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_eqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_nqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_nql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); +hak_pfrc_t hak_pf_nqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); + hak_pfrc_t hak_pf_process_current (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_process_fork (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs); diff --git a/lib/prim.c b/lib/prim.c index a01f9f9..6f02560 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -528,7 +528,7 @@ static hak_pfrc_t pf_gc (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) /* ------------------------------------------------------------------------- */ -static hak_pfrc_t pf_eqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_eqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t a0, a1, rv; @@ -541,7 +541,7 @@ static hak_pfrc_t pf_eqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_eql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_eql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { int n; n = hak_equalobjs(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); @@ -551,7 +551,7 @@ static hak_pfrc_t pf_eql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_eqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_eqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { /* equal kind? */ hak_oop_t a0, a1, rv; @@ -565,7 +565,7 @@ static hak_pfrc_t pf_eqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_nqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_nqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t a0, a1, rv; @@ -578,7 +578,7 @@ static hak_pfrc_t pf_nqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_nql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_nql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { int n; n = hak_equalobjs(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); @@ -588,7 +588,7 @@ static hak_pfrc_t pf_nql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_nqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_nqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { /* not equal kind? */ hak_oop_t a0, a1, rv; @@ -1046,50 +1046,77 @@ hak_pfrc_t hak_pf_number_ne (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) return HAK_PF_SUCCESS; } +/* ------------------------------------------------------------------------- */ - -static hak_pfrc_t pf_integer_band (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_integer_band (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t ret; ret = hak_bitandints(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); - if (!ret) return HAK_PF_FAILURE; + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; HAK_STACK_SETRET(hak, nargs, ret); return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_integer_bor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +hak_pfrc_t hak_pf_integer_bor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t ret; ret = hak_bitorints(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); - if (!ret) return HAK_PF_FAILURE; + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; HAK_STACK_SETRET(hak, nargs, ret); return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_integer_bxor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) + +hak_pfrc_t hak_pf_integer_bxor (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t ret; ret = hak_bitxorints(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); - if (!ret) return HAK_PF_FAILURE; + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; HAK_STACK_SETRET(hak, nargs, ret); return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_integer_bnot (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) + +hak_pfrc_t hak_pf_integer_bnot (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t ret; ret = hak_bitinvint(hak, HAK_STACK_GETARG(hak, nargs, 0)); - if (!ret) return HAK_PF_FAILURE; + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; HAK_STACK_SETRET(hak, nargs, ret); return HAK_PF_SUCCESS; } -static hak_pfrc_t pf_integer_bshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) + +hak_pfrc_t hak_pf_integer_bshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) { hak_oop_t ret; ret = hak_bitshiftint(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); - if (!ret) return HAK_PF_FAILURE; + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; + + HAK_STACK_SETRET(hak, nargs, ret); + return HAK_PF_SUCCESS; +} + +hak_pfrc_t hak_pf_integer_blshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +{ + hak_oop_t ret; + ret = hak_bitshiftint(hak, HAK_STACK_GETARG(hak, nargs, 0), HAK_STACK_GETARG(hak, nargs, 1)); + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; + + HAK_STACK_SETRET(hak, nargs, ret); + return HAK_PF_SUCCESS; +} + +hak_pfrc_t hak_pf_integer_brshift (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) +{ + hak_oop_t ret; + + ret = hak_negateint(hak, HAK_STACK_GETARG(hak, nargs, 1)); + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; + + ret = hak_bitshiftint(hak, HAK_STACK_GETARG(hak, nargs, 0), ret); + if (HAK_UNLIKELY(!ret)) return HAK_PF_FAILURE; HAK_STACK_SETRET(hak, nargs, ret); return HAK_PF_SUCCESS; @@ -1293,12 +1320,12 @@ static pf_t builtin_prims[] = /* this is a long-cirtuit logical or. the short-circuit 'or' is treated as a special form */ { 2, HAK_TYPE_MAX(hak_oow_t), pf_or, 3, { '_','o','r' } }, - { 2, 2, pf_eqv, 4, { 'e','q','v','?' } }, - { 2, 2, pf_eql, 4, { 'e','q','l','?' } }, - { 2, 2, pf_eqk, 4, { 'e','q','k','?' } }, - { 2, 2, pf_nqv, 4, { 'n','q','v','?' } }, - { 2, 2, pf_nql, 4, { 'n','q','l','?' } }, - { 2, 2, pf_nqk, 4, { 'n','q','k','?' } }, + { 2, 2, hak_pf_eqv, 4, { 'e','q','v','?' } }, + { 2, 2, hak_pf_eql, 4, { 'e','q','l','?' } }, + { 2, 2, hak_pf_eqk, 4, { 'e','q','k','?' } }, + { 2, 2, hak_pf_nqv, 4, { 'n','q','v','?' } }, + { 2, 2, hak_pf_nql, 4, { 'n','q','l','?' } }, + { 2, 2, hak_pf_nqk, 4, { 'n','q','k','?' } }, { 1, 1, pf_is_nil, 4, { 'n','i','l','?' } }, { 1, 1, pf_is_boolean, 8, { 'b','o','o','l','e','a','n','?' } }, @@ -1333,11 +1360,13 @@ static pf_t builtin_prims[] = { 2, 2, hak_pf_number_ne, 2, { '~','=' } }, /* bitwise operations are supported for integers only */ - { 2, 2, pf_integer_band, 7, { 'b','i','t','-','a','n','d' } }, - { 2, 2, pf_integer_bor, 6, { 'b','i','t','-','o','r' } }, - { 2, 2, pf_integer_bxor, 7, { 'b','i','t','-','x','o','r' } }, - { 1, 1, pf_integer_bnot, 7, { 'b','i','t','-','n','o','t' } }, - { 2, 2, pf_integer_bshift, 9, { 'b','i','t','-','s','h','i','f','t' } }, + { 2, 2, hak_pf_integer_band, 7, { 'b','i','t','-','a','n','d' } }, + { 2, 2, hak_pf_integer_bor, 6, { 'b','i','t','-','o','r' } }, + { 2, 2, hak_pf_integer_bxor, 7, { 'b','i','t','-','x','o','r' } }, + { 1, 1, hak_pf_integer_bnot, 7, { 'b','i','t','-','n','o','t' } }, + { 2, 2, hak_pf_integer_bshift, 9, { 'b','i','t','-','s','h','i','f','t' } }, + { 2, 2, hak_pf_integer_blshift, 14, { 'b','i','t','-','l','e','f','t','-','s','h','i','f','t' } }, + { 2, 2, hak_pf_integer_brshift, 15, { 'b','i','t','-','r','i','g','h','t','-','s','h','i','f','t' } }, { 1, HAK_TYPE_MAX(hak_oow_t), pf_integer_quo, 3, { 'd','i','v' } }, { 2, HAK_TYPE_MAX(hak_oow_t), pf_integer_rem, 3, { 'r','e','m' } }, diff --git a/lib/print.c b/lib/print.c index 0325bd3..822fa13 100644 --- a/lib/print.c +++ b/lib/print.c @@ -967,8 +967,6 @@ void hak_dumpcnode (hak_t* hak, hak_cnode_t* cnode, int newline) case HAK_CNODE_TRPCOLONS: case HAK_CNODE_DBLCOLONS: case HAK_CNODE_COLON: - case HAK_CNODE_COLONGT: - case HAK_CNODE_COLONLT: hak_logbfmt(hak, HAK_LOG_FATAL, " %.*js ", HAK_CNODE_GET_TOKLEN(cnode), HAK_CNODE_GET_TOKPTR(cnode)); break; diff --git a/lib/read.c b/lib/read.c index 2a44c26..7b6f89f 100644 --- a/lib/read.c +++ b/lib/read.c @@ -23,7 +23,7 @@ */ #include "hak-prv.h" - +#include #define HAK_LANG_ENABLE_WIDE_DELIM #define HAK_LANG_AUTO_FORGE_XLIST_ALWAYS @@ -224,6 +224,7 @@ static struct static int init_compiler (hak_t* hak); static void feed_continue (hak_t* hak, hak_flx_state_t state); static int is_at_block_beginning (hak_t* hak); +static int flx_plain_ident (hak_t* hak, hak_ooci_t c); /* ----------------------------------------------------------------- */ @@ -476,6 +477,8 @@ static int get_char (hak_t* hak) static int is_pure_ident (hak_t* hak, const hak_oocs_t* v) { + HAK_ASSERT(hak, v->len > 0); /* you must not pass the zero-length value */ + if (is_pure_lead_ident_char(v->ptr[0])) { /* check if the word conforms to pure identifier rules: @@ -507,6 +510,19 @@ not_ident: return 0; } +int hak_is_binop_string (const hak_oocs_t* v) +{ + hak_oow_t i; + + if (v->len <= 0) return 0; /* you can pass the zero-length value */ + + for (i = 0; i < v->len; i++) + { + if (!is_binop_char(v->ptr[i])) return 0; + } + return 1; +} + static int classify_ident_token (hak_t* hak, const hak_oocs_t* v, const hak_loc_t* errloc, hak_tok_type_t* tok_type) { hak_oow_t i; @@ -1893,15 +1909,9 @@ static int feed_process_token (hak_t* hak) } else if (can <= -1) goto oops; - #if 1 HAK_ASSERT(hak, can == 1 || can == 2); frd->obj = hak_makecnodebinop(hak, 0, TOKEN_LOC(hak), TOKEN_NAME(hak)); goto auto_xlist; - #else - if (can == 1) goto ident; /* if binop is the first in the list */ - HAK_ASSERT(hak, can == 2); - goto ident; - #endif } case HAK_TOK_COMMA: @@ -2079,14 +2089,6 @@ static int feed_process_token (hak_t* hak) frd->obj = hak_makecnodedblcolons(hak, 0, TOKEN_LOC(hak), TOKEN_NAME(hak)); goto auto_xlist; - case HAK_TOK_COLONGT: - frd->obj = hak_makecnodecolongt(hak, 0, TOKEN_LOC(hak), TOKEN_NAME(hak)); - goto auto_xlist; - - case HAK_TOK_COLONLT: - frd->obj = hak_makecnodecolonlt(hak, 0, TOKEN_LOC(hak), TOKEN_NAME(hak)); - goto auto_xlist; - case HAK_TOK_SMPTRLIT: { hak_oow_t i; @@ -2308,10 +2310,12 @@ static delim_token_t delim_token_tab[] = { "..", 2, HAK_TOK_DBLDOTS }, { "...", 3, HAK_TOK_ELLIPSIS }, /* for variable arguments */ + /* the tokens beginning with a colon must be handled separately in flx_colon_token() + * becuase some characters(= only as of now) after the colon are binop charaters, i + * don't want to find the match from the beginning. if a colon is followed by binop + * characters, i want to read all of them first and determin the token types */ { ":", 1, HAK_TOK_COLON }, /* key-value separator in dictionary or for method call or definition */ { ":=", 2, HAK_TOK_COLONEQ }, /* assignment */ - { ":>", 2, HAK_TOK_COLONGT }, - { ":<", 2, HAK_TOK_COLONLT }, { "::", 2, HAK_TOK_DBLCOLONS }, /* superclass, class variables, class methods */ { ":::", 3, HAK_TOK_TRPCOLONS }, @@ -2482,7 +2486,12 @@ static int flx_start (hak_t* hak, hak_ooci_t c) reset_flx_token(hak); - if (find_delim_token_char(hak, c, 0, HAK_COUNTOF(delim_token_tab) - 1, 0, FLX_DT(hak))) + if (c == ':') + { + FEED_CONTINUE_WITH_CHAR(hak, c, HAK_FLX_COLON_TOKEN); + goto consumed; + } + else if (find_delim_token_char(hak, c, 0, HAK_COUNTOF(delim_token_tab) - 1, 0, FLX_DT(hak))) { /* the character is one of the first character of a delimiter token such as (, [, :, etc */ if (FLX_DT(hak)->row_start == FLX_DT(hak)->row_end && @@ -2616,6 +2625,54 @@ static int flx_comment (hak_t* hak, hak_ooci_t c) return 1; /* consumed */ } +static int flx_colon_token (hak_t* hak, hak_ooci_t c) +{ + if (c == '=') + { + FEED_CONTINUE_WITH_CHAR(hak, c, HAK_FLX_COLONEQ_TOKEN); + goto consumed; + } + else + { + /* as if it's called in flx_start() */ + find_delim_token_char(hak, ':', 0, HAK_COUNTOF(delim_token_tab) - 1, 0, FLX_DT(hak)); /* this must succeed */ + FEED_CONTINUE(hak, HAK_FLX_DELIM_TOKEN); + goto not_consumed; + } + +consumed: + return 1; + +not_consumed: + return 0; +} + +static int flx_coloneq_token (hak_t* hak, hak_ooci_t c) +{ + if (is_binop_char(c)) + { + /* := followed by another binop char */ + TOKEN_NAME_LEN(hak)--; /* as if = after : is not in the token buffer */ + FEED_WRAP_UP(hak, HAK_TOK_COLON); + + /* as if feed_char('=') has been called. super ugly!! it plays trick to make this part just work. i hate this part */ + reset_flx_token(hak); + TOKEN_LOC(hak)->colm--; /* since the actual starting = is one character before c */ + init_flx_pi(FLX_PI(hak)); + if (flx_plain_ident(hak, '=') <= -1) return -1; + FEED_CONTINUE(hak, HAK_FLX_PLAIN_IDENT); + goto not_consumed; + } + else + { + FEED_WRAP_UP(hak, HAK_TOK_COLONEQ); + goto not_consumed; + } + +not_consumed: + return 0; +} + static int flx_delim_token (hak_t* hak, hak_ooci_t c) { if (find_delim_token_char(hak, c, FLX_DT(hak)->row_start, FLX_DT(hak)->row_end, FLX_DT(hak)->col_next, FLX_DT(hak))) @@ -3532,6 +3589,8 @@ static int feed_char (hak_t* hak, hak_ooci_t c) case HAK_FLX_START: return flx_start(hak, c); case HAK_FLX_BACKSLASHED: return flx_backslashed(hak, c); case HAK_FLX_COMMENT: return flx_comment(hak, c); + case HAK_FLX_COLON_TOKEN: return flx_colon_token(hak, c); + case HAK_FLX_COLONEQ_TOKEN: return flx_coloneq_token(hak, c); case HAK_FLX_DELIM_TOKEN: return flx_delim_token(hak, c); case HAK_FLX_DOLLARED_IDENT: return flx_dollared_ident(hak, c); case HAK_FLX_HMARKED_TOKEN: return flx_hmarked_token(hak, c); diff --git a/mod/core.c b/mod/core.c index ebc3c6a..3dc6bfc 100644 --- a/mod/core.c +++ b/mod/core.c @@ -499,16 +499,36 @@ static hak_pfinfo_t pfinfos[] = { "==", { HAK_PFBASE_FUNC, hak_pf_number_eq, 2, 2 } }, { ">", { HAK_PFBASE_FUNC, hak_pf_number_gt, 2, 2 } }, { ">=", { HAK_PFBASE_FUNC, hak_pf_number_ge, 2, 2 } }, + /* TODO: add more builtin primitives here... */ { "abs", { HAK_PFBASE_FUNC, hak_pf_number_abs, 1, 1 } }, { "basicAt", { HAK_PFBASE_FUNC, pf_core_basic_at, 2, 2 } }, { "basicAtPut", { HAK_PFBASE_FUNC, pf_core_basic_at_put, 3, 3 } }, { "basicNew", { HAK_PFBASE_FUNC, pf_core_basic_new, 1, 2 } }, { "basicSize", { HAK_PFBASE_FUNC, pf_core_basic_size, 1, 1 } }, + + { "bit-and", { HAK_PFBASE_FUNC, hak_pf_integer_band, 2, 2 } }, + { "bit-left-shift", { HAK_PFBASE_FUNC, hak_pf_integer_blshift, 2, 2 } }, + { "bit-not", { HAK_PFBASE_FUNC, hak_pf_integer_bnot, 1, 1 } }, + { "bit-or", { HAK_PFBASE_FUNC, hak_pf_integer_bor, 2, 2 } }, + { "bit-right-shift", { HAK_PFBASE_FUNC, hak_pf_integer_brshift, 2, 2 } }, + { "bit-shift", { HAK_PFBASE_FUNC, hak_pf_integer_bshift, 2, 2 } }, + { "bit-xor", { HAK_PFBASE_FUNC, hak_pf_integer_bxor, 2, 2 } }, + { "charToSmooi", { HAK_PFBASE_FUNC, pf_core_char_to_smooi, 1, 1 } }, { "className", { HAK_PFBASE_FUNC, pf_core_class_name, 1, 1 } }, { "classRespondsTo", { HAK_PFBASE_FUNC, pf_core_class_responds_to, 2, 2 } }, + + { "eqk?", { HAK_PFBASE_FUNC, hak_pf_eqk, 2, 2 } }, + { "eql?", { HAK_PFBASE_FUNC, hak_pf_eql, 2, 2 } }, + { "eqv?", { HAK_PFBASE_FUNC, hak_pf_eqv, 2, 2 } }, + { "instRespondsTo", { HAK_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } }, + + { "nqk?", { HAK_PFBASE_FUNC, hak_pf_nqk, 2, 2 } }, + { "nql?", { HAK_PFBASE_FUNC, hak_pf_nql, 2, 2 } }, + { "nqv?", { HAK_PFBASE_FUNC, hak_pf_nqv, 2, 2 } }, + { "primAt", { HAK_PFBASE_FUNC, pf_core_prim_at, 2, 2 } }, { "primAtPut", { HAK_PFBASE_FUNC, pf_core_prim_at_put, 3, 3 } }, { "slice", { HAK_PFBASE_FUNC, pf_core_slice, 3, 3 } }, diff --git a/t/Makefile.am b/t/Makefile.am index a3fde4f..efbc667 100644 --- a/t/Makefile.am +++ b/t/Makefile.am @@ -13,6 +13,7 @@ check_SCRIPTS = \ fun-01.hak \ insta-01.hak \ insta-02.hak \ + prim-01.hak \ proc-01.hak \ ret-01.hak \ retvar-01.hak \ diff --git a/t/Makefile.in b/t/Makefile.in index 5c68b30..6b6b61f 100644 --- a/t/Makefile.in +++ b/t/Makefile.in @@ -542,6 +542,7 @@ check_SCRIPTS = \ fun-01.hak \ insta-01.hak \ insta-02.hak \ + prim-01.hak \ proc-01.hak \ ret-01.hak \ retvar-01.hak \ diff --git a/t/class-5001.err b/t/class-5001.err index bca0f24..d5af75c 100644 --- a/t/class-5001.err +++ b/t/class-5001.err @@ -346,3 +346,12 @@ class[#b] X (a) { class Y: X { ##ERROR: exception not handled - "incompatible byte superclass X with oop class" } + +--- + +## you can't send a binary message to an object the receiver:message syntax. +## you must omit the colon for the binary message +## it must be '20 == 40' + +fun Number:==(b) { return (core.+ self b) } +20 :== 40 ##ERROR: syntax error - prohibited binary selector '==' diff --git a/t/prim-01.hak b/t/prim-01.hak new file mode 100644 index 0000000..2527cfb --- /dev/null +++ b/t/prim-01.hak @@ -0,0 +1,39 @@ +{ +## START +| x | + +x := (sprintf "%b %b" 123 (core.bit-not 123)) +expected := "1111011 -1111100" +if (core.eql? x "1111011 -1111100") { ## bit-inversion of 123 is -124. + printf "OK: %s\n" expected +} else { + printf "BAD: x is not %s - %s\n" expected x +} + + +##fun Number:"+"(b) { return (core.+ self b) } +fun Number:+(b) { return (core.+ self b) } +fun Number:-(b) { return (core.- self b) } +fun Number:*(b) { return (core.* self b) } +fun Number:/(b) { return (core./ self b) } +fun Apex:==(b) { return (core.eql? self b) } +fun Apex:~=(b) { return (core.nql? self b) } +## big numbers and fixed pointer decimals don't share the same object for the same values. +## we must use eql or nql, can't use eqv or nqv. + +expected := 2 +if ((x := (1 + 2 * 3 / 4)) == expected) { ## note: there is no operator precedence since it doesn't no what operation each binop represents + printf "OK: %d\n" expected +} else { + printf "BAD: x is not %d - %d\n" expected x +} + +expected := 2.2 +if ((x := (1.0 + 2 * 3 / 4)) ~= expected) { + printf "BAD: x is not %O - %O\n" expected x +} else { + printf "OK: %O\n" expected +} + +## END +}