• R/O
  • SSH

Joypy: Commit

Main interpreter and library.


Commit MetaInfo

Revisionb31b2d3ca7833c98f0181e6e547d9282181b00d6 (tree)
Time2018-08-25 08:52:00
AuthorSimon Forman <sforman@hush...>
CommiterSimon Forman

Log Message

The Prolog version of Joy.

Change Summary

Incremental Difference

diff -r 9d3dfafe0a0a -r b31b2d3ca783 thun/thun.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thun/thun.pl Fri Aug 24 16:52:00 2018 -0700
@@ -0,0 +1,193 @@
1+%
2+% Copyright © 2018 Simon Forman
3+%
4+% This file is part of Thun
5+%
6+% Thun is free software: you can redistribute it and/or modify
7+% it under the terms of the GNU General Public License as published by
8+% the Free Software Foundation, either version 3 of the License, or
9+% (at your option) any later version.
10+%
11+% Thun is distributed in the hope that it will be useful,
12+% but WITHOUT ANY WARRANTY; without even the implied warranty of
13+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14+% GNU General Public License for more details.
15+%
16+% You should have received a copy of the GNU General Public License
17+% along with Thun. If not see <http://www.gnu.org/licenses/>.
18+%
19+:- use_module(library(clpfd)).
20+:- use_module(library(dcg/basics)).
21+:- op(990, xfy, ≡). % for Joy definitions.
22+
23+/*
24+An entry point.
25+*/
26+
27+joy(InputString, StackIn, StackOut) :-
28+ phrase(joy_parse(Expression), InputString), !,
29+ thun(Expression, StackIn, StackOut).
30+
31+/*
32+Parser
33+*/
34+
35+joy_parse([T|S]) --> blanks, joy_term(T), blanks, joy_parse(S).
36+joy_parse([]) --> [].
37+
38+joy_term(N) --> number(N), !.
39+joy_term(S) --> "[", !, joy_parse(S), "]".
40+joy_term(A) --> chars(Chars), !, {atom_string(A, Chars)}.
41+
42+chars([Ch|Rest]) --> char(Ch), chars(Rest).
43+chars([Ch]) --> char(Ch).
44+
45+char(Ch) --> [Ch], {Ch \== 91, Ch \== 93, code_type(Ch, graph)}.
46+
47+/*
48+Interpreter
49+thun(Expression, InputStack, OutputStack)
50+*/
51+
52+thun([], S, S).
53+thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So).
54+thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, So).
55+thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
56+
57+/*
58+Literals
59+*/
60+
61+literal(V) :- var(V).
62+literal(I) :- number(I).
63+literal([]).
64+literal([_|_]).
65+literal(true).
66+literal(false).
67+
68+/*
69+Functions
70+*/
71+
72+func(app1, [P, Xi|S], [Xo|S]) :- thun(P, [Xi|S], [Xo|_]).
73+func(app2, [P, Xi, Yi|S], [Xo, Yo|S]) :- thun(P, [Xi|S], [Xo|_]), thun(P, [Yi|S], [Yo|_]).
74+
75+func(cons, [A, B|S], [[B|A]|S]).
76+func(swap, [A, B|S], [B, A|S]).
77+func(dup, [A|S], [A, A|S]).
78+func(pop, [_|S], S ).
79+func(+, [A, B|S], [C|S]) :- C #= A + B.
80+func(-, [A, B|S], [C|S]) :- C #= B - A.
81+func(*, [A, B|S], [C|S]) :- C #= A * B.
82+func(/, [A, B|S], [C|S]) :- C #= B div A.
83+
84+func(nullary, [P|S], [X|S]) :- thun(P, S, [X|_]). % Combinator.
85+func(infra, [P, R|S], [Q|S]) :- thun(P, R, Q). % Combinator.
86+
87+func(concat, [A, B|S], [C|S]) :- append(B, A, C).
88+func(flatten, [A|S], [B|S]) :- flatten(A, B).
89+func(swaack, [R|S], [S|R]).
90+func(stack, S , [S|S]).
91+func(clear, _ , []).
92+func(first, [[X|_]|S], [X|S]).
93+func(rest, [[_|X]|S], [X|S]).
94+func(unit, [X|S], [[X]|S]).
95+
96+func(rolldown, [A, B, C|S], [B, C, A|S]).
97+func(dupd, [A, B|S], [A, B, B|S]).
98+func(over, [A, B|S], [B, A, B|S]).
99+func(tuck, [A, B|S], [A, B, A|S]).
100+
101+func(rollup, Si, So) :- func(rolldown, So, Si).
102+func(uncons, Si, So) :- func(cons, So, Si).
103+
104+func(>, [A, B|S], [T|S]) :- B #> A #<==> R, r_truth(R, T).
105+func(<, [A, B|S], [T|S]) :- B #< A #<==> R, r_truth(R, T).
106+func(=, [A, B|S], [T|S]) :- B #= A #<==> R, r_truth(R, T).
107+func(>=, [A, B|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T).
108+func(<=, [A, B|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T).
109+func(<>, [A, B|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T).
110+
111+/*
112+Definitions
113+*/
114+
115+func(Name, Si, So) :- Name ≡ Body, thun(Body, Si, So).
116+
117+swons ≡ [swap, cons].
118+unswons ≡ [uncons, swap].
119+x ≡ [dup, i].
120+b ≡ [[i], dip, i].
121+sqr ≡ [dup, *].
122+ifte ≡ [[nullary], dipd, swap, branch].
123+while ≡ [swap, [nullary], cons, dup, dipd, concat, loop].
124+popop ≡ [pop, pop].
125+ccons ≡ [cons, cons].
126+unary ≡ [nullary, popd].
127+binary ≡ [unary, popd].
128+trinary ≡ [binary, popd].
129+popd ≡ [[pop], dip].
130+popdd ≡ [[pop], dipd].
131+popopd ≡ [[popop], dip].
132+popopdd ≡ [[popop], dipd].
133+dupd ≡ [[dup], dip].
134+dupdd ≡ [[dup], dipd].
135+second ≡ [rest, first].
136+third ≡ [rest, second].
137+fourth ≡ [rest, third].
138+rrest ≡ [rest, rest].
139+unit ≡ [[], cons].
140+drop ≡ [[rest], times].
141+at ≡ [drop, first].
142+of ≡ [swap, at].
143+sum ≡ [0, swap, [+], step].
144+product ≡ [1, swap, [*], step].
145+size ≡ [0, swap, [pop, 1, +], step].
146+fork ≡ [[i], app2].
147+cleave ≡ [fork, [popd], dip].
148+codireco ≡ [cons, dip, rest, cons].
149+make_generator ≡ [[codireco], ccons].
150+
151+r_truth(0, false).
152+r_truth(1, true).
153+
154+/*
155+Combinators
156+*/
157+
158+combo(i, [P|S], S, Ei, Eo) :- append(P, Ei, Eo).
159+combo(dip, [P, X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo).
160+combo(dipd, [P, X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo).
161+
162+combo(branch, [T, _, true|S], S, Ei, Eo) :- append(T, Ei, Eo).
163+combo(branch, [_, F, false|S], S, Ei, Eo) :- append(F, Ei, Eo).
164+
165+combo(loop, [_, false|S], S, E, E ).
166+combo(loop, [B, true|S], S, Ei, Eo) :- append(B, [B, loop|Ei], Eo).
167+
168+combo(step, [_, []|S], S, E, E ).
169+combo(step, [P, [X]|S], [X|S], Ei, Eo) :- !, append(P, Ei, Eo).
170+combo(step, [P, [X|Z]|S], [X|S], Ei, Eo) :- append(P, [Z, P, step|Ei], Eo).
171+
172+combo(times, [_, 0|S], S, E, E ).
173+combo(times, [P, 1|S], S, Ei, Eo) :- append(P, Ei, Eo).
174+combo(times, [P, N|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [M, P, times|Ei], Eo).
175+combo(times, [_, N|S], S, _, _ ) :- N #< 0, fail.
176+
177+
178+/*
179+Compiler
180+*/
181+
182+joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule).
183+
184+show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), write(Rule).
185+
186+jcmpl(Name, Expression, Rule) :-
187+ call_residue_vars(thun(Expression, Si, So), Term),
188+ copy_term(Term, Term, Gs),
189+ Head =.. [func, Name, Si, So],
190+ rule(Head, Gs, Rule).
191+
192+rule(Head, [], Head ).
193+rule(Head, [A|B], Head :- maplist(call, [A|B])).
Show on old repository browser