fix compiler unroll bug with literal

Ljzn · Aug 30, 2020 · 1284cbc · 1284cbc
1 parent 9ee5b95
commit 1284cbc
Show file tree

Hide file tree

Showing 5 changed files with 49 additions and 11 deletions.
diff --git a/c/core/core.fth b/c/core/core.fth
@@ -1,9 +1,23 @@
+: nop ;
+
+: swap
+    1 roll ;
+
+: over
+    1 pick ;
+
+: dup
+    0 pick ;
+
 : 1- ( a -- b )
     1 - ;
 
 : negate ( a -- b )
     -1 * ;
 
+: -
+    negate + ;
+
 : over ( a b -- a b a )
     swap dup tas swap fas ;
 
@@ -13,6 +27,9 @@
 : rot ( a b c -- b c a )
     tas swap fas swap ;
 
+: tuck
+    dup rot rot ;
+
 : 2dup ( a b -- a b a b )
     over over ;
 

diff --git a/c/mix.exs b/c/mix.exs
@@ -4,7 +4,7 @@ defmodule C.MixProject do
   def project do
     [
       app: :mini_forth,
-      version: "0.1.0",
+      version: "0.1.1",
       elixir: "~> 1.10",
       start_permanent: Mix.env() == :prod,
       deps: deps(),

diff --git a/c/src/compiler.erl b/c/src/compiler.erl
@@ -45,7 +45,9 @@ execute_latest_quote([], R) ->
 
 unroll(S) -> unroll_loop(S, [], 0).
 
-unroll_loop([do | C], [S, E | M], J) when is_integer(S), is_integer(E) ->
+unroll_loop([do | C], [S0, E0 | M], J) ->
+    S = interpreter:bin2num(S0),
+    E = interpreter:bin2num(E0),
     {P, C1, Step} = find_loop_part(C, 0, []),
     C2 = loops(P, S, E, [], S, J, Step) ++ C1,
     unroll_loop(C2, M, J);

diff --git a/c/src/interpreter.erl b/c/src/interpreter.erl
@@ -30,15 +30,10 @@ op(X, M) when is_integer(X) -> [num2bin(X) | M];
 op(X, M) when is_binary(X) -> [X | M];
 op(pick, [N | M]) -> pick(M, N);
 op(roll, [N | M]) -> roll(M, N);
-op(over, [X, Y | M]) -> [Y, X, Y | M];
-op(nop, M) -> M;
 op(split, [P, B | M]) -> split(B, P) ++ M;
 op(cat, [Y, X | M]) -> [<<X/binary, Y/binary>> | M];
-op(swap, [X, Y | M]) -> [Y, X | M];
 op(drop, [_X | M]) -> M;
-op(tuck, [X, Y | M]) -> [X, Y, X | M];
 op('+', [Y, X | M]) -> [add(X, Y) | M];
-op('-', [Y, X | M]) -> [sub(X, Y) | M];
 op('*', [Y, X | M]) -> [mul(X, Y) | M];
 op('/', [Y, X | M]) -> [divide(X, Y) | M];
 op('%', [Y, X | M]) -> [do_rem(X, Y) | M];
@@ -49,7 +44,6 @@ op(ripemd160, [H | M]) ->
 % the OP_BIN2NUM is trimming the bytes into minimal encoding
 op(bin2num, [H | M]) -> [num2bin(bin2num(H)) | M];
 op(num2bin, [Y, X | M]) -> [num2bin(X, Y) | M];
-op(dup, [H | M]) -> [H, H | M];
 op('=', [X, X | M]) -> [<<1>> | M];
 op('=', [_Y, _X | M]) -> [<<>> | M];
 op('num=', [Y, X | M]) ->
@@ -231,8 +225,6 @@ mul(X, Y) ->
     num2bin(bin2num(X) * bin2num(Y)).
 add(X, Y) ->
     num2bin(bin2num(X) + bin2num(Y)).
-sub(X, Y) ->
-    num2bin(bin2num(X) - bin2num(Y)).
 divide(X, Y) ->
     num2bin(bin2num(X) / bin2num(Y)).
 do_rem(X, Y) ->

diff --git a/c/test/opcode_test.fth b/c/test/opcode_test.fth
@@ -125,5 +125,32 @@
 
     2 pick
     22 =verify
-
+
+    \ test drop
+    0 1 2 3 drop
+    2 =verify
+    drop
+    0 =verify
+
+    \ test swap
+    1 2 swap
+    1 =verify
+    2 =verify
+
+    \ test over
+    1 2 over
+    1 =verify
+    2 1 over
+    2 =verify
+
+    \ test tuck
+    1 2 tuck
+    2 =verify
+    1 =verify
+    2 =verify
+
+    \ test dup
+    1 0 pick
+    1 =verify
+    1 =verify
 ;