From a3e2b589be75aadc61de9971116778ac7dd480d9 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sun, 15 Sep 2024 11:51:11 +0900 Subject: [PATCH] added the make_charaarray instruction and pop_into_chararray insruction --- lib/comp.c | 74 ++++++++++++++++++++++++++++----------------------- lib/decode.c | 10 +++++++ lib/exec.c | 43 ++++++++++++++++++++++++++++++ lib/gc.c | 13 +++++++++ lib/hcl-prv.h | 8 +++--- lib/hcl.h | 8 ++++++ lib/obj.c | 12 +++++++++ lib/read.c | 20 +++++++------- mod/core.c | 39 ++++++++++++++++++++++++++- t/feed-01.hcl | 49 ++++++++++++++++++++++++++++++++++ 10 files changed, 229 insertions(+), 47 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index f31dd81..4b297e9 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -716,8 +716,10 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1 case HCL_CODE_MAKE_DIC: /* TODO: don't these need write_long2? */ case HCL_CODE_MAKE_ARRAY: case HCL_CODE_MAKE_BYTEARRAY: + case HCL_CODE_MAKE_CHARARRAY: case HCL_CODE_POP_INTO_ARRAY: case HCL_CODE_POP_INTO_BYTEARRAY: + case HCL_CODE_POP_INTO_CHARARRAY: bc = cmd; goto write_long; } @@ -1650,7 +1652,7 @@ enum COP_COMPILE_TRY_OBJECT_LIST_TAIL, COP_COMPILE_ARRAY_LIST, - COP_COMPILE_BYTEARRAY_LIST, + COP_COMPILE_PURE_ARRAY_LIST, COP_COMPILE_DIC_LIST, COP_COMPILE_QLIST, /* compile data list */ @@ -1678,11 +1680,11 @@ enum COP_EMIT_SEND, COP_EMIT_MAKE_ARRAY, - COP_EMIT_MAKE_BYTEARRAY, + COP_EMIT_MAKE_PURE_ARRAY, COP_EMIT_MAKE_DIC, COP_EMIT_MAKE_CONS, COP_EMIT_POP_INTO_ARRAY, - COP_EMIT_POP_INTO_BYTEARRAY, + COP_EMIT_POP_INTO_PURE_ARRAY, COP_EMIT_POP_INTO_DIC, COP_EMIT_POP_INTO_CONS, COP_EMIT_POP_INTO_CONS_END, @@ -3844,16 +3846,16 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj, int return -1; } - SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_BYTEARRAY, obj); + SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_PURE_ARRAY, obj); cf = GET_TOP_CFRAME(hcl); - cf->u.bytearray_list.elem_type = concode; - cf->u.bytearray_list.index = nargs; + cf->u.pure_array_list.elem_type = concode; + cf->u.pure_array_list.index = nargs; /* redundant cdr check is performed inside compile_object_list() */ - PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, obj); + PUSH_SUBCFRAME (hcl, COP_COMPILE_PURE_ARRAY_LIST, obj); cf = GET_SUBCFRAME(hcl); - cf->u.bytearray_list.elem_type = concode; - cf->u.bytearray_list.index = 0; + cf->u.pure_array_list.elem_type = concode; + cf->u.pure_array_list.index = 0; return 0; } @@ -5001,6 +5003,10 @@ redo: if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_BYTEARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; goto done; + case HCL_CONCODE_CHARARRAY: + if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_CHARARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; + goto done; + case HCL_CONCODE_DIC: if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_DIC, 16, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1; goto done; @@ -5282,13 +5288,13 @@ static int compile_array_list (hcl_t* hcl) return 0; } -static int compile_bytearray_list (hcl_t* hcl) +static int compile_pure_array_list (hcl_t* hcl) { hcl_cframe_t* cf; hcl_cnode_t* oprnd; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_BYTEARRAY_LIST); + HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_PURE_ARRAY_LIST); oprnd = cf->operand; @@ -5311,8 +5317,8 @@ static int compile_bytearray_list (hcl_t* hcl) car = HCL_CNODE_CONS_CAR(oprnd); cdr = HCL_CNODE_CONS_CDR(oprnd); - oldidx = cf->u.bytearray_list.index; - elem_type = cf->u.bytearray_list.index; + oldidx = cf->u.pure_array_list.index; + elem_type = cf->u.pure_array_list.elem_type; /* TODO: compile type check if the data element is literal... runtime check if the data is a variable or something... */ @@ -5320,16 +5326,16 @@ static int compile_bytearray_list (hcl_t* hcl) SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); if (cdr) { - PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, cdr); + PUSH_SUBCFRAME (hcl, COP_COMPILE_PURE_ARRAY_LIST, cdr); cf = GET_SUBCFRAME(hcl); - cf->u.bytearray_list.elem_type = elem_type; - cf->u.bytearray_list.index = oldidx + 1; + cf->u.pure_array_list.elem_type = elem_type; + cf->u.pure_array_list.index = oldidx + 1; } - PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_BYTEARRAY, car); + PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_PURE_ARRAY, car); cf = GET_SUBCFRAME(hcl); - cf->u.bytearray_list.elem_type = elem_type; - cf->u.bytearray_list.index = oldidx; + cf->u.pure_array_list.elem_type = elem_type; + cf->u.pure_array_list.index = oldidx; } return 0; @@ -5714,16 +5720,17 @@ static HCL_INLINE int emit_make_array (hcl_t* hcl) return n; } -static HCL_INLINE int emit_make_bytearray (hcl_t* hcl) +static HCL_INLINE int emit_make_pure_array (hcl_t* hcl) { hcl_cframe_t* cf; - int n; + int n, inst; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_BYTEARRAY); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_PURE_ARRAY); HCL_ASSERT (hcl, cf->operand != HCL_NULL); - n = emit_single_param_instruction(hcl, HCL_CODE_MAKE_BYTEARRAY, cf->u.bytearray_list.index, HCL_CNODE_GET_LOC(cf->operand)); + inst = (cf->u.pure_array_list.elem_type == HCL_CONCODE_BYTEARRAY)? HCL_CODE_MAKE_BYTEARRAY: HCL_CODE_MAKE_CHARARRAY; + n = emit_single_param_instruction(hcl, inst, cf->u.pure_array_list.index, HCL_CNODE_GET_LOC(cf->operand)); POP_CFRAME (hcl); return n; @@ -5774,16 +5781,17 @@ static HCL_INLINE int emit_pop_into_array (hcl_t* hcl) return n; } -static HCL_INLINE int emit_pop_into_bytearray (hcl_t* hcl) +static HCL_INLINE int emit_pop_into_pure_array (hcl_t* hcl) { hcl_cframe_t* cf; - int n; + int n, inst; cf = GET_TOP_CFRAME(hcl); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_BYTEARRAY); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_PURE_ARRAY); HCL_ASSERT (hcl, cf->operand != HCL_NULL); - n = emit_single_param_instruction(hcl, HCL_CODE_POP_INTO_BYTEARRAY, cf->u.bytearray_list.index, HCL_CNODE_GET_LOC(cf->operand)); + inst = (cf->u.pure_array_list.elem_type == HCL_CONCODE_BYTEARRAY)? HCL_CODE_POP_INTO_BYTEARRAY: HCL_CODE_POP_INTO_CHARARRAY; + n = emit_single_param_instruction(hcl, inst, cf->u.pure_array_list.index, HCL_CNODE_GET_LOC(cf->operand)); POP_CFRAME (hcl); return n; @@ -6368,8 +6376,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) if (compile_array_list(hcl) <= -1) goto oops; break; - case COP_COMPILE_BYTEARRAY_LIST: - if (compile_bytearray_list(hcl) <= -1) goto oops; + case COP_COMPILE_PURE_ARRAY_LIST: + if (compile_pure_array_list(hcl) <= -1) goto oops; break; case COP_COMPILE_DIC_LIST: @@ -6448,8 +6456,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) if (emit_make_array(hcl) <= -1) goto oops; break; - case COP_EMIT_MAKE_BYTEARRAY: - if (emit_make_bytearray(hcl) <= -1) goto oops; + case COP_EMIT_MAKE_PURE_ARRAY: + if (emit_make_pure_array(hcl) <= -1) goto oops; break; case COP_EMIT_MAKE_DIC: @@ -6464,8 +6472,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags) if (emit_pop_into_array(hcl) <= -1) goto oops; break; - case COP_EMIT_POP_INTO_BYTEARRAY: - if (emit_pop_into_bytearray(hcl) <= -1) goto oops; + case COP_EMIT_POP_INTO_PURE_ARRAY: + if (emit_pop_into_pure_array(hcl) <= -1) goto oops; break; case COP_EMIT_POP_INTO_DIC: diff --git a/lib/decode.c b/lib/decode.c index f5a167d..e8bbb3d 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -645,6 +645,16 @@ int hcl_decode (hcl_t* hcl, const hcl_code_t* code, hcl_oow_t start, hcl_oow_t e LOG_INST_1 (hcl, "pop_into_bytearray %zu", b1); break; + case HCL_CODE_MAKE_CHARARRAY: + FETCH_PARAM_CODE_TO (hcl, b1); + LOG_INST_1 (hcl, "make_chararray %zu", b1); + break; + + case HCL_CODE_POP_INTO_CHARARRAY: + FETCH_PARAM_CODE_TO (hcl, b1); + LOG_INST_1 (hcl, "pop_into_chararray %zu", b1); + break; + case HCL_CODE_MAKE_DIC: FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "make_dic %zu", b1); diff --git a/lib/exec.c b/lib/exec.c index c6b1181..feccea0 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -4638,6 +4638,49 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc break; } + case HCL_CODE_MAKE_CHARARRAY: + { + hcl_oop_t t; + + FETCH_PARAM_CODE_TO (hcl, b1); + LOG_INST_1 (hcl, "make_chararray %zu", b1); + + /* create an empty array */ + t = hcl_makechararray(hcl, HCL_NULL, b1); + if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; + + HCL_STACK_PUSH (hcl, t); /* push the char array created */ + break; + } + + case HCL_CODE_POP_INTO_CHARARRAY: + { + hcl_oop_t t1, t2; + hcl_ooi_t bv; + + FETCH_PARAM_CODE_TO (hcl, b1); + LOG_INST_1 (hcl, "pop_into_chararray %zu", b1); + + t1 = HCL_STACK_GETTOP(hcl); /* value to store */ + if (!HCL_OOP_IS_CHAR(t1) || (bv = HCL_OOP_TO_CHAR(t1)) < 0 || bv > 255) + { + hcl_seterrbfmt (hcl, HCL_ERANGE, "not a character or out of character range - %O", t1); + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; + } + HCL_STACK_POP (hcl); + t2 = HCL_STACK_GETTOP(hcl); /* char array */ + + if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2))) + { + hcl_seterrbfmt (hcl, HCL_ECALL, "character array index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2)); + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; + } + ((hcl_oop_char_t)t2)->slot[b1] = bv; + break; + } + case HCL_CODE_MAKE_DIC: { hcl_oop_t t; diff --git a/lib/gc.c b/lib/gc.c index 78dc814..6c3e38b 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -135,6 +135,7 @@ enum { KCI_BYTE_STRING, KCI_SYMBOL, KCI_ARRAY, + KCI_CHARACTER_ARRAY, KCI_BYTE_ARRAY, KCI_SYMBOL_TABLE, KCI_DICTIONARY, @@ -335,6 +336,18 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] = HCL_OFFSETOF(hcl_t, c_array) }, + KCI(KCI_CHARACTER_ARRAY) { + "CharacterArray", + KCI_FIXED_SIZED_COLLECTION, + HCL_BRAND_CHARACTER_ARRAY, + 0, + 0, + 0, + HCL_CLASS_SPEC_FLAG_INDEXED, + HCL_OBJ_TYPE_CHAR, + HCL_OFFSETOF(hcl_t, c_character_array) + }, + KCI(KCI_BYTE_ARRAY) { "ByteArray", KCI_FIXED_SIZED_COLLECTION, diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 24b52da..7560a39 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -624,12 +624,12 @@ struct hcl_cframe_t hcl_ooi_t index; } array_list; - /* COP_COMPILE_BYTEARRAY_LIST, COP_POP_INTO_BYTEARRAY, COP_EMIT_MAKE_BYTEARRAY */ + /* COP_COMPILE_PURE_ARRAY_LIST, COP_POP_INTO_PURE_ARRAY, COP_EMIT_MAKE_PURE_ARRAY */ struct { int elem_type; hcl_ooi_t index; - } bytearray_list; + } pure_array_list; /* COP_EMIT_MAKE_DIC */ struct @@ -1376,8 +1376,8 @@ enum hcl_bcode_t HCL_CODE_POP_INTO_CTXTEMPVAR_X = 0xDC, /* 220 ## */ HCL_CODE_CLASS_LOAD = 0xDD, /* 221 ## */ - - /* UNUSED - 0xDE - 0xDF */ + HCL_CODE_MAKE_CHARARRAY = 0xDE, /* 222 ## */ + HCL_CODE_POP_INTO_CHARARRAY = 0xDF, /* 223 ## */ HCL_CODE_PUSH_CTXTEMPVAR_X = 0xE0, /* 224 ## */ HCL_CODE_CLASS_ENTER = 0xE1, /* 225 ## */ diff --git a/lib/hcl.h b/lib/hcl.h index da764ce..93d5880 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1721,6 +1721,7 @@ struct hcl_t hcl_oop_class_t c_byte_string; /* String */ hcl_oop_class_t c_symbol; /* Symbol */ hcl_oop_class_t c_array; /* Array */ + hcl_oop_class_t c_character_array; /* CharacterArray */ hcl_oop_class_t c_byte_array; /* ByteArray */ hcl_oop_class_t c_symtab; /* SymbolTable */ hcl_oop_class_t c_dictionary; @@ -2010,6 +2011,7 @@ enum hcl_brand_t HCL_BRAND_CONS, HCL_BRAND_ARRAY, HCL_BRAND_BYTE_ARRAY, + HCL_BRAND_CHARACTER_ARRAY, HCL_BRAND_SYMBOL, HCL_BRAND_STRING, HCL_BRAND_BYTE_STRING, @@ -2897,6 +2899,12 @@ HCL_EXPORT hcl_oop_t hcl_makearray ( hcl_oow_t len ); +HCL_EXPORT hcl_oop_t hcl_makechararray ( + hcl_t* hcl, + const hcl_ooch_t* ptr, + hcl_oow_t len +); + HCL_EXPORT hcl_oop_t hcl_makebytearray ( hcl_t* hcl, const hcl_oob_t* ptr, diff --git a/lib/obj.c b/lib/obj.c index abff652..ed72246 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -345,6 +345,18 @@ hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t len) #endif } +hcl_oop_t hcl_makechararray (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) +{ + hcl_oop_t v; + v = hcl_instantiate(hcl, hcl->c_character_array, ptr, len); + if (HCL_UNLIKELY(!v)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make char-array - %js", orgmsg); + } + return v; +} + hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { #if 0 diff --git a/lib/read.c b/lib/read.c index 0998501..aab95b0 100644 --- a/lib/read.c +++ b/lib/read.c @@ -846,7 +846,8 @@ static HCL_INLINE int can_comma_list (hcl_t* hcl) { if (rstl->count & 1) return 0; } - else if (cc != HCL_CONCODE_ARRAY && cc != HCL_CONCODE_BYTEARRAY && cc != HCL_CONCODE_TUPLE) + else if (cc != HCL_CONCODE_ARRAY && cc != HCL_CONCODE_BYTEARRAY && + cc != HCL_CONCODE_CHARARRAY && cc != HCL_CONCODE_TUPLE) { return 0; } @@ -2469,16 +2470,18 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) /* --------------------------- */ - case 'x': + case 'x': /* hexadecimal number */ init_flx_hn (FLX_HN(hcl), HCL_TOK_RADNUMLIT, HCL_SYNERR_NUMLIT, 16); goto radixed_number; - case 'o': + case 'o': /* octal number */ init_flx_hn (FLX_HN(hcl), HCL_TOK_RADNUMLIT, HCL_SYNERR_NUMLIT, 8); goto radixed_number; - case 'b': - case 'c': + case 'b': /* binary number or byte array */ + case 'B': + case 'c': /* character array */ + case 'C': #if 0 init_flx_hn (FLX_HN(hcl), HCL_TOK_RADNUMLIT, HCL_SYNERR_NUMLIT, 2); goto radixed_number; @@ -2489,12 +2492,11 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) break; #endif - - case 'e': + case 'e': /* #eXXX - error literal */ init_flx_hn (FLX_HN(hcl), HCL_TOK_ERRLIT, HCL_SYNERR_ERRLIT, 10); goto radixed_number; - case 'p': + case 'p': /* #pXXX - small pointer */ init_flx_hn (FLX_HN(hcl), HCL_TOK_SMPTRLIT, HCL_SYNERR_SMPTRLIT, 16); radixed_number: FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_FLX_HMARKED_NUMBER); @@ -2518,7 +2520,7 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) FEED_WRAP_UP_WITH_CHAR (hcl, c, HCL_TOK_DLPAREN); goto consumed; - case '"': /* #" */ + case '"': /* #" - double-quoted symbol */ reset_flx_token (hcl); init_flx_qt (FLX_QT(hcl), HCL_TOK_SYMLIT, HCL_SYNERR_SYMLIT, c, '\\', 0, HCL_TYPE_MAX(hcl_oow_t), 0); FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard prefix, quote and move on */ diff --git a/mod/core.c b/mod/core.c index e20af76..03ca31e 100644 --- a/mod/core.c +++ b/mod/core.c @@ -446,6 +446,41 @@ static hcl_pfrc_t pf_core_slice (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } +static hcl_pfrc_t pf_core_char_to_smooi (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_t rcv, out; + hcl_ooi_t code; + + rcv = HCL_STACK_GETARG(hcl, nargs, 0); + if (!HCL_OOP_IS_CHAR(rcv)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not Character - %O", rcv); + return HCL_PF_FAILURE; + } + + code = HCL_OOP_TO_CHAR(rcv); + out = HCL_SMOOI_TO_OOP(code); + HCL_STACK_SETRET (hcl, nargs, out); + return HCL_PF_SUCCESS; +} + +static hcl_pfrc_t pf_core_smooi_to_char (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) +{ + hcl_oop_t rcv, out; + hcl_ooi_t code; + + rcv = HCL_STACK_GETARG(hcl, nargs, 0); + if (!HCL_OOP_IS_SMOOI(rcv)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not SmallInteger - %O", rcv); + return HCL_PF_FAILURE; + } + + code = HCL_OOP_TO_SMOOI(rcv); + out = HCL_CHAR_TO_OOP(code); + HCL_STACK_SETRET (hcl, nargs, out); + return HCL_PF_SUCCESS; +} static hcl_pfinfo_t pfinfos[] = { @@ -453,12 +488,14 @@ static hcl_pfinfo_t pfinfos[] = { "basicAtPut", { HCL_PFBASE_FUNC, pf_core_basic_at_put, 3, 3 } }, { "basicNew", { HCL_PFBASE_FUNC, pf_core_basic_new, 2, 2 } }, { "basicSize", { HCL_PFBASE_FUNC, pf_core_basic_size, 1, 1 } }, + { "charToSmooi", { HCL_PFBASE_FUNC, pf_core_char_to_smooi, 1, 1 } }, { "className", { HCL_PFBASE_FUNC, pf_core_class_name, 1, 1 } }, { "classRespondsTo", { HCL_PFBASE_FUNC, pf_core_class_responds_to, 2, 2 } }, { "instRespondsTo", { HCL_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } }, { "primAt", { HCL_PFBASE_FUNC, pf_core_prim_at, 2, 2 } }, { "primAtPut", { HCL_PFBASE_FUNC, pf_core_prim_at_put, 3, 3 } }, - { "slice", { HCL_PFBASE_FUNC, pf_core_slice, 3, 3 } } + { "slice", { HCL_PFBASE_FUNC, pf_core_slice, 3, 3 } }, + { "smooiToChar", { HCL_PFBASE_FUNC, pf_core_smooi_to_char, 1, 1 } }, }; /* ------------------------------------------------------------------------ */ diff --git a/t/feed-01.hcl b/t/feed-01.hcl index bed583a..d71ca3f 100644 --- a/t/feed-01.hcl +++ b/t/feed-01.hcl @@ -54,4 +54,53 @@ if { q := 10; < k q } { ## a block expression is a normal expression. so it can printf "OK: k is less than q\n" } else (printf "BAD: k is not less than q\n") + +fun ByteArray:at(pos) { + return (core.basicAt self pos) +} + +fun CharacterArray:at(pos) { + return (core.basicAt self pos) +} + +fun SmallInteger:toCharacter() { + return (core.smooiToChar self) +} + +fun Character:toCode() { + return (core.charToSmooi self) +} + +ba := #B[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15] +i := 0 +while (< i 15) { + x := (+ i 1) + if (== (ba:at i) x) { printf "OK: (ba:at %d) is %O\n" i (ba:at i) } \ + else { printf "ERROR: (ba:at %d) is not %d\n" i x } + i := x +} + +ca := #C[ + 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', + 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', + 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', + 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z' +] + +i := 0 +while (< i 26) { + x := ((+ i ('a':toCode)):toCharacter) + if (eqv? (ca:at i) x) { printf "OK: (ca:at %d) is %O\n" i x } \ + else { printf "ERROR: (ca:at %d) is not %O\n" i x} + i := (+ i 1) +} + +i := 26 +while (< i 52) { + x := ((+ (- i 26) ('A':toCode)):toCharacter) + if (eqv? (ca:at i) x) { printf "OK: (ca:at %d) is %O\n" i x } \ + else { printf "ERROR: (ca:at %d) is not %O\n" i x} + i := (+ i 1) +} + } ## END