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

enhanced the reader and compiler to treat the binop expression like a message-send expression
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-09-03 12:18:08 +09:00
parent 4c1a50df83
commit a62b89cea9
18 changed files with 197 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
lib/comp.c
View File

@ -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);
}
else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_MLIST))
{
return compile_cons_mlist_expression(hcl, oprnd, cf->u.obj_r.nrets);
}
hcl_concode_t cc;
/*
else if (HCL_CNODE_IS_CONS_CONCODED(oprnd, HCL_CONCODE_ALIST))
cc = HCL_CNODE_CONS_CONCODE(oprnd);
switch (cc)
{
ALIST is transformed to XLIST with or set or set-r by the reader.
so it must not appear here..
case HCL_CONCODE_XLIST:
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;

2
lib/exec.c
View File

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

3
lib/prim.c
View File

@ -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' } },

4
lib/print.c
View File

@ -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);

47
lib/read.c
View File

@ -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");
if (rstl->head) hcl_dumpcnode(hcl, rstl->head, 1);
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");
/* dirty hack to create a wrapper cell containing the first three items.
* TODO: do i have to do this on the caller side of can_binop_list()? */
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;

2
t/class-5001.err
View File

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

2
t/feed-01.hcl
View File

@ -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")

7
t/feed-5001.err
View File

@ -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

24
t/fun-01.hcl
View File

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

21
t/insta-01.hcl
View File

@ -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.

16
t/insta-02.hcl
View File

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

6
t/ret-01.hcl
View File

@ -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

58
t/retvar-01.hcl
View File

@ -14,16 +14,20 @@
};
set-r v1 v2 v3 (ff 10 20);
if (/= v1 130) { printf "ERROR: v1 must be 130\n" };
if (/= v2 260) { printf "ERROR: v2 must be 260\n" };
if (/= v3 1099) { printf "ERROR: v3 must be 1099\n" };
printf "OK v1=%d v2=%d v3=%d\n" v1 v2 v3;
if (~= v1 130) { printf "ERROR: v1 must be 130\n" } \
else { printf "OK: v1=%d\n" v1 }
if (~= v2 260) { printf "ERROR: v2 must be 260\n" } \
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 (/= v2 2006) { printf "ERROR: v2 must be 2006\n" };
if (/= v3 1099) { printf "ERROR: v3 must be 1099\n" };
printf "OK v1=%d v2=%d v3=%d\n" v1 v2 v3;
if (~= v1 1003) { printf "ERROR: v1 must be 1003\n" } \
else { printf "OK: v1=%d\n" v1 }
if (~= v2 2006) { printf "ERROR: v2 must be 2006\n" } \
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 (/= b 888) { printf "ERROR: b must be 888\n" };
if (/= c 899) { printf "ERROR: c must be 899\n" };
if (/= d 788) { printf "ERROR: d must be 788\n" };
printf "OK a=%d b=%d c=%d d=%d\n" a b c d;
if (~= a 999) { printf "ERROR: a must be 999\n" } \
else { printf "OK: a=%d\n" a }
if (~= b 888) { printf "ERROR: b must be 888\n" } \
else { printf "OK: b=%d\n" b }
if (~= c 899) { printf "ERROR: c must be 899\n" } \
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 ((y := (z:getY)) /= 29) { printf "ERROR: z:getX msut return 29\n" }
printf "OK z:getX=%d z:getY=%d\n" x y
if (~= (x := (z:getX)) 19) { printf "ERROR: z:getX must return 19\n" } \
else { printf "OK: z:getX=%d\n" x }
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 }

2
t/test-bi.hcl
View File

@ -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)

18
t/va-01.hcl
View File

@ -11,13 +11,13 @@ defun x(a b ... :: x y z) {
|i|
x := (va-count)
y := (a * b)
z := (a + b)
y := (* 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

18
t/var-01.hcl
View File

@ -18,15 +18,15 @@ defun x (a b :: r) {
}
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 (~= x a) (printf "ERROR: x is not equal to a\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") \

12
t/var-02.hcl
View File

@ -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"} \

6
t/var-03.hcl
View File

@ -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" } \