enhanced the MLIST syntax - '(obj:message arg1 arg2)'
Some checks failed
continuous-integration/drone/push Build is failing

This commit is contained in:
hyung-hwan 2024-01-02 01:41:41 +09:00
parent caebe2c5a9
commit c82b56fdf6
7 changed files with 133 additions and 128 deletions

View File

@ -428,39 +428,6 @@ static hcl_oop_t execute_in_interactive_mode (hcl_t* hcl)
return retv;
}
/* for testing... */
static hcl_uint8_t xxxbuf[900000];
static hcl_oow_t xxxlen = 0;
static hcl_oow_t xxxpos = 0;
static int clit_writer(hcl_t* hcl, const void* ptr, hcl_oow_t len, void* ctx)
{
const hcl_uint8_t* p = (const hcl_uint8_t*)ptr;
const hcl_uint8_t* e = p + len;
while (p < e) xxxbuf[xxxlen++] = *p++;
return 0;
}
static int clit_reader(hcl_t* hcl, void* ptr, hcl_oow_t len, void* ctx)
{
hcl_uint8_t* p = (hcl_uint8_t*)ptr;
hcl_uint8_t* e = p + len;
while (p < e)
{
if (xxxpos >= xxxlen)
{
hcl_seterrbfmt (hcl, HCL_ENOENT, "no more data");
return -1;
}
*p++ = xxxbuf[xxxpos++];
}
return 0;
}
/* for testing... */
static hcl_oop_t execute_in_batch_mode(hcl_t* hcl, int verbose)
{
hcl_oop_t retv;
@ -475,13 +442,14 @@ static hcl_oop_t execute_in_batch_mode(hcl_t* hcl, int verbose)
#if 0
{
hcl_code_t xcode;
hcl_ptlc_t mem;
memset (&xcode, 0, HCL_SIZEOF(xcode));
memset (&mem, 0, HCL_SIZEOF(mem));
xxxlen = 0;
hcl_marshalcode(hcl, &hcl->code, clit_writer, HCL_NULL);
xxxpos = 0;
hcl_unmarshalcode(hcl, &xcode, clit_reader, HCL_NULL);
hcl_marshalcodetomem(hcl, &hcl->code, &mem);
hcl_unmarshalcodefrommem(hcl, &xcode, (const hcl_ptl_t*)&mem);
hcl_freemem (hcl, mem.ptr);
hcl_decode(hcl, &xcode, 0, xcode.bc.len);
hcl_purgecode (hcl, &xcode);

View File

@ -8,7 +8,7 @@
for static cleases, super.var-name can be allowed.
for dyna-clases, the super prefix is now allowed for varibles. it's allowed for method calls only.
double-check symbol and dsymbol resolution in set, set-r, defun, defclass to decide how to make it more logical and reasonable
change syntax for MLIST -> currently (: receiver method arguments...) -> can change this to (receiver:method arguments...) or use . or -> instead?
implement module -> ::, ., or what notation?
implement namespace -> ::, ., or what notation?
review the . notation used for C-module loading... may have to change it
@ -18,7 +18,7 @@
u"..." or U"..." for an explicit unicode string constant notation?
make basic branded types to an object if possible.
for example (: #[10 20] at 1)
for example (#[10 20]:at 1)
## dictionary list (DIC)
@ -73,7 +73,7 @@
; instance method. a method name must not collide with instance variable names and class variable names.
; the name can be the same as method names of parent classes.
(defun K (a b)
(:self Y a)
(self:Y a)
(return (+ a b x y))
)
@ -90,20 +90,20 @@
)
(set r (object-new X))
(:r Y 10)
(printf ">>%d\n" (:X KK 77 99))
(r:Y 10)
(printf ">>%d\n" (X:KK 77 99))
## method invocation
send the message aaa to the receiver
(:self aaa)
(self:aaa)
send the message aaa to the receiver but let it resolve the method in the superclass side.
(:super aaa)
(super:aaa)
send the message dump to the object pointed to by x with arguments 1, 2, 3.
(:x dump 1 2 3)
(x:dump 1 2 3)
## method types
@ -125,7 +125,7 @@ send the message dump to the object pointed to by x with arguments 1, 2, 3.
(defclass X ::: P
| x y |
(defun ::* new (a b)
(:super new)
(super:new)
x = a
y = b
(return self)
@ -134,10 +134,10 @@ send the message dump to the object pointed to by x with arguments 1, 2, 3.
(defun get-yy() y)
)
(set t (:X new 10 20)) ;t is an instance of X
(printf "%d %d %d %d\n" (:t get-x) (:t get-y) (:t get-xx) (:t get-yy)) ; must print 1 1 10 20
(:t new 100 300) ;the x, y in the X part get reset to 100 and 300. doesn't create a new instance
(printf "%d %d %d %d\n" (:t get-x) (:t get-y) (:t get-xx) (:t get-yy)) ; must print 1 1 100 300
(set t (X:new 10 20)) ;t is an instance of X
(printf "%d %d %d %d\n" (t:get-x) (t:get-y) (t:get-xx) (t:get-yy)) ; must print 1 1 10 20
(t:new 100 300) ;the x, y in the X part get reset to 100 and 300. doesn't create a new instance
(printf "%d %d %d %d\n" (t:get-x) (t:get-y) (t:get-xx) (t:get-yy)) ; must print 1 1 100 300
- instance method
@ -154,8 +154,8 @@ send the message dump to the object pointed to by x with arguments 1, 2, 3.
(set x (object-new X))
(:x (get-name-1) 100) ; must be same as (:x t1 100)
(:x (get-name-2) 100) ; must be same as (:x t2 100)
(x:(get-name-1) 100) ; must be same as (x:t1 100)
(x:(get-name-2) 100) ; must be same as (x:t2 100)
## Something to look into..
@ -164,7 +164,7 @@ normal function call
(rcv f arg1 arg2)
## dynamic method invocation???
(:X (f) arg1 arg2)
(X:(f) arg1 arg2)
as long as f returns a symbol, it can also invoke a method??

View File

@ -2357,7 +2357,7 @@ HCL_EXPORT int hcl_compile (
);
#endif
int hcl_addliteraltocode (
HCL_EXPORT int hcl_addliteraltocode (
hcl_t* hcl,
hcl_code_t* code,
hcl_oop_t obj,
@ -2365,7 +2365,11 @@ int hcl_addliteraltocode (
hcl_oow_t* index
);
int hcl_brewcode (
/**
* The hcl_brewcode() initializes the structure pointed to by \a code.partially or entirely.
* The part already initialized is not destroyed and/or reinitialized.
*/
HCL_EXPORT int hcl_brewcode (
hcl_t* hcl,
hcl_code_t* code
);
@ -2468,24 +2472,24 @@ HCL_EXPORT void hcl_popvolats (
* SYSTEM MEMORY MANAGEMENT FUCNTIONS VIA MMGR
* ========================================================================= */
HCL_EXPORT void* hcl_allocmem (
hcl_t* hcl,
hcl_t* hcl,
hcl_oow_t size
);
HCL_EXPORT void* hcl_callocmem (
hcl_t* hcl,
hcl_t* hcl,
hcl_oow_t size
);
HCL_EXPORT void* hcl_reallocmem (
hcl_t* hcl,
void* ptr,
hcl_t* hcl,
void* ptr,
hcl_oow_t size
);
HCL_EXPORT void hcl_freemem (
hcl_t* hcl,
void* ptr
void* ptr
);
@ -2815,13 +2819,25 @@ HCL_EXPORT int hcl_marshalcode (
void* ctx
);
int hcl_unmarshalcode (
HCL_EXPORT int hcl_unmarshalcode (
hcl_t* hcl,
hcl_code_t* code,
hcl_xchg_reader_t rdr,
void* ctx
);
HCL_EXPORT int hcl_marshalcodetomem (
hcl_t* hcl,
const hcl_code_t* code,
hcl_ptlc_t* dst
);
HCL_EXPORT int hcl_unmarshalcodefrommem (
hcl_t* hcl,
hcl_code_t* code,
const hcl_ptl_t* src
);
/* =========================================================================
* DICTIONARY ACCESS FUNCTIONS
* ========================================================================= */

View File

@ -565,8 +565,10 @@ static HCL_INLINE int can_comma_list (hcl_t* hcl)
rstl = hcl->c->r.st;
if (rstl->count <= 0) return 0;
if (rstl->count == 1) rstl->flagv |= JSON;
else if (!(rstl->flagv & JSON)) return 0;
if (rstl->flagv & (COMMAED | COLONED)) return 0;
if (LIST_FLAG_GET_CONCODE(rstl->flagv) == HCL_CONCODE_DIC)
@ -586,21 +588,35 @@ static HCL_INLINE int can_comma_list (hcl_t* hcl)
static HCL_INLINE int can_colon_list (hcl_t* hcl)
{
hcl_rstl_t* rstl;
hcl_concode_t cc;
HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
/* mark the state that a colon has appeared in the list */
if (rstl->count <= 0) return 0;
if (rstl->count == 1) rstl->flagv |= JSON;
else if (!(rstl->flagv & JSON)) return 0;
if (rstl->count <= 0) return 0; /* not allowed at the list beginning */
if (rstl->count == 1) rstl->flagv |= JSON; /* mark that the first key is colon-delimited */
else if (!(rstl->flagv & JSON)) return 0; /* the first key is not colon-delimited. so not allowed to colon-delimit other keys */
/* multiple single-colons - e.g. #{ "abc": : 20 } */
if (rstl->flagv & (COMMAED | COLONED)) return 0;
if (LIST_FLAG_GET_CONCODE(rstl->flagv) != HCL_CONCODE_DIC) return 0;
cc = LIST_FLAG_GET_CONCODE(rstl->flagv);
if (!(rstl->count & 1)) return 0;
if (cc == HCL_CONCODE_XLIST)
{
if (rstl->count > 1) return 0;
/* ugly dual use of a colon sign. switch to MLIST if the first element
* is delimited by a colon. e.g. (obj:new 10 20 30) */
LIST_FLAG_SET_CONCODE(rstl->flagv, HCL_CONCODE_MLIST);
rstl->flagv &= ~JSON;
}
else if (cc != HCL_CONCODE_DIC) return 0; /* no allowed if not in a dictionary */
if (!(rstl->count & 1)) return 0; /* not allwed after the value in a dictionary */
/* mark that it's coloned. this is to be cleared when clear_comma_colon_flag() is called */
rstl->flagv |= COLONED;
return 1;
}
@ -1075,7 +1091,7 @@ static int feed_process_token (hcl_t* hcl)
}
concode = LIST_FLAG_GET_CONCODE(rstl->flagv);
if (concode != HCL_CONCODE_XLIST) /* TODO: handle MLIST as well if the other part is implemented */
if (concode != HCL_CONCODE_XLIST && concode != HCL_CONCODE_MLIST)
{
hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
goto oops;
@ -1422,12 +1438,12 @@ static delim_token_t delim_token_tab[] =
{ ".", 1, HCL_TOK_DOT },
{ "..", 2, HCL_TOK_DBLDOTS },
{ "...", 3, HCL_TOK_ELLIPSIS },
{ "...", 3, HCL_TOK_ELLIPSIS }, /* for variable arguments */
{ ":", 1, HCL_TOK_COLON },
{ ":", 1, HCL_TOK_COLON }, /* key-value separator in dictionary */
{ "::", 2, HCL_TOK_DBLCOLONS },
{ "::*", 3, HCL_TOK_DCSTAR },
{ ":::", 3, HCL_TOK_TRPCOLONS },
{ "::*", 3, HCL_TOK_DCSTAR }, /* class instantiation method */
{ ":::", 3, HCL_TOK_TRPCOLONS }, /* superclass, class variables, class methods */
{ ";", 1, HCL_TOK_SEMICOLON }
};

View File

@ -45,6 +45,7 @@ enum hcl_xchg_type_t
HCL_XCHG_STRING_B,
HCL_XCHG_SYMBOL_U, /* contained in a cons cell */
HCL_XCHG_SYMBOL_B, /* contained in a cons cell */
HCL_XCHG_SMOOI,
HCL_XCHG_PBIGINT,
HCL_XCHG_NBIGINT,
HCL_XCHG_FPDEC_1, /* smooi + smooi */
@ -87,6 +88,15 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
for (i = lfbase; i < code->lit.len; i++)
{
tmp = ((hcl_oop_oop_t)code->lit.arr)->slot[i];
if (HCL_OOP_IS_SMOOI(tmp))
{
b = HCL_XCHG_SMOOI;
if (wrtr(hcl, &b, HCL_SIZEOF(b), ctx) <= -1) goto oops;
w = hcl_htoleoow((hcl_oow_t)HCL_OOP_TO_SMOOI(tmp));
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
continue;
}
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp);
@ -193,7 +203,6 @@ int hcl_marshalcode (hcl_t* hcl, const hcl_code_t* code, hcl_xchg_writer_t wrtr,
ucslen = tsize;
if (hcl_convutobchars(hcl, ucsptr, &ucslen, HCL_NULL, &bcslen) <= -1) goto oops;
HCL_DEBUG2(hcl, "WRITIGN nbytes %d nchars %d\n", (int)tsize, (int)bcslen);
/* write the number of characters in the little endian */
w = hcl_htoleoow(tsize);
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
@ -296,7 +305,6 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
}
if (b == HCL_XCHG_END) break;
HCL_DEBUG1(hcl, "bbbbbbbbbbb=>%d\n", b);
switch (b)
{
@ -359,18 +367,15 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
goto oops;
}
nbytes = hcl_leoowtoh(w);
HCL_DEBUG2(hcl, "nchars %d nbytes %d\n", (int)nchars, (int)nbytes);
ns = hcl_makestring(hcl, HCL_NULL, nchars, 0);
if (HCL_UNLIKELY(!ns)) goto oops;
HCL_DEBUG2(hcl, "222 nchars %d nbytes %d\n", (int)nchars, (int)nbytes);
ucspos = 0;
bcsres = 0;
while (nbytes > 0)
{
bcslen = nbytes <= HCL_SIZEOF(bcsbuf)? nbytes : HCL_SIZEOF(bcsbuf);
HCL_DEBUG4(hcl, "333 nchars %d nbytes %d bcsres %d bcslen - bcsres %d\n", (int)nchars, (int)nbytes, (int)bcsres, (int)bcslen - bcsres);
n = rdr(hcl, &bcsbuf[bcsres], bcslen - bcsres, ctx);
if (n <= -1)
{
@ -381,10 +386,8 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
HCL_ASSERT(hcl, ucspos < nchars);
bcsres = bcslen;
ucslen = nchars - ucspos;
HCL_DEBUG4(hcl, "333 nchars %d nbytes %d bcslen %d ucslen %d\n", (int)nchars, (int)nbytes, (int)bcslen, (int)ucslen);
if (hcl_convbtouchars(hcl, bcsbuf, &bcslen, HCL_OBJ_GET_CHAR_PTR(ns, ucspos), &ucslen) <= -1 && bcslen <= 0)
{
HCL_DEBUG0(hcl, "EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE\n");
goto oops;
}
@ -392,12 +395,10 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
nbytes -= bcslen;
bcsres -= bcslen;
if (bcsres > 0) HCL_MEMMOVE(bcsbuf, &bcsbuf[bcslen], bcsres);
HCL_DEBUG3(hcl, "444 nchars %d nbytes %d bcslen %d\n", (int)nchars, (int)nbytes, (int)bcslen);
}
HCL_ASSERT(hcl, ucspos == nchars);
HCL_DEBUG1(hcl, "RESTORED=>[[%js]]\n", HCL_OBJ_GET_CHAR_SLOT(ns));
if (b == HCL_XCHG_SYMBOL_U)
{
/* form a cons cell */
@ -417,6 +418,15 @@ HCL_DEBUG1(hcl, "RESTORED=>[[%js]]\n", HCL_OBJ_GET_CHAR_SLOT(ns));
/* TODO */
break;
case HCL_XCHG_SMOOI:
{
hcl_oop_t ns;
if (rdr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
w = hcl_leoowtoh(w);
ns = HCL_SMOOI_TO_OOP((hcl_ooi_t)w);
if (hcl_addliteraltocode(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
break;
}
case HCL_XCHG_PBIGINT:
case HCL_XCHG_NBIGINT:
@ -446,7 +456,6 @@ HCL_DEBUG1(hcl, "RESTORED=>[[%js]]\n", HCL_OBJ_GET_CHAR_SLOT(ns));
HCL_OBJ_SET_LIWORD_VAL(ns, j, liw);
}
HCL_DEBUG1(hcl, "RESTORED BIGINT... [%O]\n", ns);
if (hcl_addliteraltocode(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
break;
}
@ -467,7 +476,6 @@ HCL_DEBUG1(hcl, "RESTORED BIGINT... [%O]\n", ns);
}
scale = (hcl_ooi_t)hcl_leoowtoh(w);
HCL_DEBUG1(hcl, "RESTORED scale... [%O]\n", HCL_SMOOI_TO_OOP(scale));
if (b == HCL_XCHG_FPDEC_1)
{
hcl_ooi_t value;
@ -497,7 +505,6 @@ HCL_DEBUG1(hcl, "RESTORED scale... [%O]\n", HCL_SMOOI_TO_OOP(scale));
if (nbytes % HCL_SIZEOF(hcl_liw_t)) goto oops; /* not the right number of bytes */
nwords = nbytes / HCL_SIZEOF(hcl_liw_t);
HCL_DEBUG1(hcl, "FPDEC NWORD %d\n", (int)nwords);
v = hcl_makebigint(hcl, ((b == HCL_XCHG_FPDEC_2) ? HCL_BRAND_PBIGINT : HCL_BRAND_NBIGINT), HCL_NULL, nwords);
if (HCL_UNLIKELY(!v)) goto oops;
@ -508,13 +515,11 @@ HCL_DEBUG1(hcl, "FPDEC NWORD %d\n", (int)nwords);
liw = hcl_leliwtoh(liw);
HCL_OBJ_SET_LIWORD_VAL(v, j, liw);
}
HCL_DEBUG1(hcl, "RESTORED v... [%O]\n", v);
hcl_pushvolat (hcl, &v);
ns = hcl_makefpdec(hcl, v, scale);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!ns)) goto oops;
}
HCL_DEBUG1(hcl, "RESTORED FPDEC... [%O]\n", ns);
if (hcl_addliteraltocode(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
break;
}

View File

@ -40,7 +40,7 @@ defclass A
##defun get-c() c;
};
set k (:A newInstance 11 22 33);
set v (:k get-a);
set k (A:newInstance 11 22 33);
set v (k:get-a);
if (= v 11) { printf "OK - %d\n" v; }
else { printf "ERROR - %d\n" v; };

View File

@ -1,53 +1,53 @@
## test class instantiation methods
(defclass A
| a b c |
defclass A | a b c | {
(defun ::* newInstance(x y z)
(set a x)
(set b y)
(set c z)
(return self)
)
defun ::* newInstance(x y z) {
set a x;
set b y;
set c z;
return self;
};
(defun get-a() a)
(defun get-b() b)
(defun get-c() c)
)
defun get-a() { return self.a; };
defun get-b() { return self.b; };
defun get-c() { return self.c; };
};
(defclass B ::: A
| d e f |
defclass B ::: A | d e f | {
(defun ::* newInstance(x y z)
(:super newInstance (* x 2) (* y 2) (* z 2))
(set d x)
(set e y)
(set f z)
(return self)
)
defun ::* newInstance(x y z) {
super:newInstance (* x 2) (* y 2) (* z 2);
set d x;
set e y;
set f z;
return self;
};
(defun sum()
(+ (:super get-a) (:super get-b) (:super get-c) d e f)
)
defun sum() {
return (+ (super:get-a) (super:get-b) (super:get-c) self.d self.e self.f);
};
};
)
set a ((B:newInstance 1 2 3):sum);
if (/= a 18) { printf "ERROR: a must be 18\n"; }
else { printf "OK %d\n" a; };
(set a (:(:B newInstance 1 2 3) sum))
(if (/= a 18) (printf "ERROR: a must be 18\n"))
(printf "OK %d\n" a)
set b (B:newInstance 2 3 4);
set a (b:get-a);
(if (/= a 4) (printf "ERROR: a must be 4\n")
else (printf "OK %d\n" a))
(set b (:B newInstance 2 3 4))
(set a (:b get-a))
(if (/= a 4) (printf "ERROR: a must be 4\n"))
(printf "OK %d\n" a)
(set a (:b get-b))
(if (/= a 6) (printf "ERROR: a must be 6\n"))
(printf "OK %d\n" a)
(set a (:b get-c))
(if (/= a 8) (printf "ERROR: a must be 8\n"))
(printf "OK %d\n" a)
(set a (:b sum))
(if (/= a 27) (printf "ERROR: a must be 27\n"))
(printf "OK %d\n" a)
set a (b:get-b);
(if (/= a 6) (printf "ERROR: a must be 6\n")
else (printf "OK %d\n" a))
set a (b:get-c);
(if (/= a 8) (printf "ERROR: a must be 8\n")
else (printf "OK %d\n" a))
set a (b:sum);
(if (/= a 27) (printf "ERROR: a must be 27\n")
else (printf "OK %d\n" a))