THe old compiler-to-Python.
This commit is contained in:
sforman
parent
38a9b93488
commit
fb8faf917d
|
|
@ -0,0 +1,140 @@
|
||||||
|
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 -
|
||||||
|
<{} [] swap
|
||||||
|
<<{} [] rollup
|
||||||
|
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
|
||||||
|
at drop first
|
||||||
|
average [sum] [size] cleave /
|
||||||
|
b [i] dip i
|
||||||
|
binary unary popd
|
||||||
|
ccccons ccons ccons
|
||||||
|
ccons cons cons
|
||||||
|
clear [] swaack pop
|
||||||
|
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
|
||||||
|
divmod [/] [%] clop
|
||||||
|
down_to_zero [0 >] [dup --] while
|
||||||
|
drop [rest] times
|
||||||
|
dupdd [dup] dipd
|
||||||
|
dupd [dup] dip
|
||||||
|
dupdipd dup dipd
|
||||||
|
dupdip dupd dip
|
||||||
|
enstacken stack [clear] dip
|
||||||
|
first uncons pop
|
||||||
|
flatten <{} [concat] step
|
||||||
|
fork [i] app2
|
||||||
|
fourth rest third
|
||||||
|
gcd true [tuck mod dup 0 >] loop pop
|
||||||
|
genrec [[genrec] ccccons] nullary swons concat ifte
|
||||||
|
grabN <{} [cons] times
|
||||||
|
grba [stack popd] dip
|
||||||
|
hypot [sqr] ii + sqrt
|
||||||
|
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
|
||||||
|
popopd [popop] dip
|
||||||
|
popopop pop popop
|
||||||
|
popop pop pop
|
||||||
|
pow 1 roll> swap [*] cons times
|
||||||
|
product 1 swap [*] step
|
||||||
|
quoted [unit] dip
|
||||||
|
range [0 <=] [-- dup] anamorphism
|
||||||
|
range_to_zero unit [down_to_zero] infra
|
||||||
|
reco rest cons
|
||||||
|
rest uncons popd
|
||||||
|
reverse <{} shunt
|
||||||
|
rolldown roll<
|
||||||
|
roll< swapd swap
|
||||||
|
roll> swap swapd
|
||||||
|
rollup 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 !-] or] and] [[!-] [[++]] [[--]] ifte dip] [[pop !-] [--] [++] ifte] ifte
|
||||||
|
split_at [drop] [take] clop
|
||||||
|
split_list [take reverse] [drop] clop
|
||||||
|
sqr dup mul
|
||||||
|
stackd [stack] dip
|
||||||
|
step_zero 0 roll> step
|
||||||
|
stuncons stack uncons
|
||||||
|
sum [+] step_zero
|
||||||
|
swapd [swap] dip
|
||||||
|
swoncat swap concat
|
||||||
|
swons swap cons
|
||||||
|
tailrec [i] genrec
|
||||||
|
take <<{} [shift] times pop
|
||||||
|
ternary binary popd
|
||||||
|
third rest second
|
||||||
|
tuck dup swapd
|
||||||
|
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
|
||||||
|
step [_step0] x
|
||||||
|
_step0 _step1 [popopop] [_stept] branch
|
||||||
|
_step1 [?] dipd roll<
|
||||||
|
_stept [uncons] dipd [dupdipd] dip x
|
||||||
|
times [_times0] x
|
||||||
|
_times0 _times1 [popopop] [_timest] branch
|
||||||
|
_times1 [dup 0 >] dipd roll<
|
||||||
|
_timest [[--] dip dupdipd] dip x
|
||||||
|
map [_map0] cons [[] [_map?] [_mape]] dip tailrec
|
||||||
|
_map? pop bool not
|
||||||
|
_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
|
||||||
|
|
@ -0,0 +1,921 @@
|
||||||
|
/*
|
||||||
|
|
||||||
|
████████╗██╗ ██╗██╗ ██╗███╗ ██╗
|
||||||
|
╚══██╔══╝██║ ██║██║ ██║████╗ ██║
|
||||||
|
██║ ███████║██║ ██║██╔██╗ ██║
|
||||||
|
██║ ██╔══██║██║ ██║██║╚██╗██║
|
||||||
|
██║ ██║ ██║╚██████╔╝██║ ╚████║
|
||||||
|
╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝
|
||||||
|
|
||||||
|
A dialect of Joy. Version -10.0.0.
|
||||||
|
|
||||||
|
Copyright © 2018, 2019, 2020 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/>.
|
||||||
|
|
||||||
|
(Big fonts are from Figlet "ANSI Shadow" http://www.patorjk.com/software/taag/#p=display&f=ANSI%20Shadow&t=formatter and "Small".)
|
||||||
|
|
||||||
|
Thun is an implementation of a dialect of the Joy executable notation.
|
||||||
|
|
||||||
|
Table of Contents
|
||||||
|
Parser & Grammar
|
||||||
|
Semantics
|
||||||
|
Functions
|
||||||
|
Combinators
|
||||||
|
Definitions
|
||||||
|
Compiler
|
||||||
|
to Prolog
|
||||||
|
to Machine Code
|
||||||
|
Meta-Programming
|
||||||
|
Expand/Contract Definitions
|
||||||
|
Formatter
|
||||||
|
Partial Reducer
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- use_module(library(clpfd)).
|
||||||
|
:- use_module(library(dcg/basics)).
|
||||||
|
:- use_module(library(gensym)).
|
||||||
|
:- dynamic func/3.
|
||||||
|
:- dynamic def/2.
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
An entry point.
|
||||||
|
*/
|
||||||
|
|
||||||
|
joy(InputString, StackIn, StackOut) :-
|
||||||
|
text_to_expression(InputString, Expression),
|
||||||
|
!,
|
||||||
|
thun(Expression, StackIn, StackOut).
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
██████╗ █████╗ ██████╗ ███████╗███████╗██████╗ ██╗
|
||||||
|
██╔══██╗██╔══██╗██╔══██╗██╔════╝██╔════╝██╔══██╗ ██║
|
||||||
|
██████╔╝███████║██████╔╝███████╗█████╗ ██████╔╝ ████████╗
|
||||||
|
██╔═══╝ ██╔══██║██╔══██╗╚════██║██╔══╝ ██╔══██╗ ██╔═██╔═╝
|
||||||
|
██║ ██║ ██║██║ ██║███████║███████╗██║ ██║ ██████║
|
||||||
|
╚═╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚══════╝╚══════╝╚═╝ ╚═╝ ╚═════╝
|
||||||
|
|
||||||
|
██████╗ ██████╗ █████╗ ███╗ ███╗███╗ ███╗ █████╗ ██████╗
|
||||||
|
██╔════╝ ██╔══██╗██╔══██╗████╗ ████║████╗ ████║██╔══██╗██╔══██╗
|
||||||
|
██║ ███╗██████╔╝███████║██╔████╔██║██╔████╔██║███████║██████╔╝
|
||||||
|
██║ ██║██╔══██╗██╔══██║██║╚██╔╝██║██║╚██╔╝██║██╔══██║██╔══██╗
|
||||||
|
╚██████╔╝██║ ██║██║ ██║██║ ╚═╝ ██║██║ ╚═╝ ██║██║ ██║██║ ██║
|
||||||
|
╚═════╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝
|
||||||
|
|
||||||
|
The grammar of Joy is very simple. A Joy expression is zero or more Joy
|
||||||
|
terms (separated by blanks, see below) and terms can be
|
||||||
|
integers, Booleans, quoted Joy expressions, or symbols (names of
|
||||||
|
functions.)
|
||||||
|
|
||||||
|
joy ::= term*
|
||||||
|
|
||||||
|
term ::= integer | bool | '[' joy ']' | symbol
|
||||||
|
|
||||||
|
integer ::= [ '-' | '+' ] ('0'...'9')+
|
||||||
|
bool ::= 'true' | 'false'
|
||||||
|
symbol ::= char+
|
||||||
|
|
||||||
|
char ::= <Any non-space other than '[' and ']'.>
|
||||||
|
|
||||||
|
There are a few wrinkles in the handling of blank space between terms
|
||||||
|
because we want to be able to omit it around brackets:
|
||||||
|
|
||||||
|
Valid expressions:
|
||||||
|
|
||||||
|
1 2 3
|
||||||
|
1[2]3
|
||||||
|
1 [ 2 ] 3
|
||||||
|
true
|
||||||
|
truedat (a symbol prefixed with the name of a boolean)
|
||||||
|
|
||||||
|
Invalid:
|
||||||
|
|
||||||
|
12three (symbols can't start with numbers, and this shouldn't parse
|
||||||
|
as [12 three].)
|
||||||
|
|
||||||
|
Symbols can be made of any non-blank characters except '['and ']' which
|
||||||
|
are fully reserved for list literals (aka "quotes"). 'true' and 'false'
|
||||||
|
would be valid symbols but they are reserved for Boolean literals.
|
||||||
|
|
||||||
|
Integers are converted to Prolog integers, symbols and bools to Prolog
|
||||||
|
atoms, and list literals to Prolog lists.
|
||||||
|
|
||||||
|
For now strings are neglected in favor of lists of numbers. (But there's
|
||||||
|
no support for parsing string notation and converting to lists of ints.)
|
||||||
|
|
||||||
|
First lex the stream of codes into tokens separated by square brackets
|
||||||
|
or whitespace. We keep the brackets and throw away the blanks.
|
||||||
|
*/
|
||||||
|
|
||||||
|
joy_lex([tok(Token)|Ls]) --> chars(Token), !, joy_lex(Ls).
|
||||||
|
joy_lex([ lbracket|Ls]) --> "[", !, joy_lex(Ls).
|
||||||
|
joy_lex([ rbracket|Ls]) --> "]", !, joy_lex(Ls).
|
||||||
|
|
||||||
|
joy_lex(Ls) --> [Space], {code_type(Space, space)}, !, joy_lex(Ls).
|
||||||
|
|
||||||
|
joy_lex([]) --> [].
|
||||||
|
|
||||||
|
% Then parse the tokens converting them to Prolog values and building up
|
||||||
|
% the list structures (if any.)
|
||||||
|
|
||||||
|
joy_parse([J|Js]) --> joy_term(J), !, joy_parse(Js).
|
||||||
|
joy_parse([]) --> [].
|
||||||
|
|
||||||
|
joy_term(list(J)) --> [lbracket], !, joy_parse(J), [rbracket].
|
||||||
|
joy_term(Atomic) --> [tok(Codes)], {joy_token(Atomic, Codes)}.
|
||||||
|
|
||||||
|
joy_token(int(I), Codes) :- number(I, Codes, []), !. % See dcg/basics.
|
||||||
|
joy_token(bool(true), `true`) :- !.
|
||||||
|
joy_token(bool(false), `false`) :- !.
|
||||||
|
joy_token(symbol(S), Codes) :- atom_codes(S, Codes).
|
||||||
|
|
||||||
|
|
||||||
|
text_to_expression(Text, Expression) :-
|
||||||
|
phrase(joy_lex(Tokens), Text), !,
|
||||||
|
phrase(joy_parse(Expression), Tokens).
|
||||||
|
|
||||||
|
% Apologies for all the (green, I hope) cuts. The strength of the Joy
|
||||||
|
% syntax is that it's uninteresting.
|
||||||
|
|
||||||
|
chars([Ch|Rest]) --> char(Ch), chars(Rest).
|
||||||
|
chars([Ch]) --> char(Ch).
|
||||||
|
|
||||||
|
char(Ch) --> [Ch], {Ch \== 0'[, Ch \== 0'], code_type(Ch, graph)}.
|
||||||
|
|
||||||
|
|
||||||
|
/* Here is an example of Joy code:
|
||||||
|
|
||||||
|
[ [[abs] ii <=]
|
||||||
|
[
|
||||||
|
[<>] [pop !-] ||
|
||||||
|
] &&
|
||||||
|
]
|
||||||
|
[[ !-] [[++]] [[--]] ifte dip]
|
||||||
|
[[pop !-] [--] [++] ifte ]
|
||||||
|
ifte
|
||||||
|
|
||||||
|
It probably seems unreadable but with a little familiarity it becomes
|
||||||
|
just as legible as any other notation. This function accepts two
|
||||||
|
integers on the stack and increments or decrements one of them such that
|
||||||
|
the new pair of numbers is the next coordinate pair in a square spiral
|
||||||
|
(like that used to construct an Ulam Spiral). It is adapted from the
|
||||||
|
code in the answer here:
|
||||||
|
|
||||||
|
https://stackoverflow.com/questions/398299/looping-in-a-spiral/31864777#31864777
|
||||||
|
|
||||||
|
It can be used with the x combinator to make a kind of generator for
|
||||||
|
spiral square coordinates.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
███████╗███████╗███╗ ███╗ █████╗ ███╗ ██╗████████╗██╗ ██████╗███████╗
|
||||||
|
██╔════╝██╔════╝████╗ ████║██╔══██╗████╗ ██║╚══██╔══╝██║██╔════╝██╔════╝
|
||||||
|
███████╗█████╗ ██╔████╔██║███████║██╔██╗ ██║ ██║ ██║██║ ███████╗
|
||||||
|
╚════██║██╔══╝ ██║╚██╔╝██║██╔══██║██║╚██╗██║ ██║ ██║██║ ╚════██║
|
||||||
|
███████║███████╗██║ ╚═╝ ██║██║ ██║██║ ╚████║ ██║ ██║╚██████╗███████║
|
||||||
|
╚══════╝╚══════╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═══╝ ╚═╝ ╚═╝ ╚═════╝╚══════╝
|
||||||
|
|
||||||
|
The fundamental Joy relation involves an expression and two stacks. One
|
||||||
|
stack serves as input and the other as output.
|
||||||
|
|
||||||
|
thun(Expression, InputStack, OutputStack)
|
||||||
|
|
||||||
|
The null expression (denoted by an empty Prolog list) is effectively an
|
||||||
|
identity function and serves as the end-of-processing marker. As a
|
||||||
|
matter of efficiency (of Prolog) the thun/3 predicate picks off the first
|
||||||
|
term of the expression (if any) and passes it to thun/4 which can then
|
||||||
|
take advantage of Prolog indexing on the first term of a predicate. */
|
||||||
|
|
||||||
|
thun([], S, S).
|
||||||
|
thun([Term|E], Si, So) :- thun(Term, E, Si, So).
|
||||||
|
|
||||||
|
/* The thun/4 predicate was originally written in terms of the thun/3
|
||||||
|
predicate, which was very elegant, but prevented (I assume but have not
|
||||||
|
checked) tail-call recursion. In order to alleviate this, partial
|
||||||
|
reduction is used to generate the actual thun/4 rules, see below.
|
||||||
|
|
||||||
|
Original thun/4 code:
|
||||||
|
|
||||||
|
thun(int(I), E, Si, So) :- thun(E, [ int(I)|Si], So).
|
||||||
|
thun(bool(B), E, Si, So) :- thun(E, [bool(B)|Si], So).
|
||||||
|
thun(list(L), E, Si, So) :- thun(E, [list(L)|Si], So).
|
||||||
|
thun(symbol(Def), E, Si, So) :- def(Def, Body), append(Body, E, Eo), thun(Eo, Si, So).
|
||||||
|
thun(symbol(Func), E, Si, So) :- func(Func, Si, S), thun(E, S, So).
|
||||||
|
thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
|
||||||
|
|
||||||
|
Integers, Boolean values, and lists are put onto the stack, symbols are
|
||||||
|
dispatched to one of three kinds of processing: functions, combinators
|
||||||
|
and definitions (see "defs.txt".) */
|
||||||
|
|
||||||
|
thun(A, [], S, [A|S]) :- var(A), !.
|
||||||
|
thun(A, [T|E], S, So) :- var(A), !, thun(T, E, [A|S], So).
|
||||||
|
|
||||||
|
% Literals turn out okay.
|
||||||
|
|
||||||
|
thun(int(A), [], B, [int(A)|B]).
|
||||||
|
thun(int(C), [A|B], D, E) :- thun(A, B, [int(C)|D], E).
|
||||||
|
|
||||||
|
thun(bool(A), [], B, [bool(A)|B]).
|
||||||
|
thun(bool(C), [A|B], D, E) :- thun(A, B, [bool(C)|D], E).
|
||||||
|
|
||||||
|
thun(list(A), [], B, [list(A)|B]).
|
||||||
|
thun(list(C), [A|B], D, E) :- thun(A, B, [list(C)|D], E).
|
||||||
|
|
||||||
|
% Partial reduction works for func/3 cases.
|
||||||
|
|
||||||
|
thun(symbol(A), [], B, C) :- func(A, B, C).
|
||||||
|
thun(symbol(A), [C|D], B, F) :- func(A, B, E), thun(C, D, E, F).
|
||||||
|
|
||||||
|
% Combinators look ok too.
|
||||||
|
|
||||||
|
% thun(symbol(A), D, B, C) :- combo(A, B, C, D, []).
|
||||||
|
% thun(symbol(A), C, B, G) :- combo(A, B, F, C, [D|E]), thun(D, E, F, G).
|
||||||
|
|
||||||
|
% However, in this case, I think the original version will be more
|
||||||
|
% efficient.
|
||||||
|
|
||||||
|
thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
|
||||||
|
|
||||||
|
% In the reduced rules Prolog will redo all the work of the combo/5
|
||||||
|
% predicate on backtracking through the second rule. It will try
|
||||||
|
% combo/5, which usually won't end in Eo=[] so the first rule fails, then
|
||||||
|
% it will try combo/5 again in the second rule. In the original form
|
||||||
|
% after combo/5 has completed Prolog has computed Eo and can index on it
|
||||||
|
% for thun/3.
|
||||||
|
%
|
||||||
|
% Neither functions nor definitions can affect the expression so this
|
||||||
|
% consideration doesn't apply to those rules. The unification of the
|
||||||
|
% head clauses will distinguish the cases for them.
|
||||||
|
|
||||||
|
% Definitions don't work though (See "Partial Reducer" section below.)
|
||||||
|
% I hand-wrote the def/3 cases here.
|
||||||
|
|
||||||
|
thun(symbol(D), [], Si, So) :- def(D, [DH| E]), thun(DH, E, Si, So).
|
||||||
|
thun(symbol(D), [H|E0], Si, So) :- def(D, [DH|DE]),
|
||||||
|
append(DE, [H|E0], E), /* ................. */ thun(DH, E, Si, So).
|
||||||
|
|
||||||
|
% Partial reduction has been the subject of a great deal of research and
|
||||||
|
% I'm sure there's a way to make definitions work, but it's beyond the
|
||||||
|
% scope of the project at the moment. It works well enough as-is that I'm
|
||||||
|
% happy to manually write out two rules by hand.
|
||||||
|
|
||||||
|
% Some error handling.
|
||||||
|
|
||||||
|
thun(symbol(Unknown), _, _, _) :-
|
||||||
|
\+ def(Unknown, _),
|
||||||
|
\+ func(Unknown, _, _),
|
||||||
|
\+ combo(Unknown, _, _, _, _),
|
||||||
|
write("Unknown: "),
|
||||||
|
writeln(Unknown),
|
||||||
|
fail.
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
███████╗██╗ ██╗███╗ ██╗ ██████╗████████╗██╗ ██████╗ ███╗ ██╗███████╗
|
||||||
|
██╔════╝██║ ██║████╗ ██║██╔════╝╚══██╔══╝██║██╔═══██╗████╗ ██║██╔════╝
|
||||||
|
█████╗ ██║ ██║██╔██╗ ██║██║ ██║ ██║██║ ██║██╔██╗ ██║███████╗
|
||||||
|
██╔══╝ ██║ ██║██║╚██╗██║██║ ██║ ██║██║ ██║██║╚██╗██║╚════██║
|
||||||
|
██║ ╚██████╔╝██║ ╚████║╚██████╗ ██║ ██║╚██████╔╝██║ ╚████║███████║
|
||||||
|
╚═╝ ╚═════╝ ╚═╝ ╚═══╝ ╚═════╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚══════╝
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
func(words, S, [Words|S]) :- words(Words).
|
||||||
|
|
||||||
|
func(swap, [A, B|S], [B, A|S]).
|
||||||
|
func(dup, [A|S], [A, A|S]).
|
||||||
|
func(pop, [_|S], S ).
|
||||||
|
|
||||||
|
func(cons, [list(A), B |S], [list([B|A])|S]).
|
||||||
|
func(concat, [list(A), list(B)|S], [list(C)|S]) :- append(B, A, C).
|
||||||
|
func(flatten, [list(A)|S], [list(B)|S]) :- flatten(A, B).
|
||||||
|
func(swaack, [list(R)|S], [list(S)|R]).
|
||||||
|
func(stack, S , [list(S)|S]).
|
||||||
|
func(clear, _ , []).
|
||||||
|
func(first, [list([X|_])|S], [ X |S]).
|
||||||
|
func(rest, [list([_|X])|S], [list(X)|S]).
|
||||||
|
func(unit, [X|S], [list([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(dupdd, [A, B, C|D], [A, B, C, C|D]).
|
||||||
|
|
||||||
|
% func(stackd, [A|B], [A, list(B)|B]). % Doesn't compile.
|
||||||
|
|
||||||
|
func(shift, [list([B|A]), list(C)|D], [list(A), list([B|C])|D]).
|
||||||
|
|
||||||
|
func(rollup, Si, So) :- func(rolldown, So, Si).
|
||||||
|
func(uncons, Si, So) :- func(cons, So, Si).
|
||||||
|
|
||||||
|
func(bool, [ int(0)|S], [bool(false)|S]).
|
||||||
|
func(bool, [ list([])|S], [bool(false)|S]).
|
||||||
|
func(bool, [bool(false)|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func(bool, [ int(N)|S], [bool(true)|S]) :- N #\= 0.
|
||||||
|
func(bool, [list([_|_])|S], [bool(true)|S]).
|
||||||
|
func(bool, [ bool(true)|S], [bool(true)|S]).
|
||||||
|
% func(bool, [A|S], [bool(true)|S]) :- \+ func(bool, [A], [bool(false)]).
|
||||||
|
|
||||||
|
func('empty?', [ list([])|S], [ bool(true)|S]).
|
||||||
|
func('empty?', [ list([_|_])|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func('list?', [ list(_)|S], [ bool(true)|S]).
|
||||||
|
func('list?', [ bool(_)|S], [bool(false)|S]).
|
||||||
|
func('list?', [ int(_)|S], [bool(false)|S]).
|
||||||
|
func('list?', [symbol(_)|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func('one-or-more?', [list([_|_])|S], [ bool(true)|S]).
|
||||||
|
func('one-or-more?', [ list([])|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func(and, [bool(true), bool(true)|S], [ bool(true)|S]).
|
||||||
|
func(and, [bool(true), bool(false)|S], [bool(false)|S]).
|
||||||
|
func(and, [bool(false), bool(true)|S], [bool(false)|S]).
|
||||||
|
func(and, [bool(false), bool(false)|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func(or, [bool(true), bool(true)|S], [ bool(true)|S]).
|
||||||
|
func(or, [bool(true), bool(false)|S], [ bool(true)|S]).
|
||||||
|
func(or, [bool(false), bool(true)|S], [ bool(true)|S]).
|
||||||
|
func(or, [bool(false), bool(false)|S], [bool(false)|S]).
|
||||||
|
|
||||||
|
func( + , [int(A), int(B)|S], [int(A + B)|S]).
|
||||||
|
func( - , [int(A), int(B)|S], [int(B - A)|S]).
|
||||||
|
func( * , [int(A), int(B)|S], [int(A * B)|S]).
|
||||||
|
func( / , [int(A), int(B)|S], [int(B div A)|S]).
|
||||||
|
func('%', [int(A), int(B)|S], [int(B mod A)|S]).
|
||||||
|
% func( + , [int(A), int(B)|S], [int(C)|S]) :- C #= A + B.
|
||||||
|
% func( - , [int(A), int(B)|S], [int(C)|S]) :- C #= B - A.
|
||||||
|
% func( * , [int(A), int(B)|S], [int(C)|S]) :- C #= A * B.
|
||||||
|
% func( / , [int(A), int(B)|S], [int(C)|S]) :- C #= B div A.
|
||||||
|
% func('%', [int(A), int(B)|S], [int(C)|S]) :- C #= B mod A.
|
||||||
|
|
||||||
|
func('/%', [int(A), int(B)|S], [int(B div A), int(B mod A)|S]).
|
||||||
|
func( pm , [int(A), int(B)|S], [int(A + B), int(B - A)|S]).
|
||||||
|
% func('/%', [int(A), int(B)|S], [int(C), int(D)|S]) :- C #= B div A, D #= B mod A.
|
||||||
|
% func( pm , [int(A), int(B)|S], [int(C), int(D)|S]) :- C #= A + B, D #= B - A.
|
||||||
|
|
||||||
|
func(>, [int(A), int(B)|S], [ bool(B > A)|S]).
|
||||||
|
func(<, [int(A), int(B)|S], [ bool(B < A)|S]).
|
||||||
|
func(=, [int(A), int(B)|S], [ bool(eq(B, A))|S]).
|
||||||
|
func(>=, [int(A), int(B)|S], [ bool(B >= A)|S]).
|
||||||
|
func(<=, [int(A), int(B)|S], [ bool(B =< A)|S]).
|
||||||
|
func(<>, [int(A), int(B)|S], [bool(neq(B, A))|S]).
|
||||||
|
% func(>, [int(A), int(B)|S], [T|S]) :- B #> A #<==> R, r_truth(R, T).
|
||||||
|
% func(<, [int(A), int(B)|S], [T|S]) :- B #< A #<==> R, r_truth(R, T).
|
||||||
|
% func(=, [int(A), int(B)|S], [T|S]) :- B #= A #<==> R, r_truth(R, T).
|
||||||
|
% func(>=, [int(A), int(B)|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T).
|
||||||
|
% func(<=, [int(A), int(B)|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T).
|
||||||
|
% func(<>, [int(A), int(B)|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T).
|
||||||
|
|
||||||
|
func(sqr) --> func(dup), func(mul). % Pretty neat.
|
||||||
|
|
||||||
|
r_truth(0, bool(false)).
|
||||||
|
r_truth(1, bool(true)).
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
██████╗ ██████╗ ███╗ ███╗██████╗ ██╗███╗ ██╗ █████╗ ████████╗ ██████╗ ██████╗ ███████╗
|
||||||
|
██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║████╗ ██║██╔══██╗╚══██╔══╝██╔═══██╗██╔══██╗██╔════╝
|
||||||
|
██║ ██║ ██║██╔████╔██║██████╔╝██║██╔██╗ ██║███████║ ██║ ██║ ██║██████╔╝███████╗
|
||||||
|
██║ ██║ ██║██║╚██╔╝██║██╔══██╗██║██║╚██╗██║██╔══██║ ██║ ██║ ██║██╔══██╗╚════██║
|
||||||
|
╚██████╗╚██████╔╝██║ ╚═╝ ██║██████╔╝██║██║ ╚████║██║ ██║ ██║ ╚██████╔╝██║ ██║███████║
|
||||||
|
╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚═════╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═╝╚══════╝
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
combo(i, [list(P)|S], S, Ei, Eo) :- append(P, Ei, Eo).
|
||||||
|
combo(dip, [list(P), X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo).
|
||||||
|
combo(dipd, [list(P), X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo).
|
||||||
|
|
||||||
|
combo(dupdip, [list(P), X|S], [X|S], Ei, Eo) :- append(P, [X|Ei], Eo).
|
||||||
|
|
||||||
|
combo(branch, [list(T), list(_), bool(true)|S], S, Ei, Eo) :- append(T, Ei, Eo).
|
||||||
|
combo(branch, [list(_), list(F), bool(false)|S], S, Ei, Eo) :- append(F, Ei, Eo).
|
||||||
|
|
||||||
|
combo(loop, [list(_), bool(false)|S], S, E, E ).
|
||||||
|
combo(loop, [list(B), bool(true)|S], S, Ei, Eo) :- append(B, [list(B), symbol(loop)|Ei], Eo).
|
||||||
|
|
||||||
|
combo(step, [list(_), list([])|S], S, E, E ).
|
||||||
|
combo(step, [list(P), list([X|Z])|S], [X|S], Ei, Eo) :- append(P, [list(Z), list(P), symbol(step)|Ei], Eo).
|
||||||
|
|
||||||
|
combo(times, [list(_), int(0)|S], S, E, E ).
|
||||||
|
combo(times, [list(P), int(1)|S], S, Ei, Eo) :- append(P, Ei, Eo).
|
||||||
|
combo(times, [list(P), int(N)|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [int(M), list(P), symbol(times)|Ei], Eo).
|
||||||
|
combo(times, [list(_), int(N)|S], S, _, _ ) :- N #< 0, fail.
|
||||||
|
|
||||||
|
combo(genrec, [R1, R0, Then, If|S],
|
||||||
|
[ Else, Then, If|S], E, [symbol(ifte)|E]) :-
|
||||||
|
append(R0, [list([If, Then, R0, R1, symbol(genrec)])|R1], Else).
|
||||||
|
|
||||||
|
/*
|
||||||
|
This is a crude but servicable implementation of the map combinator.
|
||||||
|
|
||||||
|
Obviously it would be nice to take advantage of the implied parallelism.
|
||||||
|
Instead the quoted program, stack, and terms in the input list are
|
||||||
|
transformed to simple Joy expressions that run the quoted program on
|
||||||
|
prepared copies of the stack that each have one of the input terms on
|
||||||
|
top. These expressions are collected in a list and the whole thing is
|
||||||
|
evaluated (with infra) on an empty list, which becomes the output list.
|
||||||
|
|
||||||
|
The chief advantage of doing it this way (as opposed to using Prolog's
|
||||||
|
map) is that the whole state remains in the pending expression, so
|
||||||
|
there's nothing stashed in Prolog's call stack. This preserves the nice
|
||||||
|
property that you can interrupt the Joy evaluation and save or transmit
|
||||||
|
the stack+expression knowing that you have all the state.
|
||||||
|
*/
|
||||||
|
|
||||||
|
combo(map, [list(_), list([])|S], [list([])|S], E, E ) :- !.
|
||||||
|
combo(map, [list(P), list(List)|S], [list(Mapped), list([])|S], E, [symbol(infra)|E]) :-
|
||||||
|
prepare_mapping(list(P), S, List, Mapped).
|
||||||
|
|
||||||
|
% Set up a program for each term in ListIn
|
||||||
|
%
|
||||||
|
% [term S] [P] infrst
|
||||||
|
%
|
||||||
|
% prepare_mapping(P, S, ListIn, ListOut).
|
||||||
|
|
||||||
|
prepare_mapping(Pl, S, In, Out) :- prepare_mapping(Pl, S, In, [], Out).
|
||||||
|
|
||||||
|
prepare_mapping( _, _, [], Out, Out) :- !.
|
||||||
|
prepare_mapping( Pl, S, [T|In], Acc, Out) :-
|
||||||
|
prepare_mapping(Pl, S, In, [list([T|S]), Pl, symbol(infrst)|Acc], Out).
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
██████╗ ███████╗███████╗██╗███╗ ██╗██╗████████╗██╗ ██████╗ ███╗ ██╗███████╗
|
||||||
|
██╔══██╗██╔════╝██╔════╝██║████╗ ██║██║╚══██╔══╝██║██╔═══██╗████╗ ██║██╔════╝
|
||||||
|
██║ ██║█████╗ █████╗ ██║██╔██╗ ██║██║ ██║ ██║██║ ██║██╔██╗ ██║███████╗
|
||||||
|
██║ ██║██╔══╝ ██╔══╝ ██║██║╚██╗██║██║ ██║ ██║██║ ██║██║╚██╗██║╚════██║
|
||||||
|
██████╔╝███████╗██║ ██║██║ ╚████║██║ ██║ ██║╚██████╔╝██║ ╚████║███████║
|
||||||
|
╚═════╝ ╚══════╝╚═╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚══════╝
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
joy_def(Codes) :-
|
||||||
|
text_to_expression(Codes, [symbol(Name)|Body]),
|
||||||
|
% writeln(Name),
|
||||||
|
assert_def(Name, Body).
|
||||||
|
|
||||||
|
assert_defs(DefsFile) :-
|
||||||
|
read_file_to_codes(DefsFile, Codes, []),
|
||||||
|
lines(Codes, Lines),
|
||||||
|
maplist(joy_def, Lines).
|
||||||
|
|
||||||
|
assert_def(Symbol, Body) :-
|
||||||
|
( % Don't let this "shadow" functions or combinators.
|
||||||
|
\+ func(Symbol, _, _),
|
||||||
|
\+ combo(Symbol, _, _, _, _)
|
||||||
|
) -> ( % Replace any existing defs of this name.
|
||||||
|
retractall(def(Symbol, _)),
|
||||||
|
assertz(def(Symbol, Body))
|
||||||
|
) ; true.
|
||||||
|
|
||||||
|
% Split on newline chars a list of codes into a list of lists of codes
|
||||||
|
% one per line. Helper function.
|
||||||
|
lines([], []) :- !.
|
||||||
|
lines(Codes, [Line|Lines]) :- append(Line, [0'\n|Rest], Codes), !, lines(Rest, Lines).
|
||||||
|
lines(Codes, [Codes]).
|
||||||
|
|
||||||
|
:- assert_defs("defs.txt").
|
||||||
|
|
||||||
|
|
||||||
|
% A meta function that finds the names of all available functions.
|
||||||
|
|
||||||
|
words(Words) :-
|
||||||
|
findall(Name, clause(func(Name, _, _), _), Funcs),
|
||||||
|
findall(Name, clause(combo(Name, _, _, _, _), _), Combos, Funcs),
|
||||||
|
findall(Name, clause(def(Name, _), _), Words0, Combos),
|
||||||
|
list_to_set(Words0, Words1),
|
||||||
|
sort(Words1, Words).
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
██████╗ ██████╗ ███╗ ███╗██████╗ ██╗██╗ ███████╗██████╗
|
||||||
|
██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║██║ ██╔════╝██╔══██╗
|
||||||
|
██║ ██║ ██║██╔████╔██║██████╔╝██║██║ █████╗ ██████╔╝
|
||||||
|
██║ ██║ ██║██║╚██╔╝██║██╔═══╝ ██║██║ ██╔══╝ ██╔══██╗
|
||||||
|
╚██████╗╚██████╔╝██║ ╚═╝ ██║██║ ██║███████╗███████╗██║ ██║
|
||||||
|
╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚══════╝╚══════╝╚═╝ ╚═╝
|
||||||
|
_ ___ _ _
|
||||||
|
| |_ ___ | _ \_ _| |_| |_ ___ _ _
|
||||||
|
| _/ _ \ | _/ || | _| ' \/ _ \ ' \
|
||||||
|
\__\___/ |_| \_, |\__|_||_\___/_||_|
|
||||||
|
|__/
|
||||||
|
|
||||||
|
|
||||||
|
We have a tabulator predicate.
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
tabs(N) --> { N #> 0, M #= N - 1 },
|
||||||
|
tab, tabs(M).
|
||||||
|
|
||||||
|
tabs(0) --> [].
|
||||||
|
|
||||||
|
nl --> "\n".
|
||||||
|
|
||||||
|
tab --> " ".
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
Convert Prolog terms to Python source.
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
% stack_to_python(F) --> { writeln(F), fail }.
|
||||||
|
|
||||||
|
stack_to_python(S) --> {atom(S), !, atom_codes(S, C)}, C.
|
||||||
|
stack_to_python([]) --> "stack", !.
|
||||||
|
stack_to_python([Term|Tail]) -->
|
||||||
|
"(", term_to_python(Term), ", ", stack_to_python(Tail), ")".
|
||||||
|
|
||||||
|
|
||||||
|
% Unify unbound terms with fresh Python identifiers.
|
||||||
|
pyvar(Prefix, Term, Codes) :-
|
||||||
|
( var(Term) -> gensym(Prefix, Term) ; atom(Term) ),
|
||||||
|
atom_codes(Term, Codes).
|
||||||
|
|
||||||
|
term_to_python(Term) -->
|
||||||
|
{ pyvar(v, Term, Var) }, !, Var.
|
||||||
|
|
||||||
|
term_to_python(bool(Term)) --> term_to_python(Term).
|
||||||
|
|
||||||
|
term_to_python(int(Term)) -->
|
||||||
|
{ ( integer(Term) ->
|
||||||
|
number_codes(Term, Int)
|
||||||
|
;
|
||||||
|
pyvar(i, Term, Int)
|
||||||
|
)
|
||||||
|
},
|
||||||
|
Int.
|
||||||
|
|
||||||
|
term_to_python(list(Term)) --> list_to_python(Term).
|
||||||
|
|
||||||
|
term_to_python(Term) --> Term.
|
||||||
|
|
||||||
|
|
||||||
|
list_to_python(Term) -->
|
||||||
|
{ pyvar(s, Term, Var) }, !, Var.
|
||||||
|
|
||||||
|
list_to_python([]) --> "()", !.
|
||||||
|
|
||||||
|
list_to_python([Term|Tail]) -->
|
||||||
|
"(", term_to_python(Term), ", ", list_to_python(Tail), ")".
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
Generate Python code.
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
code_gen([Head|Tail]) --> Head, code_gen(Tail).
|
||||||
|
code_gen([]) --> [].
|
||||||
|
|
||||||
|
cg, Term --> [Term], cg.
|
||||||
|
cg --> [].
|
||||||
|
|
||||||
|
compile_fn(Name) --> gronk_fn(Name), cg, !.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
|
||||||
|
|
||||||
|
██████╗ ██████╗ ██████╗ ███╗ ██╗██╗ ██╗
|
||||||
|
██╔════╝ ██╔══██╗██╔═══██╗████╗ ██║██║ ██╔╝
|
||||||
|
██║ ███╗██████╔╝██║ ██║██╔██╗ ██║█████╔╝
|
||||||
|
██║ ██║██╔══██╗██║ ██║██║╚██╗██║██╔═██╗
|
||||||
|
╚██████╔╝██║ ██║╚██████╔╝██║ ╚████║██║ ██╗
|
||||||
|
╚═════╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚═╝ ╚═╝
|
||||||
|
|
||||||
|
(GRONK stands for "I am bad at naming things.")
|
||||||
|
|
||||||
|
With gronk we're juggling four things:
|
||||||
|
|
||||||
|
The incoming joy expression
|
||||||
|
The outgoing code tokens (for the code gen)
|
||||||
|
The incoming stack representation
|
||||||
|
and outgoing stack representation
|
||||||
|
|
||||||
|
The basic formula is like so (the indent level is an implementation
|
||||||
|
detail):
|
||||||
|
|
||||||
|
gronk_fn_body(
|
||||||
|
[joy expression]
|
||||||
|
StackIn,
|
||||||
|
StackOut,
|
||||||
|
[code gen tokens]
|
||||||
|
).
|
||||||
|
|
||||||
|
(Let's leave out DCGs for now, eh? Since I don't actually know how they
|
||||||
|
work really yet, do I? ;P )
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
gronk_fn(Name, Expr, CodeGens)
|
||||||
|
:-
|
||||||
|
CodeGens = ["def ", Name,"(stack, expression, dictionary):", nl,
|
||||||
|
tab, stack_to_python(StackIn), " = stack", nl|Cs],
|
||||||
|
CGTail = [tab, "return ", stack_to_python(StackOut), ", expression, dictionary", nl],
|
||||||
|
reset_gensym(s), reset_gensym(v), reset_gensym(i),
|
||||||
|
gronk_fn_list(Expr, StackIn, StackOut, CGTail, Cs, 1).
|
||||||
|
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[list(BodyFalse), list(BodyTrue), symbol(branch)|Js],
|
||||||
|
[bool(B)|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
CodeGens,
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!,
|
||||||
|
J #= IndentLevel + 1,
|
||||||
|
CodeGens = [
|
||||||
|
tabs(IndentLevel), "if ", term_to_python(B), ":", nl|Cs0],
|
||||||
|
True = [tabs(J), stack_to_python(Stack), " = ", stack_to_python(StackT), nl,
|
||||||
|
tabs(IndentLevel), "else:", nl|Cs1],
|
||||||
|
False = [tabs(J), stack_to_python(Stack), " = ", stack_to_python(StackF), nl|Ck],
|
||||||
|
gronk_fn_list(BodyTrue, StackIn, StackT, True, Cs0, J),
|
||||||
|
gronk_fn_list(BodyFalse, StackIn, StackF, False, Cs1, J),
|
||||||
|
gronk_fn_list(Js, Stack, StackOut, CGTail, Ck, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[list(Body), symbol(loop)|Js],
|
||||||
|
[bool(B)|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
CodeGens,
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!,
|
||||||
|
J #= IndentLevel + 1,
|
||||||
|
CodeGens = [
|
||||||
|
tabs(IndentLevel), term_to_python(Tos), " = ", term_to_python(B), nl,
|
||||||
|
tabs(IndentLevel), "while ", term_to_python(Tos), ":", nl|Cs
|
||||||
|
],
|
||||||
|
gronk_fn_list(Body, StackIn, [bool(Tos)|Stack], [tabs(J), stack_to_python(StackIn), " = ", stack_to_python(Stack), nl|Ck], Cs, J),
|
||||||
|
gronk_fn_list(Js, StackIn, StackOut, CGTail, Ck, IndentLevel).
|
||||||
|
% ^^^^^^^ wha!? not Stack!?
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[list(Body), symbol(dip)|Js],
|
||||||
|
[Term|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
Cs,
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!,
|
||||||
|
gronk_fn_list(Body, StackIn, Stack, Ck, Cs, IndentLevel),
|
||||||
|
gronk_fn_list(Js, [Term|Stack], StackOut, CGTail, Ck, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(step)|Js],
|
||||||
|
[list(Body), list(B)|Stack0],
|
||||||
|
Stack,
|
||||||
|
CGTail,
|
||||||
|
CodeGens,
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!,
|
||||||
|
J #= IndentLevel + 1,
|
||||||
|
CodeGens = [
|
||||||
|
tabs(IndentLevel), stack_to_python(Stack1), " = ", stack_to_python(Stack0), nl,
|
||||||
|
tabs(IndentLevel), "while ", term_to_python(B), ":", nl,
|
||||||
|
tabs(J), "(", term_to_python(T), ", ", term_to_python(B), ") = ", term_to_python(B), nl|CG2
|
||||||
|
],
|
||||||
|
CG1 = [tabs(J), stack_to_python(Stack1), " = ", stack_to_python(Stack2), nl|CG0],
|
||||||
|
gronk_fn_list(Body, [T|Stack1], Stack2, CG1, CG2, J),
|
||||||
|
gronk_fn_list(Js, Stack1, Stack, CGTail, CG0, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(abs)|Js],
|
||||||
|
[In|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
[tabs(IndentLevel), term_to_python(Out), " = abs(", term_to_python(In), ")", nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!, % green cut
|
||||||
|
gronk_fn_list(Js, [Out|StackIn], StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(bool)|Js],
|
||||||
|
[In|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
[tabs(IndentLevel), term_to_python(Out), " = bool(", term_to_python(In), ")", nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!, % green cut
|
||||||
|
gronk_fn_list(Js, [bool(Out)|StackIn], StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(stack)|Js],
|
||||||
|
StackIn,
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
[tabs(IndentLevel), stack_to_python(Stack), " = (", stack_to_python(StackIn), ", ", stack_to_python(StackIn), ")", nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!, % green cut
|
||||||
|
gronk_fn_list(Js, Stack, StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(swaack)|Js],
|
||||||
|
[list(S)|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
% [tabs(IndentLevel), "pass", nl|Cs],
|
||||||
|
[tabs(IndentLevel), stack_to_python(Stack), " = (", stack_to_python(StackIn), ", ", stack_to_python(S), ")", nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
!, % green cut
|
||||||
|
gronk_fn_list(Js, Stack, StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(Sym)|Js],
|
||||||
|
[int(B), int(A)|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
[tabs(IndentLevel), term_to_python(int(C)), " = ", term_to_python(int(A)), Op, term_to_python(int(B)), nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
bin_math_op(Sym, Op), !, % green cut
|
||||||
|
gronk_fn_list(Js, [int(C)|StackIn], StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list(
|
||||||
|
[symbol(Sym)|Js],
|
||||||
|
[int(B), int(A)|StackIn],
|
||||||
|
StackOut,
|
||||||
|
CGTail,
|
||||||
|
[tabs(IndentLevel), term_to_python(bool(C)), " = ", term_to_python(int(A)), Op, term_to_python(int(B)), nl|Cs],
|
||||||
|
IndentLevel)
|
||||||
|
:-
|
||||||
|
bin_bool_op(Sym, Op), !, % green cut
|
||||||
|
gronk_fn_list(Js, [bool(C)|StackIn], StackOut, CGTail, Cs, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([symbol(Sym)|Js], S0, S, C0, C, IndentLevel) :-
|
||||||
|
yin(Sym),
|
||||||
|
func(Sym, S0, S1), !, % green cut
|
||||||
|
gronk_fn_list(Js, S1, S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([symbol(Sym)|Js], S0, S, C0, C, IndentLevel) :-
|
||||||
|
yin(Sym),
|
||||||
|
def(Sym, Body), !, % green cut
|
||||||
|
append(Body, Js, Expr),
|
||||||
|
gronk_fn_list(Expr, S0, S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([bool(true)|Js], S0, S, C0, C, IndentLevel) :- !, % green cut
|
||||||
|
gronk_fn_list(Js, [bool("True")|S0], S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([bool(false)|Js], S0, S, C0, C, IndentLevel) :- !, % green cut
|
||||||
|
gronk_fn_list(Js, [bool("False")|S0], S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([int(I)|Js], S0, S, C0, C, IndentLevel) :- !, % green cut
|
||||||
|
gronk_fn_list(Js, [int(I)|S0], S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([list(L)|Js], S0, S, C0, C, IndentLevel) :- !, % green cut
|
||||||
|
gronk_fn_list(Js, [list(L)|S0], S, C0, C, IndentLevel).
|
||||||
|
|
||||||
|
gronk_fn_list([], Stack, Stack, Cs, Cs, _).
|
||||||
|
|
||||||
|
|
||||||
|
bin_math_op(+, " + ").
|
||||||
|
bin_math_op(-, " - ").
|
||||||
|
bin_math_op(*, " * ").
|
||||||
|
bin_math_op(div, " // ").
|
||||||
|
bin_math_op( / , " // ").
|
||||||
|
bin_math_op(mod, " % ").
|
||||||
|
bin_math_op('%', " % ").
|
||||||
|
|
||||||
|
bin_bool_op(>, " > ").
|
||||||
|
bin_bool_op(<, " < ").
|
||||||
|
bin_bool_op(=, " == ").
|
||||||
|
bin_bool_op(>=, " >= ").
|
||||||
|
bin_bool_op(<=, " <= ").
|
||||||
|
bin_bool_op(<>, " != ").
|
||||||
|
|
||||||
|
yin(bool).
|
||||||
|
yin(cons).
|
||||||
|
yin(dip).
|
||||||
|
yin(dup).
|
||||||
|
yin(dupd).
|
||||||
|
yin(dupdd).
|
||||||
|
yin(first).
|
||||||
|
yin(gcd).
|
||||||
|
yin(over).
|
||||||
|
yin(pop).
|
||||||
|
yin(product).
|
||||||
|
yin(rest).
|
||||||
|
yin(rolldown).
|
||||||
|
yin(rollup).
|
||||||
|
yin(shift).
|
||||||
|
yin(step).
|
||||||
|
yin(stackd).
|
||||||
|
yin(sum).
|
||||||
|
yin(swap).
|
||||||
|
yin(tuck).
|
||||||
|
yin(uncons).
|
||||||
|
yin(unit).
|
||||||
|
yin(Sym) :- def(Sym, Body), maplist(yins, Body).
|
||||||
|
|
||||||
|
yins(int(_)).
|
||||||
|
yins(bool(_)).
|
||||||
|
yins(list(_)).
|
||||||
|
|
||||||
|
yins(symbol(Sym)) :- yin(Sym).
|
||||||
|
yins(symbol(Sym)) :- bin_math_op(Sym, _).
|
||||||
|
yins(symbol(Sym)) :- bin_bool_op(Sym, _).
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
concat
|
||||||
|
flatten
|
||||||
|
swaack
|
||||||
|
clear
|
||||||
|
bool+
|
||||||
|
|
||||||
|
list ops (empty? list? ...)
|
||||||
|
logic ops (and or ...)
|
||||||
|
|
||||||
|
COMBINATORS
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
gronk(Name, BodyText) :-
|
||||||
|
text_to_expression(BodyText, Expr),
|
||||||
|
gronk_fn(Name, Expr, Out),
|
||||||
|
code_gen(Out, A, []), !,
|
||||||
|
string_codes(S, A),
|
||||||
|
writeln(""),
|
||||||
|
writeln(S).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
do :-
|
||||||
|
gronk("abs", `abs`),
|
||||||
|
gronk("ccons", `ccons`),
|
||||||
|
gronk("cons", `cons`),
|
||||||
|
gronk("decr", `--`),
|
||||||
|
gronk("dup", `dup`),
|
||||||
|
gronk("dupd", `dupd`),
|
||||||
|
gronk("dupdd", `dupdd`),
|
||||||
|
gronk("first", `first`),
|
||||||
|
gronk("fourth", `fourth`),
|
||||||
|
gronk("incr", `++`),
|
||||||
|
gronk("non_negative", `!-`),
|
||||||
|
gronk("pop", `pop`),
|
||||||
|
gronk("popd", `popd`),
|
||||||
|
gronk("popop", `popop`),
|
||||||
|
gronk("popopd", `popopd`),
|
||||||
|
gronk("quoted", `quoted`),
|
||||||
|
gronk("reco", `reco`),
|
||||||
|
gronk("rest", `rest`),
|
||||||
|
gronk("rrest", `rrest`),
|
||||||
|
gronk("second", `second`),
|
||||||
|
gronk("shift", `shift`),
|
||||||
|
gronk("sqr", `sqr`),
|
||||||
|
gronk("stackd", `stackd`), % Compiling func(stackd, ...) doesn't work.
|
||||||
|
gronk("swons", `swons`),
|
||||||
|
gronk("third", `third`),
|
||||||
|
gronk("truthy", `?`),
|
||||||
|
gronk("tuckl", `<{}`),
|
||||||
|
gronk("tuckld", `<<{}`),
|
||||||
|
gronk("uncons", `uncons`),
|
||||||
|
gronk("unit", `unit`),
|
||||||
|
gronk("unswons", `unswons`),
|
||||||
|
gronk("gcd", `gcd`),
|
||||||
|
gronk("sum", `sum`),
|
||||||
|
gronk("product", `product`),
|
||||||
|
writeln("").
|
||||||
Loading…
Reference in New Issue