enhanced the MLIST syntax - '(obj:message arg1 arg2)'
Some checks failed
continuous-integration/drone/push Build is failing
Some checks failed
continuous-integration/drone/push Build is failing
This commit is contained in:
parent
caebe2c5a9
commit
c82b56fdf6
42
bin/main.c
42
bin/main.c
@ -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);
|
||||
|
||||
32
lang.txt
32
lang.txt
@ -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??
|
||||
|
||||
|
||||
|
||||
22
lib/hcl.h
22
lib/hcl.h
@ -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
|
||||
);
|
||||
@ -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
|
||||
* ========================================================================= */
|
||||
|
||||
36
lib/read.c
36
lib/read.c
@ -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 }
|
||||
};
|
||||
|
||||
33
lib/xchg.c
33
lib/xchg.c
@ -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;
|
||||
}
|
||||
|
||||
@ -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; };
|
||||
|
||||
@ -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))
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user