changeset 90b994dcbb48 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=90b994dcbb48 user: Simon Forman <sform****@hushm*****> date: Mon Jul 15 20:55:11 2019 -0700 description: Minor cleanup of defs. changeset aaab55ef2527 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=aaab55ef2527 user: Simon Forman <sform****@hushm*****> date: Mon Jul 15 20:55:41 2019 -0700 description: Implement genrec combinator. changeset 15eb946b7887 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=15eb946b7887 user: Simon Forman <sform****@hushm*****> date: Mon Jul 15 23:02:08 2019 -0700 description: Change comparison ops to not use CLP(FD). diffstat: thun/defs.txt | 7 +++---- thun/thun.pl | 31 ++++++++++++++++++++++++------- 2 files changed, 27 insertions(+), 11 deletions(-) diffs (97 lines): diff -r 3096787a1234 -r 15eb946b7887 thun/defs.txt --- a/thun/defs.txt Mon Jul 15 16:11:49 2019 -0700 +++ b/thun/defs.txt Mon Jul 15 23:02:08 2019 -0700 @@ -1,3 +1,4 @@ +-- == 1 - ++ == 1 + anamorphism == [pop []] swap [dip swons] genrec app1 == grba infrst @@ -9,7 +10,7 @@ ccons == cons cons cleave == fork [popd] dip codireco == cons dip rest cons -dinfrirst == dip infra first +dinfrirst == dip infrst disenstacken == ? [uncons ?] loop pop down_to_zero == [0 >] [dup --] while drop == [rest] times @@ -20,7 +21,6 @@ flatten == [] swap [concat] step fork == [i] app2 fourth == rest third -gcd == 1 [tuck modulus dup 0 >] loop pop grba == [stack popd] dip ifte == [nullary] dipd swap branch ii == [dip] dupdip i @@ -28,7 +28,7 @@ infrst == infra first make_generator == [codireco] ccons neg == 0 swap - -nullary == stack popd [i] infrst +nullary == [stack] dinfrirst of == swap at pam == [i] map pm == [+] [-] cleave popdd @@ -39,7 +39,6 @@ popopdd == [popop] dipd primrec == [i] genrec product == 1 swap [*] step -product == 1 swap [*] step quoted == [unit] dip range == [0 <=] [1 - dup] anamorphism range_to_zero == unit [down_to_zero] infra diff -r 3096787a1234 -r 15eb946b7887 thun/thun.pl --- a/thun/thun.pl Mon Jul 15 16:11:49 2019 -0700 +++ b/thun/thun.pl Mon Jul 15 23:02:08 2019 -0700 @@ -102,7 +102,7 @@ func(*, [A, B|S], [B * A|S]). func(/, [A, B|S], [B / A|S]). -func(=, [A|S], [B|S]) :- B is A. +func(calc, [A|S], [B|S]) :- B is A. % func(pm, [A, B|S], [C, D|S]) :- C #= A + B, D #= B - A. % func(pm, [A, B|S], [B + A, B - A|S]). @@ -127,12 +127,25 @@ func(rollup, Si, So) :- func(rolldown, So, Si). func(uncons, Si, So) :- func(cons, So, Si). -func(>, [A, B|S], [T|S]) :- B #> A #<==> R, r_truth(R, T). -func(<, [A, B|S], [T|S]) :- B #< A #<==> R, r_truth(R, T). -func(=, [A, B|S], [T|S]) :- B #= A #<==> R, r_truth(R, T). -func(>=, [A, B|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T). -func(<=, [A, B|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T). -func(<>, [A, B|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T). +func(>, [A, B|S], [ true|S]) :- B > A. +func(>, [A, B|S], [false|S]) :- \+ B > A. +func(<, [A, B|S], [ true|S]) :- B < A. +func(<, [A, B|S], [false|S]) :- \+ B < A. +func(>=, [A, B|S], [ true|S]) :- B >= A. +func(>=, [A, B|S], [false|S]) :- \+ B >= A. +func(<=, [A, B|S], [ true|S]) :- B =< A. +func(<=, [A, B|S], [false|S]) :- \+ B =< A. +func(=, [A, B|S], [ true|S]) :- B =:= A. +func(=, [A, B|S], [false|S]) :- B =\= A. +func(<>, [A, B|S], [ true|S]) :- B =\= A. +func(<>, [A, B|S], [false|S]) :- B =:= A. + +% func(>, [A, B|S], [T|S]) :- B #> A #<==> R, r_truth(R, T). +% func(<, [A, B|S], [T|S]) :- B #< A #<==> R, r_truth(R, T). +% func(=, [A, B|S], [T|S]) :- B #= A #<==> R, r_truth(R, T). +% func(>=, [A, B|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T). +% func(<=, [A, B|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T). +% func(<>, [A, B|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T). r_truth(0, false). r_truth(1, true). @@ -185,6 +198,10 @@ combo(times, [P, N|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [M, P, times|Ei], Eo). combo(times, [_, N|S], S, _, _ ) :- N #< 0, fail. +combo(genrec, [R1, R0, Then, If|S], + [ Else, Then, If|S], E, [ifte|E]) :- + append(R0, [[If, Then, R0, R1, genrec]|R1], Else). + /* Compiler
Fork