enhanced the MLIST syntax - '(obj:message arg1 arg2)'

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_marshalcodetomem(hcl, &hcl->code, &mem);
-	hcl_marshalcode(hcl, &hcl->code, clit_writer, HCL_NULL);
+	hcl_unmarshalcodefrommem(hcl, &xcode, (const hcl_ptl_t*)&mem);
-	xxxpos = 0;
+	hcl_freemem (hcl, mem.ptr);
-	hcl_unmarshalcode(hcl, &xcode, clit_reader, HCL_NULL);
 
 	hcl_decode(hcl, &xcode, 0, xcode.bc.len);
 	hcl_purgecode (hcl, &xcode);

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)
+	(r:Y 10)
-	(printf ">>%d\n" (:X KK 77 99))
+	(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
+	(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
+	(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
+	(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
+	(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-1) 100) ; must be same as (x:t1 100)
-	(:x (get-name-2) 100) ; must be same as (:x t2 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??
 
 

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
  * ========================================================================= */

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 <= 0) return 0; /* not allowed at the list beginning  */
-	if (rstl->count == 1) rstl->flagv |= JSON;
-	else if (!(rstl->flagv & JSON)) return 0;
 
+	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_DCSTAR },   /* class instantiation method */
-	{ ":::",      3, HCL_TOK_TRPCOLONS  },
+	{ ":::",      3, HCL_TOK_TRPCOLONS  }, /* superclass, class variables, class methods */
 
 	{ ";",        1, HCL_TOK_SEMICOLON }
 };

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;
 			}

t/fun-01.hcl

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

t/insta-01.hcl

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