enhanced the reader and compiler to treat the binop expression like a message-send expression

lib/comp.c

@@ -4054,11 +4054,11 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 			goto done;
 
 		case HCL_CNODE_ELIF:
-			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "else without if");
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "elif without if");
 			return -1;
 
 		case HCL_CNODE_ELSE:
-			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "elif without if");
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "else without if");
 			return -1;
 
 		case HCL_CNODE_THROW:
@@ -4215,6 +4215,7 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 	else if (HCL_CNODE_IS_SYMBOL(car)  || HCL_CNODE_IS_DSYMBOL(car) ||
 	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST) ||
 	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_MLIST) ||
+	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_BLIST) ||
 	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_ALIST))
 	{
 		/* normal function call
@@ -4319,8 +4320,11 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 
 	/* message sending
 	 *  (:<receiver> <operator> <operand1> ...)
+	 *  (<receiver>:<operator> <operand1> ...)
+	 *  (<receiver> <binop> <operand>
 	 */
-	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
+	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_BLIST) ||
+	                 HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
 
 	car = HCL_CNODE_CONS_CAR(obj);
 	if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
@@ -4914,7 +4918,8 @@ redo:
 					if (compile_cons_xlist_expression(hcl, oprnd, 0) <= -1) return -1;
 					break;
 
-				case HCL_CONCODE_MLIST:
+				case HCL_CONCODE_BLIST: /* message send with binop */
+				case HCL_CONCODE_MLIST: /* message send expression */
 					if (compile_cons_mlist_expression(hcl, oprnd, 0) <= -1) return -1;
 					break;
 
@@ -4969,6 +4974,11 @@ redo:
 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty executable list");
 					return -1;
 
+				case HCL_CONCODE_BLIST:
+					/* this must not happend as the reader prevents it */
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty binop list");
+					return -1;
+
 				case HCL_CONCODE_MLIST:
 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty message send list");
 					return -1;
@@ -5057,22 +5067,31 @@ static int compile_object_r (hcl_t* hcl)
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
         oprnd = cf->operand;
-	if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_XLIST))
+	if (HCL_CNODE_IS_CONS(oprnd))
 	{
-		return compile_cons_xlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
+		hcl_concode_t cc;
-	}
-	else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_MLIST))
-	{
-		return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
-	}
 
-	/*
+		cc = HCL_CNODE_CONS_CONCODE(oprnd);
-	else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_ALIST))
+
+		switch (cc)
 		{
-		ALIST is transformed to XLIST with or set or set-r by the reader.
+			case HCL_CONCODE_XLIST:
-		so it must not appear here..
+				return compile_cons_xlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
+
+			case HCL_CONCODE_BLIST:
+			case HCL_CONCODE_MLIST:
+				return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
+
+#if 0
+			case HCL_CONCODE_ALIST:
+				/* TODO: can support it? */
+				k := ([a, b, c] := (+ 10 20 30))
+				break;
+#endif
+			default:
+				break;
+		}
 	}
-	*/
 
 	hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "non-function call/non-message send disallowed");
 	return -1;

lib/exec.c

@@ -2382,7 +2382,7 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
 			hcl_loc_t loc;
 
 			dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
-			HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu- %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
+			HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu - %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
 			HCL_MEMSET (&loc, 0, HCL_SIZEOF(loc));
 			loc.file = dbgi[ip].fname;
 			loc.line = dbgi[ip].sline;

lib/prim.c

@@ -1280,7 +1280,8 @@ static pf_t builtin_prims[] =
 	{ 2, 2,                       pf_number_lt,       1,  { '<' } },
 	{ 2, 2,                       pf_number_le,       2,  { '<','=' } },
 	{ 2, 2,                       pf_number_eq,       1,  { '=' } },
-	{ 2, 2,                       pf_number_ne,       2,  { '/','=' } },
+	{ 2, 2,                       pf_number_eq,       2,  { '=', '=' } },
+	{ 2, 2,                       pf_number_ne,       2,  { '~','=' } },
 
 	/* bitwise operations are supported for integers only */
 	{ 2, 2,                       pf_integer_band,    7,  { 'b','i','t','-','a','n','d' } },

lib/print.c

@@ -841,6 +841,10 @@ void hcl_dumpcnode (hcl_t* hcl, hcl_cnode_t* cnode, int newline)
 					case HCL_CONCODE_ALIST:
 						hcl_logbfmt (hcl, HCL_LOG_FATAL, " := ");
 						break;
+					case HCL_CONCODE_BLIST:
+					case HCL_CONCODE_MLIST:
+						hcl_logbfmt (hcl, HCL_LOG_FATAL, ":");
+						break;
 				}
 
 				hcl_dumpcnode (hcl, HCL_CNODE_CONS_CDR(cnode),0);

lib/read.c

@@ -203,6 +203,7 @@ static struct
 
 static int init_compiler (hcl_t* hcl);
 static void feed_continue (hcl_t* hcl, hcl_flx_state_t state);
+static int is_at_block_beginning (hcl_t* hcl);
 
 /* ----------------------------------------------------------------- */
 
@@ -762,8 +763,16 @@ but the check isn't complemete if more operands are added without an operator e.
 				goto oops;
 			}
 
-#define TRANSFORM_BLIST
 		#if defined(TRANSFORM_BLIST)
+			/* this part is to transform (x binop y) to (binop x y).
+			 * if transformation is done, it is a normal executable expression
+			 * where the binary operator is a primitive function.
+			 *
+			 * alternatively, the compiler treat this as a message send expression
+			 * if the reader skips this transformation.
+			 *
+			 * We keep this part commented out to have this trated as a message
+			 * send expression. */
 			HCL_CNODE_CONS_CDR(head) = HCL_CNODE_CONS_CDR(binop);
 			HCL_CNODE_CONS_CDR(binop) = head;
 			head = binop;
@@ -928,14 +937,33 @@ static HCL_INLINE int can_binop_list (hcl_t* hcl)
 	rstl = hcl->c->r.st;
 	cc = (hcl_concode_t)LIST_FLAG_GET_CONCODE(rstl->flagv);
 
-	if (rstl->count <= 0 || cc == HCL_CONCODE_TUPLE)
+	if (rstl->count <= 0 || cc == HCL_CONCODE_TUPLE || is_at_block_beginning(hcl))
 	{
 		/* allowed but it must be treated like a normal identifier.
 		 * in case of the tuple, chain_to_list() rejects binop symbols.
-		 * so let this routine to allow it as a normal indentifier. */
+		 * so let this routine to allow it as a normal indentifier.
+		 *
+		 * when the expression is inside a block enclosed in {},
+		 * rstl->count is the number of preceding expression.
+		 * call is_at_block_begigging() separately to check if it is
+		 * at the beging of the sub-expression. For example,
+		 *  { a := 10; b := 20; + a b }
+		 * when this function is called for '+' above, rstl->count is 2.
+		 */
 		return 1;
 	}
 
+	if (rstl->count >= 1 && cc == HCL_CONCODE_XLIST)
+	{
+		/* special case:
+		 *   fun xxx::+() { }
+		 *   fun + () {}
+		 */
+
+		/* TODO: this whole block is hacky. we may do proper parsing instead of checking the first element is 'fun' */
+		if (HCL_CNODE_IS_TYPED(HCL_CNODE_CONS_CAR(rstl->head), HCL_CNODE_FUN)) return 1;
+	}
+
 	/* repeated delimiters - e.g (a ++ ++ ...)   (a : := ... )  */
 	if (rstl->flagv & (COMMAED | COLONED | COLONEQED | BINOPED)) return 0;
 
@@ -962,15 +990,12 @@ static HCL_INLINE int can_binop_list (hcl_t* hcl)
 		fake_tok.len = vocas[VOCA_BLIST].len;
 		fake_tok_ptr = &fake_tok;
 
-hcl_logbfmt(hcl, HCL_LOG_STDERR, "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxx\n");
+		/* dirty hack to create a wrapper cell containing the first three items.
-if (rstl->head) hcl_dumpcnode(hcl,  rstl->head, 1);
+		 * TODO: do i have to do this on the caller side of can_binop_list()? */
-else hcl_logbfmt(hcl, HCL_LOG_STDERR, "rstl->head is null\n");
-if (rstl->tail) hcl_dumpcnode(hcl,  rstl->tail, 1);
-else hcl_logbfmt(hcl, HCL_LOG_STDERR, "rstl->tail is null\n");
-
 		HCL_ASSERT (hcl, HCL_CNODE_IS_TYPED(rstl->head, HCL_CNODE_CONS));
-		wrap = hcl_makecnodecons(hcl, 0, HCL_CNODE_GET_LOC(rstl->head), fake_tok_ptr, rstl->head, rstl->head->u.cons.cdr);
+		wrap = hcl_makecnodecons(hcl, 0, HCL_CNODE_GET_LOC(rstl->head), fake_tok_ptr, rstl->head, HCL_NULL);
 		if (HCL_UNLIKELY(!wrap)) return  -1;
+		HCL_CNODE_CONS_CONCODE(rstl->head) = HCL_CONCODE_BLIST;
 
 		rstl->head = wrap;
 		rstl->tail = wrap;
@@ -1279,7 +1304,7 @@ static void feed_clean_up_reader_stack (hcl_t* hcl)
 	}
 }
 
-static HCL_INLINE int is_at_block_beginning (hcl_t* hcl)
+static int is_at_block_beginning (hcl_t* hcl)
 {
 	hcl_rstl_t* rstl;
 	rstl = hcl->c->r.st;

t/class-5001.err

@@ -17,7 +17,7 @@ class B + ##ERROR: syntax error - prohibited binary operator - +
 
 J := 11
 class B {
-	if (J = 10) {
+	if (== J 10) {
 		defun :*newA() {
 			return self
 		}

t/feed-01.hcl

@@ -50,7 +50,7 @@ if (eqv? J 1296) {
 
 
 k := 5
-if { q := 10; k < q } {  ## a block expression is a normal expression. so t can be used as a conditional expression for if
+if { q := 10; < k q } {  ## a block expression is a normal expression. so it can be used as a conditional expression for if
 	printf "OK: k is less than q\n"
 } else (printf "BAD: k is not less than q\n")
 

t/feed-5001.err

@@ -10,13 +10,6 @@ x := (10 +); ##ERROR: syntax error - no operand after binary operator
 
 ---
 
-##
-
-x := (10 + 20 * 4); ##ERROR: syntax error - prohibited binary operator
-
----
-
-
 ## you can't have another colon before the method..
 (obj: :method) ##ERROR: syntax error - : disallowed
 

t/fun-01.hcl

@@ -6,7 +6,7 @@ defun aaa(a b) {
 
 set k (aaa 10 20);
 
-if (= k 30) {
+if (== k 30) {
 	printf "OK - %d\n" k;
 } else {
 	printf "ERROR - %d\n" k;
@@ -30,7 +30,7 @@ defun mkfun2(t) {
 
 f := (mkfun 20);
 set k (f 50);
-if (k = 70) {
+if (== k 70) {
 	printf "OK - %d\n" k;
 } else {
 	printf "ERROR - %d\n" k;
@@ -39,7 +39,7 @@ if (k = 70) {
 k := {
 	(mkfun 20) 30
 }
-if (k = 50) {
+if (== k 50) {
 	printf "OK - %d\n" k
 } else {
 	printf "ERROR - %d\n" k
@@ -49,14 +49,14 @@ k := {
 	(mkfun 20) 30 ## the return value of this expression is ignored
 	(mkfun 20) 40 ## the return value of this expression is the return value of the block expression
 }
-if (k = 60) {
+if (== k 60) {
 	printf "OK - %d\n" k
 } else {
 	printf "ERROR - %d\n" k
 };
 
 k := (((mkfun2 10) 40) 30)
-if (k = 80) {
+if (== k 80) {
 	printf "OK - %d\n" k
 } else {
 	printf "ERROR - %d\n" k
@@ -64,31 +64,31 @@ if (k = 80) {
 ## --------------------------------------
 
 ## multiple return values
-defun f(a :: b c) { b := (a + 10); c := (a + 20) }
+defun f(a :: b c) { b := (+ a 10); c := (+ a 20) }
 [x, y] := (f 9)
-if (x = 19) {
+if (== x 19) {
 	printf "OK - %d\n" x
 } else {
 	printf "ERROR - %d\n" x
 }
-if (y = 29) {
+if (== y 29) {
 	printf "OK - %d\n" y
 } else {
 	printf "ERROR - %d\n" y
 }
 
 ## --------------------------------------
-k := (defun qq(t) (t + 20))
+k := (defun qq(t) (+ t 20))
 x := (k 8)
 y := (qq 9)
 
-if (x = 28) {
+if (== x 28) {
 	printf "OK - %d\n" x
 } else {
 	printf "ERROR - %d\n" x
 }
 
-if (x = 29) {
+if (== y 29) {
 	printf "OK - %d\n" x
 } else {
 	printf "ERROR - %d\n" x
@@ -113,7 +113,7 @@ k := (A:newInstance 11 22 33);
 ##set k (A:newInstance 11 22 33);
 
 set v (k:get-a);
-if (= v 11) {
+if (== v 11) {
 	printf "OK - %d\n" v;
 } else {
 	printf "ERROR - %d\n" v;

t/insta-01.hcl

@@ -1,5 +1,16 @@
 ## test class instantiation methods
 
+fun Number: + (oprnd) { return (+ self oprnd) }
+fun Number: - (oprnd) { return (- self oprnd) }
+fun Number: * (oprnd) { return (* self oprnd) }
+fun Number: / (oprnd) { return (/ self oprnd) }
+fun Number: > (oprnd) { return (> self oprnd) }
+fun Number: < (oprnd) { return (< self oprnd) }
+fun Number: >= (oprnd) { return (>= self oprnd) }
+fun Number: <= (oprnd) { return (<= self oprnd) }
+fun Number: == (oprnd) { return (== self oprnd) }
+fun Number: ~= (oprnd) { return (~= self oprnd) }
+
 class A [ a b c ]  {
 
 	defun :*newInstance(x y z) {
@@ -34,24 +45,24 @@ class B :: A [ d e f ] {
 };
 
 a := ((B:newInstance 1 2 3):sum);
-if (a /= 18) { printf "ERROR: a must be 18\n"; } \
+if (a ~= 18) { printf "ERROR: a must be 18\n"; } \
 else { printf "OK %d\n" a; };
 
 b := (B:newInstance 2 3 4);
 a := (b:get-a);
-if (a /= 4) {printf "ERROR: a must be 4\n" } \
+if (a ~= 4) {printf "ERROR: a must be 4\n" } \
 else { printf "OK %d\n" a };
 
 a := (b:get-b);
-if (a /= 6) { printf "ERROR: a must be 6\n" } \
+if (a ~= 6) { printf "ERROR: a must be 6\n" } \
 else { printf "OK %d\n" a };
 
 a := (b:get-c);
-if (a /= 8) { printf "ERROR: a must be 8\n" } \
+if (a ~= 8) { printf "ERROR: a must be 8\n" } \
 else {printf "OK %d\n" a };
 
 a := (b:sum);
-if (a /= 27) { printf "ERROR: a must be 27\n" } \
+if (a ~= 27) { printf "ERROR: a must be 27\n" } \
 else { printf "OK %d\n" a };
 
 ## super is equivalent to self unless a message is sent to it.

t/insta-02.hcl

@@ -1,3 +1,15 @@
+fun Number: + (oprnd) { return (+ self oprnd) }
+fun Number: - (oprnd) { return (- self oprnd) }
+fun Number: * (oprnd) { return (* self oprnd) }
+fun Number: / (oprnd) { return (/ self oprnd) }
+fun Number: > (oprnd) { return (> self oprnd) }
+fun Number: < (oprnd) { return (< self oprnd) }
+fun Number: >= (oprnd) { return (>= self oprnd) }
+fun Number: <= (oprnd) { return (<= self oprnd) }
+fun Number: == (oprnd) { return (== self oprnd) }
+fun Number: ~= (oprnd) { return (~= self oprnd) }
+
+## --------------------------------------------------------------
 set t (
 	class [ x ] {
 		defun :* make() { x := 1234; return self; };
@@ -159,3 +171,7 @@ else { printf "OK: value is %d\n" v }
 v := (X6:t)
 if (nqv? v 40) { printf "ERROR: v is not 40 - %d\n" v } \
 else { printf "OK: value is %d\n" v }
+
+v := { X5:t; (X6:t) + 10 }
+if (nqv? v 50) { printf "ERROR: v is not 50 - %d\n" v } \
+else { printf "OK: value is %d\n" v }

t/ret-01.hcl

@@ -15,11 +15,11 @@ defun test-non-local-ret-1(k) {
 };
 
 set a (test-non-local-ret-1 20);
-if (/= a 28) { printf "ERROR: a must be 28\n" } \
+if (~= a 28) { printf "ERROR: a must be 28\n" } \
 else { printf "OK %d\n" a };
 
 set a (test-non-local-ret-1 21);
-if (/= a 41) { printf "ERROR: a must be 41\n" } \
+if (~= a 41) { printf "ERROR: a must be 41\n" } \
 else { printf "OK %d\n" a };
 
 
@@ -27,7 +27,7 @@ defun ff() { return 999 };
 
 ## test a normal block return
 set a (ff);
-if (/= a 999) { printf "ERROR: a must be 999\n" } \
+if (~= a 999) { printf "ERROR: a must be 999\n" } \
 else  { printf "OK %d\n" a };
 
 ## return from top-level

t/retvar-01.hcl

@@ -14,16 +14,20 @@
 	};
 
 	set-r v1 v2 v3 (ff 10 20);
-	if (/= v1 130) { printf "ERROR: v1 must be 130\n" };
+	if (~= v1 130) { printf "ERROR: v1 must be 130\n" } \
-	if (/= v2 260) { printf "ERROR: v2 must be 260\n" };
+	else { printf "OK: v1=%d\n" v1 }
-	if (/= v3 1099) { printf "ERROR: v3 must be 1099\n" };
+	if (~= v2 260) { printf "ERROR: v2 must be 260\n" } \
-	printf "OK v1=%d v2=%d v3=%d\n" v1 v2 v3;
+	else { printf "OK: v2=%d\n" v2 }
+	if (~= v3 1099) { printf "ERROR: v3 must be 1099\n" } \
+	else { printf "OK: v3=%d\n" v3 }
 
 	set-r v1 v2 (ff 1 2); ## using 2 return variables only. not assigning to v3
-	if (/= v1 1003) { printf "ERROR: v1 must be 1003\n" };
+	if (~= v1 1003) { printf "ERROR: v1 must be 1003\n" } \
-	if (/= v2 2006) { printf "ERROR: v2 must be 2006\n" };
+	else { printf "OK: v1=%d\n" v1 }
-	if (/= v3 1099) { printf "ERROR: v3 must be 1099\n" };
+	if (~= v2 2006) { printf "ERROR: v2 must be 2006\n" } \
-	printf "OK v1=%d v2=%d v3=%d\n" v1 v2 v3;
+	else { printf "OK: v2=%d\n" v2 }
+	if (~= v3 1099) { printf "ERROR: v3 must be 1099\n" } \
+	else { printf "OK: v3=%d\n" v3 }
 
 
 	## test return variables in message sends
@@ -46,15 +50,17 @@
 	set-r a b (B:get);
 	set-r c d (B:get2 -100);
 
-	if (/= a 999) { printf "ERROR: a must be 999\n" };
+	if (~= a 999) { printf "ERROR: a must be 999\n" } \
-	if (/= b 888) { printf "ERROR: b must be 888\n" };
+	else { printf "OK: a=%d\n" a }
-	if (/= c 899) { printf "ERROR: c must be 899\n" };
+	if (~= b 888) { printf "ERROR: b must be 888\n" } \
-	if (/= d 788) { printf "ERROR: d must be 788\n" };
+	else { printf "OK: b=%d\n" b }
-
+	if (~= c 899) { printf "ERROR: c must be 899\n" } \
-	printf "OK a=%d b=%d c=%d d=%d\n" a b c d;
+	else { printf "OK: c=%d\n" c }
+	if (~= d 788) { printf "ERROR: d must be 788\n" } \
+	else { printf "OK: d=%d\n" d }
 
 	class X [ x, y ] {
-		fun ::f(a :: b c) { b := (a + 10); c := (a + 20) }
+		fun ::f(a :: b c) { b := (+ a 10); c := (+ a 20) }
 
 		fun :*new(z) {
 			## multi-variable assignment with return variables to member variables
@@ -67,7 +73,23 @@
 	}
 
 	z := (X:new 9)
-	if ((x := (z:getX)) /= 19) { printf "ERROR: z:getX msut return 19\n" }
+	if (~= (x := (z:getX)) 19) { printf "ERROR: z:getX must return 19\n" } \
-	if ((y := (z:getY)) /= 29) { printf "ERROR: z:getX msut return 29\n" }
+	else { printf "OK: z:getX=%d\n" x }
-	printf "OK z:getX=%d z:getY=%d\n" x y
+
+	if (~= (y := (z:getY)) 29) { printf "ERROR: z:getX must return 29\n" } \
+	else { printf "OK: z:getY=%d\n" y }
 });
+
+
+
+## create a new binary operator message returning two output values
+fun Number: // (x :: quo rem) {
+        quo := (/ self x)
+        rem := (- self (* quo x))
+}
+
+[q,r] := (123 // 4)
+if (~= q 30) { printf "ERROR: q is not 30" } \
+else { printf "OK: q is %d\n" q }
+if (~= r 3) { printf "ERROR: r is not 3" } \
+else { printf "OK: r is %d\n" r }

t/test-bi.hcl

@@ -27,7 +27,7 @@
 	(set remainder (rem dividend divisor))
 	(set derived_dividend (+ (* quotient divisor) remainder))
 
-	(if (/= dividend derived_dividend)
+	(if (~= dividend derived_dividend)
 		(printf ">> dividend %O\n>> divisor %O\n>> quotient %O\n>> remainder %O\n>> derived_dividend %O\n"
 			dividend divisor quotient remainder derived_dividend)
 		(break)

t/va-01.hcl

@@ -11,13 +11,13 @@ defun x(a b ... :: x y z) {
 	|i|
 
 	x := (va-count)
-	y := (a * b)
+	y := (* a b)
-	z := (a + b)
+	z := (+ a b)
 
 	i := 0;
-	while (i < (va-count)) {
+	while (< i (va-count)) {
 		printf "VA[%d]=>[%d]\n" i (va-get i)
-		i := (i + 1)
+		i := (+ i 1)
 	}
 	fn-y "hello" "world" (va-context)
 
@@ -25,31 +25,31 @@ defun x(a b ... :: x y z) {
 }
 
 t := (x 10 20 30);
-if (/= t 1) {
+if (~= t 1) {
 	printf "ERROR: t is not 1\n"
 } else {
 	printf "OK: %d\n" t
 }
 
 t := ([a b c] := (x 10 20 30 40 50));
-if (/= t 3) {
+if (~= t 3) {
 	printf "ERROR: t is not 3\n"
 } else {
 	printf "OK: %d\n" t
 }
 
-if (/= a 3) {
+if (~= a 3) {
 	printf "ERROR: a is not 3\n"
 } else {
 	printf "OK: %d\n" a
 }
 
-if (/= b 200) {
+if (~= b 200) {
 	printf "ERROR: b is not 200\n"
 } else {
 	printf "OK: %d\n" b
 }
-if (/= c 30) {
+if (~= c 30) {
 	printf "ERROR: c is not 30\n"
 } else {
 	printf "OK: %d\n" c

t/var-01.hcl

@@ -18,15 +18,15 @@ defun x (a b :: r) {
 	}
 
 
-	if (/= x a) (printf "ERROR: x is not equal to a\n")
+	if (~= x a) (printf "ERROR: x is not equal to a\n")
-	if (/= y b) (printf "ERROR: y is not equal to b\n")
+	if (~= y b) (printf "ERROR: y is not equal to b\n")
 }
 
 t := (x 10 20)
-if (/= t -2000) (printf "ERROR: t is not equal to -2000\n") \
+if (~= t -2000) (printf "ERROR: t is not equal to -2000\n") \
 else (printf "OK: %d\n" t)
 set t (x 30 20)
-if (/= t 500) (printf "ERROR: t is not equal to 500\n") \
+if (~= t 500) (printf "ERROR: t is not equal to 500\n") \
 else (printf "OK: %d\n" t)
 
 
@@ -38,18 +38,18 @@ defun x () {
 	try {
 		| x |
 		set x 88
-		if (/= x 88) (printf "ERROR: x is not 88\n") \
+		if (~= x 88) (printf "ERROR: x is not 88\n") \
 	  	else (printf "OK: %d\n" x)
 		throw 1000
 	} catch (x) {
-		if (/= x 1000) (printf "ERROR: x is not 1000\n") \
+		if (~= x 1000) (printf "ERROR: x is not 1000\n") \
 	 	else (printf "OK: %d\n" x)
 		set y x
 	}
 
-	if (/= x 99) (printf "ERROR: x is not 99\n") \
+	if (~= x 99) (printf "ERROR: x is not 99\n") \
 	else (printf "OK: %d\n" x)
-	if (/= y 1000) (print "ERROR: y is not 1000\n") \
+	if (~= y 1000) (print "ERROR: y is not 1000\n") \
 	else (printf "OK: %d\n" y)
 } 
 
@@ -78,7 +78,7 @@ class T [ j ] {
 set t (T:new)
 t:x
 set t (Q)
-if (/= t 99) (print "ERROR: t is not 99\n") \
+if (~= t 99) (print "ERROR: t is not 99\n") \
 else (printf "OK: %d\n" t)
 
 if (nqv? R false) (print "ERROR: R is not false\n") \

t/var-02.hcl

@@ -14,24 +14,24 @@ if (eqv? j 20) {
 	q := (x 30);
 };
 
-if (/= a 900) { printf "ERROR: a is not 900\n" } \
+if (~= a 900) { printf "ERROR: a is not 900\n" } \
 else { printf "OK: %d\n" a };
 
-if (/= b 60) { printf "ERROR: b is not 60\n" } \
+if (~= b 60) { printf "ERROR: b is not 60\n" } \
 else { printf "OK: %d\n" b };
 
-if (/= c 840) { printf "ERROR: c is not 840\n" } \
+if (~= c 840) { printf "ERROR: c is not 840\n" } \
 else { printf "OK: %d\n" c };
 
 [aa,bb,cc] := ((xx := x) 10)
 
-if (/= aa 100) { printf "ERROR: aa is not 100\n" } \
+if (~= aa 100) { printf "ERROR: aa is not 100\n" } \
 else { printf "OK: %d\n" aa };
 
-if (/= bb 20) { printf "ERROR: bb is not 20\n" } \
+if (~= bb 20) { printf "ERROR: bb is not 20\n" } \
 else { printf "OK: %d\n" bb };
 
-if (/= cc 80) { printf "ERROR: cc is not 80\n" } \
+if (~= cc 80) { printf "ERROR: cc is not 80\n" } \
 else { printf "OK: %d\n" cc };
 
 if (nqv? xx x) { printf "ERROR: xx is not equal to x\n"} \

t/var-03.hcl

@@ -17,14 +17,14 @@ a := 1234
 	g := 70
 	h := 80
 		
-	if (/= a 10) { print "ERROR: a inside the block expression is not 10\n" } \
+	if (~= a 10) { print "ERROR: a inside the block expression is not 10\n" } \
 	else { printf "OK: %d\n" a };
 }
 
-a := (a + 1)
+a := (+ a 1)
 c := (sprintf "%d" a)
 
-if (/= a 1235) { printf "ERROR: a is not 1235\n" } \
+if (~= a 1235) { printf "ERROR: a is not 1235\n" } \
 else { printf "OK: %d\n" a };
 
 if (nql? c "1235") { printf "ERROR: c is not \"1235\"\n" } \