diff --git a/thun/thun.pl b/thun/thun.pl new file mode 100644 index 0000000..d9f9179 --- /dev/null +++ b/thun/thun.pl @@ -0,0 +1,193 @@ +% +% Copyright © 2018 Simon Forman +% +% This file is part of Thun +% +% Thun is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% Thun is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with Thun. If not see . +% +:- use_module(library(clpfd)). +:- use_module(library(dcg/basics)). +:- op(990, xfy, ≡). % for Joy definitions. + +/* +An entry point. +*/ + +joy(InputString, StackIn, StackOut) :- + phrase(joy_parse(Expression), InputString), !, + thun(Expression, StackIn, StackOut). + +/* +Parser +*/ + +joy_parse([T|S]) --> blanks, joy_term(T), blanks, joy_parse(S). +joy_parse([]) --> []. + +joy_term(N) --> number(N), !. +joy_term(S) --> "[", !, joy_parse(S), "]". +joy_term(A) --> chars(Chars), !, {atom_string(A, Chars)}. + +chars([Ch|Rest]) --> char(Ch), chars(Rest). +chars([Ch]) --> char(Ch). + +char(Ch) --> [Ch], {Ch \== 91, Ch \== 93, code_type(Ch, graph)}. + +/* +Interpreter +thun(Expression, InputStack, OutputStack) +*/ + +thun([], S, S). +thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So). +thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, So). +thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). + +/* +Literals +*/ + +literal(V) :- var(V). +literal(I) :- number(I). +literal([]). +literal([_|_]). +literal(true). +literal(false). + +/* +Functions +*/ + +func(app1, [P, Xi|S], [Xo|S]) :- thun(P, [Xi|S], [Xo|_]). +func(app2, [P, Xi, Yi|S], [Xo, Yo|S]) :- thun(P, [Xi|S], [Xo|_]), thun(P, [Yi|S], [Yo|_]). + +func(cons, [A, B|S], [[B|A]|S]). +func(swap, [A, B|S], [B, A|S]). +func(dup, [A|S], [A, A|S]). +func(pop, [_|S], S ). +func(+, [A, B|S], [C|S]) :- C #= A + B. +func(-, [A, B|S], [C|S]) :- C #= B - A. +func(*, [A, B|S], [C|S]) :- C #= A * B. +func(/, [A, B|S], [C|S]) :- C #= B div A. + +func(nullary, [P|S], [X|S]) :- thun(P, S, [X|_]). % Combinator. +func(infra, [P, R|S], [Q|S]) :- thun(P, R, Q). % Combinator. + +func(concat, [A, B|S], [C|S]) :- append(B, A, C). +func(flatten, [A|S], [B|S]) :- flatten(A, B). +func(swaack, [R|S], [S|R]). +func(stack, S , [S|S]). +func(clear, _ , []). +func(first, [[X|_]|S], [X|S]). +func(rest, [[_|X]|S], [X|S]). +func(unit, [X|S], [[X]|S]). + +func(rolldown, [A, B, C|S], [B, C, A|S]). +func(dupd, [A, B|S], [A, B, B|S]). +func(over, [A, B|S], [B, A, B|S]). +func(tuck, [A, B|S], [A, B, A|S]). + +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). + +/* +Definitions +*/ + +func(Name, Si, So) :- Name ≡ Body, thun(Body, Si, So). + +swons ≡ [swap, cons]. +unswons ≡ [uncons, swap]. +x ≡ [dup, i]. +b ≡ [[i], dip, i]. +sqr ≡ [dup, *]. +ifte ≡ [[nullary], dipd, swap, branch]. +while ≡ [swap, [nullary], cons, dup, dipd, concat, loop]. +popop ≡ [pop, pop]. +ccons ≡ [cons, cons]. +unary ≡ [nullary, popd]. +binary ≡ [unary, popd]. +trinary ≡ [binary, popd]. +popd ≡ [[pop], dip]. +popdd ≡ [[pop], dipd]. +popopd ≡ [[popop], dip]. +popopdd ≡ [[popop], dipd]. +dupd ≡ [[dup], dip]. +dupdd ≡ [[dup], dipd]. +second ≡ [rest, first]. +third ≡ [rest, second]. +fourth ≡ [rest, third]. +rrest ≡ [rest, rest]. +unit ≡ [[], cons]. +drop ≡ [[rest], times]. +at ≡ [drop, first]. +of ≡ [swap, at]. +sum ≡ [0, swap, [+], step]. +product ≡ [1, swap, [*], step]. +size ≡ [0, swap, [pop, 1, +], step]. +fork ≡ [[i], app2]. +cleave ≡ [fork, [popd], dip]. +codireco ≡ [cons, dip, rest, cons]. +make_generator ≡ [[codireco], ccons]. + +r_truth(0, false). +r_truth(1, true). + +/* +Combinators +*/ + +combo(i, [P|S], S, Ei, Eo) :- append(P, Ei, Eo). +combo(dip, [P, X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo). +combo(dipd, [P, X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo). + +combo(branch, [T, _, true|S], S, Ei, Eo) :- append(T, Ei, Eo). +combo(branch, [_, F, false|S], S, Ei, Eo) :- append(F, Ei, Eo). + +combo(loop, [_, false|S], S, E, E ). +combo(loop, [B, true|S], S, Ei, Eo) :- append(B, [B, loop|Ei], Eo). + +combo(step, [_, []|S], S, E, E ). +combo(step, [P, [X]|S], [X|S], Ei, Eo) :- !, append(P, Ei, Eo). +combo(step, [P, [X|Z]|S], [X|S], Ei, Eo) :- append(P, [Z, P, step|Ei], Eo). + +combo(times, [_, 0|S], S, E, E ). +combo(times, [P, 1|S], S, Ei, Eo) :- append(P, Ei, Eo). +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. + + +/* +Compiler +*/ + +joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule). + +show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), write(Rule). + +jcmpl(Name, Expression, Rule) :- + call_residue_vars(thun(Expression, Si, So), Term), + copy_term(Term, Term, Gs), + Head =.. [func, Name, Si, So], + rule(Head, Gs, Rule). + +rule(Head, [], Head ). +rule(Head, [A|B], Head :- maplist(call, [A|B])).