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
Download Patch File Download Diff File Expand all files Collapse all files

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