The Prolog version of Joy.
This commit is contained in:
Simon Forman
parent
3b0b7659b3
commit
e573d7a3dc
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
%
|
||||
:- 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])).
|
||||
Loading…
Reference in New Issue