Compiling Thun to Python.

Not all of the words that compiled with the old defs.txt compiled with
the latest, so we're keeping the old one in here until I can trace down
the issues.

implementations/SWIProlog/compiled_code.py

@@ -0,0 +1,195 @@
+
+def abs(stack, expression, dictionary):
+    (v1, stack) = stack
+    v2 = abs(v1)
+    return (v2, stack), expression, dictionary
+
+
+def ccons(stack, expression, dictionary):
+    (s1, (v1, (v2, stack))) = stack
+    return ((v2, (v1, s1)), stack), expression, dictionary
+
+
+def cons(stack, expression, dictionary):
+    (s1, (v1, stack)) = stack
+    return ((v1, s1), stack), expression, dictionary
+
+
+def decr(stack, expression, dictionary):
+    (i1, stack) = stack
+    i2 = i1 - 1
+    return (i2, stack), expression, dictionary
+
+
+def dup(stack, expression, dictionary):
+    (v1, stack) = stack
+    return (v1, (v1, stack)), expression, dictionary
+
+
+def dupd(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    return (v1, (v2, (v2, stack))), expression, dictionary
+
+
+def dupdd(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    return (v1, (v2, (v3, (v3, stack)))), expression, dictionary
+
+
+def first(stack, expression, dictionary):
+    ((v1, s1), stack) = stack
+    return (v1, stack), expression, dictionary
+
+
+def fourth(stack, expression, dictionary):
+    ((v1, (v2, (v3, (v4, s1)))), stack) = stack
+    return (v4, stack), expression, dictionary
+
+
+def incr(stack, expression, dictionary):
+    (i1, stack) = stack
+    i2 = i1 + 1
+    return (i2, stack), expression, dictionary
+
+
+def non_negative(stack, expression, dictionary):
+    (i1, stack) = stack
+    v1 = i1 >= 0
+    return (v1, stack), expression, dictionary
+
+
+def pop(stack, expression, dictionary):
+    (v1, stack) = stack
+    return stack, expression, dictionary
+
+
+def popd(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    return (v1, stack), expression, dictionary
+
+
+def popop(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    return stack, expression, dictionary
+
+
+def popopd(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    return (v1, stack), expression, dictionary
+
+
+def quoted(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    return (v1, ((v2, ()), stack)), expression, dictionary
+
+
+def reco(stack, expression, dictionary):
+    ((v1, s1), (v2, stack)) = stack
+    return ((v2, s1), stack), expression, dictionary
+
+
+def rest(stack, expression, dictionary):
+    ((v1, s1), stack) = stack
+    return (s1, stack), expression, dictionary
+
+
+def rrest(stack, expression, dictionary):
+    ((v1, (v2, s1)), stack) = stack
+    return (s1, stack), expression, dictionary
+
+
+def second(stack, expression, dictionary):
+    ((v1, (v2, s1)), stack) = stack
+    return (v2, stack), expression, dictionary
+
+
+def shift(stack, expression, dictionary):
+    ((v1, s1), (s2, stack)) = stack
+    return (s1, ((v1, s2), stack)), expression, dictionary
+
+
+def sqr(stack, expression, dictionary):
+    (i1, stack) = stack
+    i2 = i1 * i1
+    return (i2, stack), expression, dictionary
+
+
+def stackd(stack, expression, dictionary):
+    (v1, stack) = stack
+    stack = (stack, stack)
+    return (v1, stack), expression, dictionary
+
+
+def swons(stack, expression, dictionary):
+    (v1, (s1, stack)) = stack
+    return ((v1, s1), stack), expression, dictionary
+
+
+def third(stack, expression, dictionary):
+    ((v1, (v2, (v3, s1))), stack) = stack
+    return (v3, stack), expression, dictionary
+
+
+def truthy(stack, expression, dictionary):
+    (v1, stack) = stack
+    v2 = bool(v1)
+    return (v2, (v1, stack)), expression, dictionary
+
+
+def tuckl(stack, expression, dictionary):
+    (v1, stack) = stack
+    return (v1, ((), stack)), expression, dictionary
+
+
+def tuckld(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    return (v1, (v2, ((), stack))), expression, dictionary
+
+
+def uncons(stack, expression, dictionary):
+    ((v1, s1), stack) = stack
+    return (s1, (v1, stack)), expression, dictionary
+
+
+def unit(stack, expression, dictionary):
+    (v1, stack) = stack
+    return ((v1, ()), stack), expression, dictionary
+
+
+def unswons(stack, expression, dictionary):
+    ((v1, s1), stack) = stack
+    return (v1, (s1, stack)), expression, dictionary
+
+
+def gcd(stack, expression, dictionary):
+    (i1, (i2, stack)) = stack
+    v1 = True
+    while v1:
+        i3 = i2 % i1
+        v1 = i3 > 0
+        (i1, (i2, stack)) = (i3, (i1, stack))
+    return (i2, stack), expression, dictionary
+
+
+def sum(stack, expression, dictionary):
+    (s1, stack) = stack
+    (i1, stack) = (0, stack)
+    while s1:
+        (i2, s1) = s1
+        i3 = i1 + i2
+        (i1, stack) = (i3, stack)
+    return (i1, stack), expression, dictionary
+
+
+def product(stack, expression, dictionary):
+    (s1, stack) = stack
+    (i1, stack) = (1, stack)
+    while s1:
+        (i2, s1) = s1
+        i3 = i1 * i2
+        (i1, stack) = (i3, stack)
+    return (i1, stack), expression, dictionary
+
+
+1 ?- 
+

implementations/SWIProlog/defs.txt

@@ -1,46 +1,38 @@
-eq [false] [true] [false] cmp
-gt [true] [false] [false] cmp
-lt [false] [false] [true] cmp
-neq [true] [false] [true] cmp
-le [false] [true] [true] cmp
-ge [true] [true] [false] cmp
-? dup bool
-!- 0 >=
-++ 1 +
 -- 1 -
+? dup bool
+&& nulco [nullary [false]] dip branch
+++ 1 +
+|| nulco [nullary] dip [true] branch
+!- 0 >=
 <{} [] swap
-<<{} [] rollup
+<<{} [] rolldown
 abs dup 0 < [] [neg] branch
 anamorphism [pop []] swap [dip swons] genrec
-and nulco [nullary [false]] dip branch
 app1 grba infrst
 app2 [grba swap grba swap] dip [infrst] cons ii
 app3 3 appN
-appN [grabN] codi map reverse disenstacken
+appN [grabN] codi map disenstacken
 at drop first
 average [sum] [size] cleave /
 b [i] dip i
 binary unary popd
 ccccons ccons ccons
 ccons cons cons
-clear [] swaack pop
+clear stack bool [pop stack bool] loop
 cleave fork popdd
 clop cleave popdd
-cmp [[>] swap] dipd [ifte] ccons [=] swons ifte
 codi cons dip
 codireco codi reco
 dinfrirst dip infrst
 dipd [dip] codi
-disenstacken swaack pop
+disenstacken ? [uncons ?] loop pop
-divmod [/] [%] clop
 down_to_zero [0 >] [dup --] while
 drop [rest] times
-dupdd [dup] dipd
 dupd [dup] dip
-dupdipd dup dipd
+dupdd [dup] dipd
 dupdip dupd dip
+dupdipd dup dipd
 enstacken stack [clear] dip
-first uncons pop
 flatten <{} [concat] step
 fork [i] app2
 fourth rest third
@@ -53,60 +45,50 @@ ifte [nullary] dipd swap branch
 ii [dip] dupdip i
 infra swons swaack [i] dip swaack
 infrst infra first
-<< lshift
-lshift [2 *] times
 make_generator [codireco] ccons
 mod %
 neg 0 swap -
 not [true] [false] branch
 nulco [nullary] cons
 nullary [stack] dinfrirst
-null [] swap concat bool not
 of swap at
-or nulco [nullary] dip [true] branch
-over [dup] dip swap
 pam [i] map
 pm [+] [-] clop
-popdd [pop] dipd
 popd [pop] dip
-popopdd [popop] dipd
+popdd [pop] dipd
-popopd [popop] dip
-popopop pop popop
 popop pop pop
-pow 1 roll> swap [*] cons times
+popopop pop popop
+popopd [popop] dip
+popopdd [popop] dipd
 product 1 swap [*] step
 quoted [unit] dip
-range [0 <=] [-- dup] anamorphism
+range [0 <=] [1 - dup] anamorphism
 range_to_zero unit [down_to_zero] infra
 reco rest cons
-rest uncons popd
+rest [pop] infra
 reverse <{} shunt
-rolldown roll<
-roll< swapd swap
 roll> swap swapd
+roll< swapd swap
 rollup roll>
+rolldown roll<
 rrest rest rest
->> rshift
-rshift [2 /] times
 run <{} infra
 second rest first
 shift uncons [swons] dip
 shunt [swons] step
 size [pop ++] step_zero
-small dup null [rest null] [pop true] branch
+spiral_next [[[abs] ii <=] [[<>] [pop !-] ||] &&] [[!-] [[++]] [[--]] ifte dip] [[pop !-] [--] [++] ifte] ifte
-spiral_next [[[abs] ii <=] [[<>] [pop !-] or] and] [[!-] [[++]] [[--]] ifte dip] [[pop !-] [--] [++] ifte] ifte
 split_at [drop] [take] clop
 split_list [take reverse] [drop] clop
-sqr dup mul
+sqr dup *
 stackd [stack] dip
 step_zero 0 roll> step
-stuncons stack uncons
 sum [+] step_zero
 swapd [swap] dip
-swoncat swap concat
 swons swap cons
+swoncat swap concat
 tailrec [i] genrec
-take <<{} [shift] times pop
+take [] roll> [shift] times pop
 ternary binary popd
 third rest second
 tuck dup swapd
@@ -114,7 +96,6 @@ unary nullary popd
 uncons [first] [rest] cleave
 unit [] cons
 unquoted [i] dip
-unstack [[] swaack] dip swoncat swaack pop
 unswons uncons swap
 while swap nulco dupdipd concat loop
 x dup i
@@ -132,9 +113,3 @@ _mape popd reverse
 _map0 [_map1] dipd _map2
 _map1 stackd shift
 _map2 [infrst] cons dipd roll< swons
-_isnt_bool not not
-_isnt_two_bools [_isnt_bool] ii
-_\/_ [_isnt_bool] [not] branch
-/\ _isnt_two_bools [pop false] [] branch
-\/ _isnt_two_bools [] [pop true] branch
-xor [] [not] branch