--- /dev/null
+/*
+
+████████╗██╗ ██╗██╗ ██╗███╗ ██╗
+╚══██╔══╝██║ ██║██║ ██║████╗ ██║
+ ██║ ███████║██║ ██║██╔██╗ ██║
+ ██║ ██╔══██║██║ ██║██║╚██╗██║
+ ██║ ██║ ██║╚██████╔╝██║ ╚████║
+ ╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝
+
+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("").
OSDN Git Service
