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

change the way to read a token beginning with a colon.

Browse Source 
added more primitive functions to the core module
This commit is contained in:
hyung-hwan
2025-09-26 00:32:33 +09:00
parent 4c000c2c9c
commit 0128fe88dc
13 changed files with 250 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
README.md
View File

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

10
lib/cnode.c
View File

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

18
lib/comp.c
View File

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

11
lib/fmt.c
View File

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

27
lib/hak-prv.h
View File

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

85
lib/prim.c
View File

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

2
lib/print.c
View File

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

95
lib/read.c
View File

@ -23,7 +23,7 @@
*/
#include "hak-prv.h"
#include <stdio.h>
#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);

20
mod/core.c
View File

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

1
t/Makefile.am
View File

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

1
t/Makefile.in
View File

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

9
t/class-5001.err
View File

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

39
t/prim-01.hak Normal file
View File

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