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

added respondsTo and related functions
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-08-08 01:52:50 +09:00
parent 433744c33a
commit 5ddc29dc5b
5 changed files with 178 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
lib/exec.c
View File

@ -2266,6 +2266,32 @@ static hcl_oop_block_t find_cmethod_noseterr (hcl_t* hcl, hcl_oop_class_t _class
return find_imethod_in_class_noseterr(hcl, (hcl_oop_class_t)HCL_CLASSOF(hcl, _class), &name, ivaroff, owner);
}
int hcl_class_responds_to (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg)
{
hcl_oop_block_t mth_blk;
hcl_oop_class_t owner;
hcl_ooi_t ivaroff;
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv));
mth_blk = find_cmethod_noseterr(hcl, (hcl_oop_class_t)rcv, msg, 0, &ivaroff, &owner);
return mth_blk != HCL_NULL;
}
int hcl_inst_responds_to (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg)
{
hcl_oop_block_t mth_blk;
hcl_oop_class_t _class, owner;
hcl_ooi_t ivaroff;
_class = (hcl_oop_class_t)HCL_CLASSOF(hcl, rcv);
HCL_ASSERT (hcl, _class != HCL_NULL);
HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, _class));
mth_blk = find_imethod_noseterr(hcl, _class, msg, 0, &ivaroff, &owner);
return mth_blk != HCL_NULL;
}
static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, int to_super, hcl_ooi_t nargs, hcl_ooi_t nrvars)
{
hcl_oop_block_t mth_blk;

3
lib/hcl-prv.h
View File

@ -1992,6 +1992,9 @@ int hcl_is_binop_char (hcl_ooci_t c);
/* ========================================================================= */
/* exec.c */
/* ========================================================================= */
int hcl_class_responds_to (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg);
int hcl_inst_responds_to (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg);
hcl_pfrc_t hcl_pf_process_current (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);
hcl_pfrc_t hcl_pf_process_resume (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs);

7
lib/read.c
View File

@ -2239,6 +2239,7 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c)
* #b[ ] byte array
* #( ) qlist
* #{ } dictionary
* #"..." symbol literal
*/
switch (c)
@ -2302,6 +2303,12 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c)
FEED_WRAP_UP_WITH_CHAR (hcl, c, HCL_TOK_DLPAREN);
goto consumed;
#if 0
case '"': /* #" */
FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_TOK_HMARKED_SYMBOL); /* symbol lieral */
goto consumed;
#endif
/* --------------------------- */
default:
/* the character used as case values above can never be the first character of a hash-marked identifier */

55
mod/core.c
View File

@ -26,6 +26,7 @@
#include "_core.h"
#include "../lib/hcl-prv.h"
static hcl_pfrc_t pf_core_basic_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
@ -53,7 +54,7 @@ static hcl_pfrc_t pf_core_basic_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs
return HCL_PF_FAILURE;
}
inst = hcl_instantiate(hcl, obj, HCL_NULL, nsize);
inst = hcl_instantiate(hcl, (hcl_oop_class_t)obj, HCL_NULL, nsize);
if (HCL_UNLIKELY(!inst)) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, inst);
@ -69,7 +70,7 @@ static hcl_pfrc_t pf_core_get_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t
if (!HCL_IS_CLASS(hcl, obj))
{
#if 0
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a class - %O", obj);
hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not class - %O", obj);
return HCL_PF_FAILURE;
#else
obj = (hcl_oop_t)HCL_CLASSOF(hcl, obj);
@ -81,22 +82,48 @@ static hcl_pfrc_t pf_core_get_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t
return HCL_PF_SUCCESS;
}
#if 0
static hcl_pfrc_t pf_arr_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static hcl_pfrc_t pf_core_cresp_to (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t sz, arr;
hcl_oow_t size;
hcl_oop_t obj;
hcl_oop_t msg;
int x;
sz = (hcl_oop_t)HCL_STACK_GETARG(hcl, nargs, 0);
if (hcl_inttooow(hcl, sz, &size) == 0) return HCL_PF_FAILURE;
obj = HCL_STACK_GETARG(hcl, nargs, 0);
msg = HCL_STACK_GETARG(hcl, nargs, 1);
if (!HCL_IS_CLASS(hcl, obj))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not class - %O", msg);
return HCL_PF_FAILURE;
}
if (!HCL_OBJ_IS_CHAR_POINTER(msg))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid message - %O", msg);
return HCL_PF_FAILURE;
}
arr = hcl_makearray(hcl, size, 0);
if (HCL_UNLIKELY(!arr)) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, arr);
x = hcl_class_responds_to(hcl, obj, msg);
HCL_STACK_SETRET (hcl, nargs, (x? hcl->_true: hcl->_false));
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_core_iresp_to (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t obj;
hcl_oop_t msg;
int x;
obj = HCL_STACK_GETARG(hcl, nargs, 0);
msg = HCL_STACK_GETARG(hcl, nargs, 1);
if (!HCL_OBJ_IS_CHAR_POINTER(msg))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid message - %O", msg);
return HCL_PF_FAILURE;
}
x = hcl_inst_responds_to(hcl, obj, msg);
HCL_STACK_SETRET (hcl, nargs, (x? hcl->_true: hcl->_false));
return HCL_PF_SUCCESS;
}
#endif
static hcl_pfrc_t pf_core_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
@ -352,7 +379,9 @@ static hcl_pfinfo_t pfinfos[] =
{
{ { 'b','a','s','i','c','_','n','e','w','\0' }, { HCL_PFBASE_FUNC, pf_core_basic_new, 2, 2 } },
{ { 'c','l','a','s','s','_','n','a','m','e','\0' }, { HCL_PFBASE_FUNC, pf_core_get_class_name, 1, 1 } },
{ { 'c','r','e','s','p','_','t','o', '\0' }, { HCL_PFBASE_FUNC, pf_core_cresp_to, 2, 2 } },
{ { 'g','e','t','\0' }, { HCL_PFBASE_FUNC, pf_core_get, 2, 2 } },
{ { 'i','r','e','s','p','_','t','o', '\0' }, { HCL_PFBASE_FUNC, pf_core_iresp_to, 2, 2 } },
{ { 'l','e','n','g','t','h','\0' }, { HCL_PFBASE_FUNC, pf_core_size, 1, 1 } },
{ { '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 } },

125
src/kernel.hcl
View File

@ -1,66 +1,104 @@
class Apex {
fun :: basicNew(size) {
fun ::basicNew(size) {
return (core.basic_new self size)
}
fun ::respondsTo(mth) {
return (core.cresp_to self mth)
}
fun respondsTo(mth) {
return (core.iresp_to self mth)
}
fun basicAt(pos) {
return (core.get self index)
}
fun basicAtPut(index value) {
return (core.put self index value)
}
}
class Object :: Apex {
}
class Collection :: Object {
}
class Class :: Apex [
_name
_mdic
_spec
_selfspec
_superclass
_nivars_super
_ibrand
_ivarnames
_cvarnames
] {
fun name() {
##return (core.class_name self)
return _class
}
class IndexedCollection :: Collection {
}
fun instanceVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _ivarnames
}
class FixedSizedCollection :: IndexedCollection {
}
class Array :: FixedSizedCollection {
fun :: new(size) {
return (core.basic_new self size)
fun classVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _cvarnames
}
}
class String :: FixedSizedCollection {
}
fun Collection:length() {
class Collection :: Object {
fun length() {
return (core.length self)
}
}
fun Collection:slice(index count) {
class IndexedCollection :: Collection {
fun slice(index count) {
return (core.slice self index count)
}
}
fun Collection:at(index) {
fun at(index) {
return (core.get self index)
}
}
fun Collection:atPut(index value) {
fun atPut(index value) {
return (core.put self index value)
}
}
fun Class:name() {
return (core.class_name self)
class FixedSizedCollection :: IndexedCollection {
fun ::new(size) {
| obj iv |
obj := (core.basic_new self size)
if (self:respondsTo "initValue") { ## TODO: change "initValue" to a symbol once supported
i := 0
iv := (self:initValue)
while (i < size) {
core.put obj i iv
i := (i + 1)
}
}
return obj
}
##fun ::initValue() {
## return nil
##}
}
##class String:: Array [a b c] {
##}
class Array :: FixedSizedCollection {
}
##class String:: Array [
## monaco
## duncan
## falcon
## deuce
## canival
## pebble
## godzilla
##] {
## fun Collection:slice(index count) {
## return (arr.slice self index count)
## }
##}
class String :: FixedSizedCollection {
fun ::initValue() {
##return '\0'
return ' '
}
}
k := "abcdefghijklmn"
@ -96,3 +134,16 @@ try {
k := (Array:new 10)
k:atPut 3 "hello"
printf "%O\n" k
printf "[%O]\n" (String:new 5)
printf "[%O]\n" (String:basicNew 5)
printf "[%O]\n" (String:respondsTo "new")
printf "[%O]\n" (String:respondsTo "newx")
printf "[%O]\n" (" ":respondsTo "new")
printf "[%O]\n" (" ":respondsTo "length")
##printf "[%O]\n" (String:classVariableNames)
##printf "[%O]\n" (String:instanceVariableNames)
printf "%O\n" #"abcdefg"