From e2864bab55a337115aef025d6a1f68c6c7571d0c Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Mon, 29 Jul 2024 19:15:12 +0900 Subject: [PATCH] added pf_core_put --- lib/read.c | 3 ++- mod/core.c | 72 ++++++++++++++++++++++++++++++++++++++++++-------- src/kernel.hcl | 34 ++++++++++++++++++++++-- 3 files changed, 95 insertions(+), 14 deletions(-) diff --git a/lib/read.c b/lib/read.c index d431832..ef9f6c9 100644 --- a/lib/read.c +++ b/lib/read.c @@ -2235,7 +2235,8 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) * #\tab * #\vtab * #include - * #[ ] byte array + * #[ ] array + * #b[ ] byte array * #( ) qlist * #{ } dictionary */ diff --git a/mod/core.c b/mod/core.c index d7d31fd..2f0787d 100644 --- a/mod/core.c +++ b/mod/core.c @@ -212,11 +212,10 @@ static hcl_pfrc_t pf_core_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) return HCL_PF_SUCCESS; } -#if 0 static hcl_pfrc_t pf_core_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) { - hcl_oop_t obj; - hcl_oop_t pos, val; + hcl_oop_t obj, val; + hcl_oop_t pos; hcl_oow_t index; obj = HCL_STACK_GETARG(hcl, nargs, 0); @@ -230,23 +229,74 @@ static hcl_pfrc_t pf_core_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) return HCL_PF_FAILURE; } - if (!HCL_IS_ARRAY(hcl,obj)) - { - hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not an array - %O", obj); - return HCL_PF_FAILURE; - } if (!HCL_OOP_IS_SMOOI(pos)) { hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos); return HCL_PF_FAILURE; } index = HCL_OOP_TO_SMOOI(pos); + if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%O) out of range - 0 and %zu", pos, (hcl_oow_t)HCL_OBJ_GET_SIZE(obj) - 1); + return HCL_PF_FAILURE; + } + + switch (HCL_OBJ_GET_FLAGS_TYPE(obj)) + { + case HCL_OBJ_TYPE_OOP: + HCL_OBJ_SET_OOP_VAL(obj, index, val); + break; + + case HCL_OBJ_TYPE_CHAR: + { + hcl_ooch_t c; + if (!HCL_OOP_IS_CHAR(val)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "value not character - %O", val); + return HCL_PF_FAILURE; + } + c = HCL_OOP_TO_CHAR(val); + HCL_OBJ_SET_CHAR_VAL(obj, index, c); + break; + } + + case HCL_OBJ_TYPE_BYTE: + { + hcl_ooi_t b; + if (!HCL_OOP_IS_SMOOI(val)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "value not byte - %O", val); + return HCL_PF_FAILURE; + } + b = HCL_OOP_TO_SMOOI(val); + HCL_OBJ_SET_BYTE_VAL(obj, index, b); + break; + } + + case HCL_OBJ_TYPE_HALFWORD: + { + hcl_oow_t w; + if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; + HCL_OBJ_SET_HALFWORD_VAL(obj, index, w); + break; + } + + case HCL_OBJ_TYPE_WORD: + { + hcl_oow_t w; + if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE; + HCL_OBJ_SET_WORD_VAL(obj, index, w); + break; + } + + default: + goto unindexable; + break; + } - obj->slot[index] = val; HCL_STACK_SETRET (hcl, nargs, val); return HCL_PF_SUCCESS; } -#endif static hcl_pfinfo_t pfinfos[] = { @@ -255,8 +305,8 @@ static hcl_pfinfo_t pfinfos[] = { { 'l','e','n','g','t','h','\0' }, { HCL_PFBASE_FUNC, pf_core_size, 1, 1 } }, /* { { 'n','e','w','\0' }, { HCL_PFBASE_FUNC, pf_core_new, 1, 1 } }, - { { 'p','u','t','\0' }, { HCL_PFBASE_FUNC, pf_core_put, 3, 3 } }, */ + { { 'p','u','t','\0' }, { HCL_PFBASE_FUNC, pf_core_put, 3, 3 } }, { { 's','i','z','e','\0' }, { HCL_PFBASE_FUNC, pf_core_size, 1, 1 } }, { { 's','l','i','c','e','\0' }, { HCL_PFBASE_FUNC, pf_core_slice, 3, 3 } } }; diff --git a/src/kernel.hcl b/src/kernel.hcl index cc9dcb8..32ba77c 100644 --- a/src/kernel.hcl +++ b/src/kernel.hcl @@ -31,6 +31,10 @@ fun Collection:at(index) { return (core.get self index) } +fun Collection:atPut(index value) { + return (core.put self index value) +} + fun Class:name() { return (core.class_name self) } @@ -53,6 +57,32 @@ fun Class:name() { ##} +k := "abcdefghijklmn" printf "string length %d\n" ("aaaa":length) -printf "substring [%s]\n" ("abcdefghijklmn":slice 5 6) -printf "substring [%c]\n" ("abcdefghijklmn":at 14) +printf "substring [%s]\n" (k:slice 5 6) + +try { + printf "substring [%c]\n" (k:at 13) + k:atPut 14 'A' + printf "[%s]\n" k +} catch (e) { + printf "EXCEPTION %O\n" e +} + +k := #[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15] + +try { + k:atPut 2 'A' + printf "%O\n" k +} catch (e) { + printf "EXCEPTION %O\n" e +} + +k := #b[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15] +try { + k:atPut 2 -10 + printf "%O\n" k +} catch (e) { + printf "EXCEPTION %O\n" e +} +