diff --git a/implementations/Prolog/CHANGELOG b/implementations/Prolog/CHANGELOG new file mode 100644 index 0000000..d7d5c8c --- /dev/null +++ b/implementations/Prolog/CHANGELOG @@ -0,0 +1,56 @@ + + +----------------------------------------- +Unreleased + +Added: + +- Some documentation for a few functors. +- A start on regression tests. + +Fixed: +- Blanks should parse as null expression. + + +----------------------------------------- +[-10.0.0] - 2020-2-1 + +Initial re-release as a Prolog project. See https://joypy.osdn.io/ for +the original Python 2 project. + +Added: + +- Parser & Grammar. +- Semantics (evaluation function.) +- Many functions, combinators, & definitions. +- Compiler to Prolog. +- (Unfinished) Compiler to machine code. +- Expand/Contract Definitions. +- Formatter (Joy expressions to strings.) +- Partial Reducer (transforms Prolog rules for greater efficiency.) + +Removed: + +- All the Python code. +- All the Jupyter notebooks. (I want to rework the content anyway. The + originals will remain up on the web at the same URLs (I think the web + hosting of OSDN allows for setting up 301s though, in case I want to move + them and redirect.)) +- All the GNU Prolog portage ( https://osdn.net/projects/joypy/scm/hg/Joypy/tree/tip/thun/gnu-prolog/ ) + This is another area where i want to rework the content. It's kind of + cool to compile Prolog to native code so easily. + + + + + +Appendix A: Types of changes + +See https://keepachangelog.com/en/1.0.0/ + +- 'Added' for new features. +- 'Changed' for changes in existing functionality. +- 'Deprecated' for soon-to-be removed features. +- 'Removed' for now removed features. +- 'Fixed' for any bug fixes. +- 'Security' in case of vulnerabilities. diff --git a/implementations/Prolog/README b/implementations/Prolog/README new file mode 100644 index 0000000..eb47c4f --- /dev/null +++ b/implementations/Prolog/README @@ -0,0 +1,211 @@ + _____ _ + |_ _| |_ _ _ _ _ + | | | ' \ || | ' \ + |_| |_||_\_,_|_||_| + +Thun + +"...as simple as possible, but no simpler." + +A dialect of Joy. + +Version -10.0.0. (Version -10 in case I want to change the names of some +functions before the first "real" release, and I'm more-or-less using +https://semver.org/ ) + +This project started life as part of a Python project called at first +Joypy but then later renamed (after someone claimed the name on PyPI +before me) to Thun in honor of Manfred Von Thun who created Joy. While +creating a type-inference system for it I realized that it would be much +easier and more flexible to do it in Prolog. In fact, the Prolog code +(using SWI Prolog) is so much more elegant than the Python version that, +combined with the recent deprecation of Python 2, it convinced me to +switch "whole-hog" to Prolog. (You can find the original project at: +https://joypy.osdn.io/ ) + + ___ _ ___ _ + | __|_ ____ _ _ __ _ __| |___ / __|___ __| |___ + | _|\ \ / _` | ' \| '_ \ / -_) | (__/ _ \/ _` / -_) + |___/_\_\__,_|_|_|_| .__/_\___| \___\___/\__,_\___| + |_| +Here is an example of Joy code: + + [[[abs]ii <=][[<>][pop !-]||]&&][[!-][[++]][[--]]ifte dip][[pop !-][--][++]ifte]ifte + +It might seem unreadable but with a little familiarity it becomes just as +legible as any other notation. Some layout helps: + + [ [[abs] ii <=] + [ + [<>] [pop !-] || + ] && + ] + [[ !-] [[++]] [[--]] ifte dip] + [[pop !-] [--] [++] ifte ] + ifte + +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 the kind used to construct an +Ulam Spiral). For more information see docs\notes\on-square-spiral.md + + ___ _ _ _ _ _ + | __| _ _ _ __| |_(_)___ _ _ __ _| (_) |_ _ _ + | _| || | ' \/ _| _| / _ \ ' \/ _` | | | _| || | + |_| \_,_|_||_\__|\__|_\___/_||_\__,_|_|_|\__|\_, | + __ _ _ _ __| | | _ \_ _ _ _ _ __ ___ ___ |__/ + / _` | ' \/ _` | | _/ || | '_| '_ \/ _ (_- cd source + + PS C:\Users\sforman\Desktop\src\PROLOG\Thun\source> swipl thun.pl + + Welcome to SWI-Prolog (threaded, 64 bits, version 8.1.4-33-gf5970a6e0) + SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software. + Please run ?- license. for legal details. + + For online help and background, visit http://www.swi-prolog.org + For built-in help, use ?- help(Topic). or ?- apropos(Word). + + 1 ?- + +Creating a better user interface is a big part of the "meta-project" +here, if you will. Thun/Joy is the language, the UI is the real project. +I'm thinking a server with multiple clients (web, native) just because +Prolog isn't fabulous at the nitty-gritty of UIs. There are other logic +languages that have e.g. reactive rules. Kowalski has a great thing: LPS +(Logic Production Systems) http://lps.doc.ic.ac.uk/ + +Anyhooo, for now there's not even a REPL. Use Prolog's. + +TODO: Explain the top-level predicates, with examples, this can be put in +the docs directory... + + ___ _ + | \ _____ _____| |___ _ __ ___ _ _ + | |) / -_) V / -_) / _ \ '_ \/ -_) '_| + |___/\___|\_/\___|_\___/ .__/\___|_| _ _ + | \ ___ __ _ _ _ __|_|__ _ _| |_ __ _| |_(_)___ _ _ + | |) / _ \/ _| || | ' \/ -_) ' \ _/ _` | _| / _ \ ' \ + |___/\___/\__|\_,_|_|_|_\___|_||_\__\__,_|\__|_\___/_||_| + +Developer Documentation + +Since there aren't yet any user-facing clients this is pretty much all +developer documentation. Until the UI side of the project is re-worked +this will mostly be of interest to people who are into formal semanics of +programming languages. + +If you already know Prolog then the code should be pretty simple and +straightforward. The partial reducer is documented in "The Art of +Prolog" so I won't repeat that here. Other than that there just really +isn't anything to crunchy in there. The signal virtual of Joy is it's +simplicity after all. + +Adding syntax should be avoided. At some point I'll likely add more +types, and maybe subtype relations between them. Maybe add the ability +to "tag" types from Joy itself (i.e. the ordered binary tree functions.) + + ___ _ _ _ _ _ + / __|___ _ _| |_ _ _(_) |__ _ _| |_(_)___ _ _ ___ + | (__/ _ \ ' \ _| '_| | '_ \ || | _| / _ \ ' \(_-< + \___\___/_||_\__|_| |_|_.__/\_,_|\__|_\___/_||_/__/ + +Contributions + +Well, aren't you sweet! GPL, docs please, "Be excellent to each other." + + ___ _ _ _ ___ _ _ + | _ )_ _(_) |__| | / __| |_ __ _| |_ _ _ ___ + | _ \ || | | / _` | \__ \ _/ _` | _| || (_-< + |___/\_,_|_|_\__,_| |___/\__\__,_|\__|\_,_/__/ + +Build Status + +No build, no status. diff --git a/implementations/Prolog/docs/dev-guide/partial-reduction.md b/implementations/Prolog/docs/dev-guide/partial-reduction.md new file mode 100644 index 0000000..0f5363b --- /dev/null +++ b/implementations/Prolog/docs/dev-guide/partial-reduction.md @@ -0,0 +1,7 @@ +The `source/gen-*.pl` files are created by `partial_reduce_thun/0`. I'm +just messing around with it at the moment. In theory the reduced forms +would be more efficient, but there's no pressure to improve performance +yet, and I'm not e.g. feeding the output to GNU Prolog to compile to +machine code, eh? + +It's just neat to see what the reducer makes of it. \ No newline at end of file diff --git a/implementations/Prolog/docs/notes/YUNO-color-arrows-right-like-this.PNG b/implementations/Prolog/docs/notes/YUNO-color-arrows-right-like-this.PNG new file mode 100644 index 0000000..93edd1d Binary files /dev/null and b/implementations/Prolog/docs/notes/YUNO-color-arrows-right-like-this.PNG differ diff --git a/implementations/Prolog/docs/notes/YUNO-color-arrows-right.PNG b/implementations/Prolog/docs/notes/YUNO-color-arrows-right.PNG new file mode 100644 index 0000000..b715bb3 Binary files /dev/null and b/implementations/Prolog/docs/notes/YUNO-color-arrows-right.PNG differ diff --git a/implementations/Prolog/docs/notes/abs-def-vs-func b/implementations/Prolog/docs/notes/abs-def-vs-func new file mode 100644 index 0000000..ce2ee07 --- /dev/null +++ b/implementations/Prolog/docs/notes/abs-def-vs-func @@ -0,0 +1,310 @@ +% With abs as a definition: abs ::= dup 0 < [] [neg] branch + +?- joy(`[abs] ii <=`, [int(A), int(C)], [bool(B)]). + +% Eight solutions: + +B = false, +A in 0..sup, +A#==C, +A+1#=_67204, +C in 0..sup, +C+1#=_67252, +_67252 in 1..sup, +_67204 in 1..sup ; + + +B = false, +A in inf.. -1, +_67892+A#=0, +A+1#=_67912, +_67892 in 1..sup, +_67892#==C, +C in 0..sup, +C+1#=_67834, +_67834 in 1..sup, +_67744 in inf..0 ; + + +B = false, +A in 0..sup, +A#=<_67850+ -1, +A+1#=_67870, +_67850 in 1..sup, +_67850+C#=0, +C in inf.. -1, +C+1#=_67966, +_67966 in inf..0, +_67870 in 1..sup ; + + +B = true, +A in 1..sup, +A#>=_67762, +A+1#=_67780, +_67762 in 1..sup, +_67762+C#=0, +C in inf.. -1, +C+1#=_67876, +_67876 in inf..0, +_67780 in 1..sup ; + + +B = false, +A in inf.. -1, +_68746+A#=0, +A+1#=_68766, +_68746 in 1..sup, +_68746#=<_68818+ -1, +_68818 in 2..sup, +_68818+C#=0, +C in inf.. -2, +C+1#=_68910, +_68910 in inf..0, +_68766 in inf..0 ; + + +B = true, +A in inf.. -1, +_68258+A#=0, +A+1#=_68278, +_68258 in 1..sup, +_68258#>=_68326, +_68326 in 1..sup, +_68326+C#=0, +C in inf.. -1, +C+1#=_68416, +_68416 in inf..0, +_68278 in inf..0 ; + + +false. + + +% If we add a function rule for it using CLP(FD)...: + + func(abs, [int(A)|S], [int(B)|S]) :- B #= abs(A). + +?- joy(`[abs] ii <=`, [int(A), int(C)], [bool(B)]). + +% We get eighteen solutions! Egad. + +B = false, +_7784#=abs(A), +_7784 in 0..sup, +_7784#=<_7836+ -1, +_7836 in 1..sup, +_7836#=abs(C), +C in inf.. -1\/1..sup ; + + +B = true, +_6512#=abs(A), +_6512 in 0..sup, +_6512#>=_6560, +_6560 in 0..sup, +_6560#=abs(C) ; + + +B = false, +A in 0..sup, +A#=<_8820+ -1, +A+1#=_8840, +_8820 in 1..sup, +_8820#=abs(C), +C in inf.. -1\/1..sup, +_8840 in 1..sup ; + + +B = true, +A in 0..sup, +A#>=_7544, +A+1#=_7562, +_7544 in 0..sup, +_7544#=abs(C), +_7562 in 1..sup ; + + +B = false, +A in inf.. -1, +_9354+A#=0, +A+1#=_9374, +_9354 in 1..sup, +_9354#=<_9426+ -1, +_9426 in 2..sup, +_9426#=abs(C), +C in inf.. -2\/2..sup, +_9374 in inf..0 ; + + +B = true, +A in inf.. -1, +_8082+A#=0, +A+1#=_8102, +_8082 in 1..sup, +_8082#>=_8150, +_8150 in 0..sup, +_8150#=abs(C), +_8102 in inf..0 ; + + +B = false, +_7686#=abs(A), +_7686 in 0..sup, +_7686#==C, +C in 0..sup, +C+1#=_7608, +_7608 in 1..sup ; + + +B = false, +A in 0..sup, +A#==C, +A+1#=_8568, +C in 0..sup, +C+1#=_8616, +_8616 in 1..sup, +_8568 in 1..sup ; + + +B = false, +A in inf.. -1, +_9256+A#=0, +A+1#=_9276, +_9256 in 1..sup, +_9256#==C, +C in 0..sup, +C+1#=_9198, +_9198 in 1..sup, +_9108 in inf..0 ; + + +B = false, +_8178#=abs(A), +_8178 in 0..sup, +_8178#=<_8230+ -1, +_8230 in 1..sup, +_8230+C#=0, +C in inf.. -1, +C+1#=_8322, +_8322 in inf..0 ; + + +B = true, +A in inf.. -1\/1..sup, +_9272#=abs(A), +_9272 in 1..sup, +_9272#>=_9320, +_9320 in 1..sup, +_9320+C#=0, +C in inf.. -1, +C+1#=_9410, +_9410 in inf..0 ; + + +B = false, +A in 0..sup, +A#=<_9214+ -1, +A+1#=_9234, +_9214 in 1..sup, +_9214+C#=0, +C in inf.. -1, +C+1#=_9330, +_9330 in inf..0, +_9234 in 1..sup ; + + +B = true, +A in 1..sup, +A#>=_9126, +A+1#=_9144, +_9126 in 1..sup, +_9126+C#=0, +C in inf.. -1, +C+1#=_9240, +_9240 in inf..0, +_9144 in 1..sup ; + + +B = false, +A in inf.. -1, +_10110+A#=0, +A+1#=_10130, +_10110 in 1..sup, +_10110#=<_10182+ -1, +_10182 in 2..sup, +_10182+C#=0, +C in inf.. -2, +C+1#=_10274, +_10274 in inf..0, +_10130 in inf..0 ; + + +B = true, +A in inf.. -1, +_9622+A#=0, +A+1#=_9642, +_9622 in 1..sup, +_9622#>=_9690, +_9690 in 1..sup, +_9690+C#=0, +C in inf.. -1, +C+1#=_9780, +_9780 in inf..0, +_9642 in inf..0 ; + + +false. diff --git a/implementations/Prolog/docs/notes/minimal-basis b/implementations/Prolog/docs/notes/minimal-basis new file mode 100644 index 0000000..8d7a875 --- /dev/null +++ b/implementations/Prolog/docs/notes/minimal-basis @@ -0,0 +1,4 @@ +Talk about minimal basis, Kirby (sp?) has found a basis involving a +combinator he calls 'cake'... + +Branch, Loop, Sequence, Parallel. diff --git a/implementations/Prolog/docs/notes/on-square-spiral.md b/implementations/Prolog/docs/notes/on-square-spiral.md new file mode 100644 index 0000000..2d1ece7 --- /dev/null +++ b/implementations/Prolog/docs/notes/on-square-spiral.md @@ -0,0 +1,225 @@ + ___ _ ___ _ + | __|_ ____ _ _ __ _ __| |___ / __|___ __| |___ + | _|\ \ / _` | ' \| '_ \ / -_) | (__/ _ \/ _` / -_) + |___/_\_\__,_|_|_|_| .__/_\___| \___\___/\__,_\___| + |_| +# On the Square Spiral Example Code + +Here is the example of Joy code from the `README` file: + + [[[abs]ii <=][[<>][pop !-]||]&&][[!-][[++]][[--]]ifte dip][[pop !-][--][++]ifte]ifte + +It might seem unreadable but with a little familiarity it becomes just as +legible as any other notation. Some layout helps: + + [ [[abs] ii <=] + [ + [<>] [pop !-] || + ] && + ] + [[ !-] [[++]] [[--]] ifte dip] + [[pop !-] [--] [++] ifte ] + ifte + +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 the kind used to construct an +Ulam Spiral). + + +## Original Form + +It's adapted from the [original code on StackOverflow](https://stackoverflow.com/questions/398299/looping-in-a-spiral/31864777#31864777): + +> If all you're trying to do is generate the first N points in the spiral +> (without the original problem's constraint of masking to an N x M +> region), the code becomes very simple: + + void spiral(const int N) + { + int x = 0; + int y = 0; + for(int i = 0; i < N; ++i) + { + cout << x << '\t' << y << '\n'; + if(abs(x) <= abs(y) && (x != y || x >= 0)) + x += ((y >= 0) ? 1 : -1); + else + y += ((x >= 0) ? -1 : 1); + } + } + +> The trick is that you can compare x and y to determine what side of the +> square you're on, and that tells you what direction to move in. + + +## Translation to Joy + +I'm going to make a function that take two ints (`x` and `y`) and +generates the next pair, we'll turn it into a generator later using the +`x` combinator. + +### First Boolean Predicate + +We need a function that computes `abs(x) <= abs(y)`, we can use `ii` to +apply `abs` in parallel (eventually) to both values and then compare them +with `<=`: + + [abs] ii <= + +I've defined two short-circuiting Boolean combinators `&&` and `||` that +each accept two quoted predicate programs, run the first, and +conditionally run the second only if required (to compute the final +Boolean value). They run their predicate arguments `nullary`. Given +those, we can define `x != y || x >= 0` as: + + [<>] [pop 0 >=] || + +And `(abs(x) <= abs(y) && (x != y || x >= 0))` as: + + [[abs] ii <=] [[<>] [pop 0 >=] ||] && + +It's a little rough, but, as I say, with a little familiarity it becomes +legible. + +### The Increment / Decrement Branches + +Turning to the branches of the main `if` statement: + + x += ((y >= 0) ? 1 : -1); + +Rewrite as a hybrid (pseudo-code) `ifte` expression: + + [y >= 0] [x += 1] [X -= 1] ifte + +Change each C phrase to Joy code: + + [0 >=] [[++] dip] [[--] dip] ifte + +Factor out the dip from each branch: + + [0 >=] [[++]] [[--]] ifte dip + +Similar logic applies to the other branch: + + y += ((x >= 0) ? -1 : 1); + + [x >= 0] [y -= 1] [y += 1] ifte + + [pop 0 >=] [--] [++] ifte + + +## Putting the Pieces Together + +We can assemble the three functions we just defined in quotes and give +them them to the `ifte` combinator. With some arrangement to show off +the symmetry of the two branches, we have: + + [[[abs] ii <=] [[<>] [pop !-] ||] &&] + [[ !-] [[++]] [[--]] ifte dip] + [[pop !-] [--] [++] ifte ] + ifte + +As I was writing this up I realized that, since the `&&` combinator +doesn't consume the stack (below its quoted args), I can unquote the +predicate, swap the branches, and use the `branch` combinator instead of +`ifte`: + + [[abs] ii <=] [[<>] [pop !-] ||] && + [[pop !-] [--] [++] ifte ] + [[ !-] [[++]] [[--]] ifte dip] + branch + + +## Turning it into a Generator with `x` + +It can be used with the x combinator to make a kind of generator for +spiral square coordinates. + + +We can use `codireco` to make a generator + + codireco ::= cons dip rest cons + +It will look like this: + + [value [F] codireco] + +Here's a trace of how it works: + + [0 [dup ++] codireco] . x + [0 [dup ++] codireco] . 0 [dup ++] codireco + [0 [dup ++] codireco] 0 . [dup ++] codireco + [0 [dup ++] codireco] 0 [dup ++] . codireco + [0 [dup ++] codireco] 0 [dup ++] . cons dip rest cons + [0 [dup ++] codireco] [0 dup ++] . dip rest cons + . 0 dup ++ [0 [dup ++] codireco] rest cons + 0 . dup ++ [0 [dup ++] codireco] rest cons + 0 0 . ++ [0 [dup ++] codireco] rest cons + 0 1 . [0 [dup ++] codireco] rest cons + 0 1 [0 [dup ++] codireco] . rest cons + 0 1 [[dup ++] codireco] . cons + 0 [1 [dup ++] codireco] . + +But first we have to change the `spiral_next` function to work on a +quoted pair of integers, and leave a copy of the pair on the stack. +From: + + y x spiral_next + --------------------- + y' x' + +to: + + [x y] [spiral_next] infra + ------------------------------- + [x' y'] + +So our generator is: + + [[x y] [dup [spiral_next] infra] codireco] + +Or rather: + + [[0 0] [dup [spiral_next] infra] codireco] + +There is a function `make_generator` that will build the generator for us +out of the value and stepper function: + + [0 0] [dup [spiral_next] infra] make_generator + ---------------------------------------------------- + [[0 0] [dup [spiral_next] infra] codireco] + +Here it is in action: + + ?- joy(`[[0 0] [dup [spiral_next] infra] codireco] x x x x pop`, [], _So), + | joy_terms_to_string(_So, S). + + _So = [list([int(-1), int(0)]), list([int(-1), int(1)]), list([int(0), int(1)]), list([int(0), int(0)])], + + S = "[-1 0] [-1 1] [0 1] [0 0]" . + +Four `x` combinators, four pairs of coordinates. + + +## Conclusion + +So that's an example of Joy code. It's a straightforward translation of +the original. It's a little long for a single definition, you might +break it up like so: + + _spn_P ::= [[abs] ii <=] [[<>] [pop !-] ||] && + + _spn_T ::= [ !-] [[++]] [[--]] ifte dip + _spn_E ::= [pop !-] [--] [++] ifte + + spiral_next ::= _spn_P [_spn_E] [_spn_T] branch + +This way it's easy to see that the function is a branch with two +quasi-symmetrical paths. + +We then used this function to make a simple generator of coordinate +pairs, where the next pair in the series can be generated at any time by +using the `x` combinator on the generator (which is just a quoted +expression containing a copy of the current pair and the "stepper +function" to generate the next pair from that.) \ No newline at end of file diff --git a/implementations/Prolog/docs/notes/semantics.md b/implementations/Prolog/docs/notes/semantics.md new file mode 100644 index 0000000..96d39e8 --- /dev/null +++ b/implementations/Prolog/docs/notes/semantics.md @@ -0,0 +1,61 @@ +# list-structured memory + +[In SICP, section 5.3, "Storage Allocation and Garbage Collection"](https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-33.html#%_sec_5.3): + +> In order to simplify the discussion, we will assume that our register + machines can be equipped with a list-structured memory, in which the + basic operations for manipulating list-structured data are primitive. + +So they bunt to an abstraction and then implement that abstraction as a +separate problem. Makes sense. I see no reason not to adopt the design +described here. + +------------------ + +# Machine Ints vs BigNums + +Already there is a problem in the semantics. SWI Prolog integers can be +larger than machine words, which in the RISC CPU are thirty-two bits. +(GNU Prolog uses machine words for its integers). THe main options are: + +1. Implements "BigNums" for Wirth RISC. + +2. Adjust the semantics of Thun to reflect the modular arithmetic of + machine words and native machine integer math operations. + +3. ... something else. + +------------------ + +# specialized versions of `branch` and `ifte` + +THere's another semantic wrinkle with branches and Boolean values. +Namely, the CPU provides the condition and the offset in one instruction +whereas Joy has them separated. I have been thinking about introducing +specialized versions of `branch` as primitives: + + =branch + >branch + =branch + <>branch + +Or maybe: + + =? + >? + =? + <>? + +Anyway, it would be pretty easy to detect simple cases of the split +pattern and convert them automatically, but the programmer could use them +directly whenever it made sense. + + > [F] [T] branch ==> [F] [T] >branch + +Probably specialized versions of `ifte` would be useful as well. + +------------------ diff --git a/implementations/Prolog/docs/reference/FORMAT-Functor-Reference.md b/implementations/Prolog/docs/reference/FORMAT-Functor-Reference.md new file mode 100644 index 0000000..f3f3b25 --- /dev/null +++ b/implementations/Prolog/docs/reference/FORMAT-Functor-Reference.md @@ -0,0 +1,39 @@ + +-------------------- + +Get a list of currently defined functors with: + + ?- joy(`words`, [], [Words]), maplist(writeln, Words). + + + + + +FORMAT: + +-------------------- + +## Name + +[Basis] Function | Combinator + +Summary + +Gentzen diagram. + +### Definition + +if not basis. + +### Derivation + +if not basis. + +### Source + +if basis + +### Discussion + + +### Crosslinks \ No newline at end of file diff --git a/implementations/Prolog/docs/reference/FuncRef.html b/implementations/Prolog/docs/reference/FuncRef.html new file mode 100644 index 0000000..b984927 --- /dev/null +++ b/implementations/Prolog/docs/reference/FuncRef.html @@ -0,0 +1,353 @@ + + + + + + + Functor-Reference + + + + + +

Functor Reference

+

Version -10.0.0

+

Each function, combinator, or definition should be documented here.

+
+

!-

+

“not negative”

+

(Function, Boolean Predicate)

+

Integer on top of stack is replaced by Boolean value indicating whether it is non-negative.

+
    N !-
+-----------  N < 0
+   false
+
+   N !-
+----------  N >= 0
+   true
+

Definition

+
0 >=
+
+

app1

+

“apply one”

+

(Combinator)

+

Given a quoted program on TOS and anything as the second stack item run the program without disturbing the stack and replace the two args with the first result of the program.

+
         ... x [Q] app1
+---------------------------------
+   ... [x ...] [Q] infra first
+

Definition

+
nullary popd
+

Discussion

+

Just a specialization of nullary really. Its parallelizable cousins are more useful.

+
+

b

+

(Combinator)

+

Run two quoted programs

+
   [P] [Q] b
+---------------
+      P Q
+

Definition

+
[i] dip i
+

Derivation

+
[P] [Q] b
+[P] [Q] [i] dip i
+[P] i [Q] i
+ P    [Q] i
+ P     Q
+

Discussion

+

This combinator comes in handy.

+ +

dupdip ii

+
+

binary

+

(Combinator)

+

Run a quoted program using exactly two stack values and leave the first item of the result on the stack.

+
   ... y x [P] binary
+-----------------------
+        ... A
+

Definition

+
unary popd
+

Discussion

+

Runs any other quoted function and returns its first result while consuming exactly two items from the stack.

+ +

nullary ternary unary

+
+

ccons

+

(Function)

+

Given two items and a list, append the items to the list to make a new list.

+
   B A [...] ccons
+---------------------
+      [B A ...]
+

Definition

+
cons cons
+

Discussion

+

Does cons twice.

+ +

cons

+
+

cons

+

(Basis Function)

+

Given an item and a list, append the item to the list to make a new list.

+
   A [...] cons
+------------------
+     [A ...]
+

Source

+
func(cons, [list(A), B|S], [list([B|A])|S]).
+

Discussion

+

Cons is a venerable old function from Lisp. It doesn’t inspect the item but it will not cons onto a non-list. It’s inverse operation is called uncons.

+ +

ccons uncons

+
+

i

+

(Basis Combinator)

+

Append a quoted expression onto the pending expression.

+
   [Q] i
+-----------
+    Q
+

Source

+
combo(i, [list(P)|S], S, Ei, Eo) :- append(P, Ei, Eo).
+

Discussion

+

This is probably the fundamental combinator. You wind up using it in all kinds of places (for example, the x combinator can be defined as dup i.)

+
+

infra

+

(Combinator)

+

Accept a quoted program and a list on the stack and run the program with the list as its stack. Does not affect the stack (below the list.)

+
   ... [a b c] [Q] infra
+---------------------------
+    c b a Q [...] swaack
+

Definition

+
swons swaack [i] dip swaack
+

Discussion

+

This is one of the more useful combinators. It allows a quoted expression to serve as a stack for a program, effectively running it in a kind of “pocket universe”. If the list represents a datastructure then infra lets you work on its internal structure.

+ +

swaack

+
+

nullary

+

(Combinator)

+

Run a quoted program without using any stack values and leave the first item of the result on the stack.

+
   ... [P] nullary
+---------------------
+        ... A
+

Definition

+
[stack] dip infra first
+

Derivation

+
... [P] nullary
+... [P] [stack] dip infra first
+... stack [P] infra first
+... [...] [P] infra first
+... [A ...] first
+...  A
+

Discussion

+

A very useful function that runs any other quoted function and returns it’s first result without disturbing the stack (under the quoted program.)

+ +

unary binary ternary

+
+

ternary

+

(Combinator)

+

Run a quoted program using exactly three stack values and leave the first item of the result on the stack.

+
   ... z y x [P] unary
+-------------------------
+         ... A
+

Definition

+
binary popd
+

Discussion

+

Runs any other quoted function and returns its first result while consuming exactly three items from the stack.

+ +

binary nullary unary

+
+

unary

+

(Combinator)

+

Run a quoted program using exactly one stack value and leave the first item of the result on the stack.

+
   ... x [P] unary
+---------------------
+       ... A
+

Definition

+
nullary popd
+

Discussion

+

Runs any other quoted function and returns its first result while consuming exactly one item from the stack.

+ +

binary nullary ternary

+
+

uncons

+

(Basis Function)

+

Removes an item from a list and leaves it on the stack under the rest of the list. You cannot uncons an item from an empty list.

+
   [A ...] uncons
+--------------------
+      A [...]
+

Source

+
func(uncons, Si, So) :- func(cons, So, Si).
+

Discussion

+

This is the inverse of cons.

+ +

cons

+
+

x

+

(Combinator)

+
   [F] x
+-----------
+   [F] F
+

Definition

+
dup i
+

Discussion

+

The x combinator …

+ + diff --git a/implementations/Prolog/docs/reference/Functor-Reference.md b/implementations/Prolog/docs/reference/Functor-Reference.md new file mode 100644 index 0000000..ffa76c5 --- /dev/null +++ b/implementations/Prolog/docs/reference/Functor-Reference.md @@ -0,0 +1,355 @@ +# Functor Reference + +Version -10.0.0 + +Each function, combinator, or definition should be documented here. + +-------------------- + +## !- + +"not negative" + +(Function, Boolean Predicate) + +Integer on top of stack is replaced by Boolean value indicating whether +it is non-negative. + + N !- + ----------- N < 0 + false + + N !- + ---------- N >= 0 + true + + +### Definition + + 0 >= + +-------------------- + +## app1 + +"apply one" + +(Combinator) + +Given a quoted program on TOS and anything as the second stack item run +the program without disturbing the stack and replace the two args with +the first result of the program. + + ... x [Q] app1 + --------------------------------- + ... [x ...] [Q] infra first + +### Definition + + nullary popd + +### Discussion + +Just a specialization of `nullary` really. Its parallelizable cousins +are more useful. + + +-------------------- + +## b + +(Combinator) + +Run two quoted programs + + [P] [Q] b + --------------- + P Q + +### Definition + + [i] dip i + +### Derivation + + [P] [Q] b + [P] [Q] [i] dip i + [P] i [Q] i + P [Q] i + P Q + +### Discussion + +This combinator comes in handy. + +### Crosslinks + +[dupdip](#dupdip) +[ii](#ii) + +-------------------- + +## binary + +(Combinator) + +Run a quoted program using exactly two stack values and leave the first +item of the result on the stack. + + ... y x [P] binary + ----------------------- + ... A + +### Definition + + unary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly two items from the stack. + +### Crosslinks + +[nullary](#nullary) +[ternary](#ternary) +[unary](#unary) + +-------------------- + +## ccons + +(Function) + +Given two items and a list, append the items to the list to make a new list. + + B A [...] ccons + --------------------- + [B A ...] + +### Definition + + cons cons + +### Discussion + +Does `cons` twice. + +### Crosslinks + +[cons](#cons) + +-------------------- + +## cons + +(Basis Function) + +Given an item and a list, append the item to the list to make a new list. + + A [...] cons + ------------------ + [A ...] + +### Source + + func(cons, [list(A), B|S], [list([B|A])|S]). + +### Discussion + +Cons is a venerable old function from Lisp. It doesn't inspect the item +but it will not cons onto a non-list. It's inverse operation is called +`uncons`. + +### Crosslinks + +[ccons](#ccons) +[uncons](#uncons) + +-------------------- + +## i + +(Basis Combinator) + +Append a quoted expression onto the pending expression. + + + [Q] i + ----------- + Q + +### Source + + combo(i, [list(P)|S], S, Ei, Eo) :- append(P, Ei, Eo). + +### Discussion + +This is probably the fundamental combinator. You wind up using it in all +kinds of places (for example, the `x` combinator can be defined as `dup i`.) + +-------------------- + +## infra + +(Combinator) + +Accept a quoted program and a list on the stack and run the program with +the list as its stack. Does not affect the stack (below the list.) + + ... [a b c] [Q] infra + --------------------------- + c b a Q [...] swaack + +### Definition + + swons swaack [i] dip swaack + + +### Discussion + +This is one of the more useful combinators. It allows a quoted +expression to serve as a stack for a program, effectively running it in a +kind of "pocket universe". If the list represents a datastructure then +`infra` lets you work on its internal structure. + +### Crosslinks + +[swaack](#swaack) + +-------------------- + +## nullary + +(Combinator) + +Run a quoted program without using any stack values and leave the first item of the result on the stack. + + ... [P] nullary + --------------------- + ... A + +### Definition + + [stack] dip infra first + +### Derivation + + ... [P] nullary + ... [P] [stack] dip infra first + ... stack [P] infra first + ... [...] [P] infra first + ... [A ...] first + ... A + +### Discussion + +A very useful function that runs any other quoted function and returns +it's first result without disturbing the stack (under the quoted +program.) + +### Crosslinks + +[unary](#unary) +[binary](#binary) +[ternary](#ternary) + +-------------------- + +## ternary + +(Combinator) + + +Run a quoted program using exactly three stack values and leave the first +item of the result on the stack. + + ... z y x [P] unary + ------------------------- + ... A + +### Definition + + binary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly three items from the stack. + +### Crosslinks + +[binary](#binary) +[nullary](#nullary) +[unary](#unary) + +-------------------- + +## unary + +(Combinator) + +Run a quoted program using exactly one stack value and leave the first item of the result on the stack. + + ... x [P] unary + --------------------- + ... A + +### Definition + + nullary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly one item from the stack. + +### Crosslinks + +[binary](#binary) +[nullary](#nullary) +[ternary](#ternary) + +-------------------- + +## uncons + +(Basis Function) + +Removes an item from a list and leaves it on the stack under the rest of +the list. You cannot `uncons` an item from an empty list. + + [A ...] uncons + -------------------- + A [...] + +### Source + + func(uncons, Si, So) :- func(cons, So, Si). + +### Discussion + +This is the inverse of `cons`. + +### Crosslinks + +[cons](#cons) + +-------------------- + +## x + +(Combinator) + + [F] x + ----------- + [F] F + +### Definition + + dup i + +### Discussion + +The `x` combinator ... + diff --git a/implementations/Prolog/docs/reference/Makefile b/implementations/Prolog/docs/reference/Makefile new file mode 100644 index 0000000..8b16eab --- /dev/null +++ b/implementations/Prolog/docs/reference/Makefile @@ -0,0 +1,3 @@ + +all: + pandoc -s --toc --toc-depth=2 --ascii Functor-Reference.md -o FuncRef.html diff --git a/implementations/Prolog/docs/reference/app1.md b/implementations/Prolog/docs/reference/app1.md new file mode 100644 index 0000000..95dbe5f --- /dev/null +++ b/implementations/Prolog/docs/reference/app1.md @@ -0,0 +1,26 @@ +-------------------- + +## app1 + +"apply one" + +(Combinator) + +Given a quoted program on TOS and anything as the second stack item run +the program without disturbing the stack and replace the two args with +the first result of the program. + + ... x [Q] app1 + --------------------------------- + ... [x ...] [Q] infra first + +### Definition + + nullary popd + +### Discussion + +Just a specialization of `nullary` really. Its parallelizable cousins +are more useful. + + diff --git a/implementations/Prolog/docs/reference/b.md b/implementations/Prolog/docs/reference/b.md new file mode 100644 index 0000000..37647a1 --- /dev/null +++ b/implementations/Prolog/docs/reference/b.md @@ -0,0 +1,33 @@ +-------------------- + +## b + +(Combinator) + +Run two quoted programs + + [P] [Q] b + --------------- + P Q + +### Definition + + [i] dip i + +### Derivation + + [P] [Q] b + [P] [Q] [i] dip i + [P] i [Q] i + P [Q] i + P Q + +### Discussion + +This combinator comes in handy. + +### Crosslinks + +[dupdip](#dupdip) +[ii](#ii) + diff --git a/implementations/Prolog/docs/reference/binary.md b/implementations/Prolog/docs/reference/binary.md new file mode 100644 index 0000000..182da5b --- /dev/null +++ b/implementations/Prolog/docs/reference/binary.md @@ -0,0 +1,28 @@ +-------------------- + +## binary + +(Combinator) + +Run a quoted program using exactly two stack values and leave the first +item of the result on the stack. + + ... y x [P] binary + ----------------------- + ... A + +### Definition + + unary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly two items from the stack. + +### Crosslinks + +[nullary](#nullary) +[ternary](#ternary) +[unary](#unary) + diff --git a/implementations/Prolog/docs/reference/bleah.txt b/implementations/Prolog/docs/reference/bleah.txt new file mode 100644 index 0000000..10f82f6 --- /dev/null +++ b/implementations/Prolog/docs/reference/bleah.txt @@ -0,0 +1,20 @@ +The problem is twofold: + +1.) Programming is very young, and has been in a growth phase since it's inception. I forget the exact numbers, but *half* of *all* programmers have been doing it for less than *five years*, and that has been true for many decades. + +Because there has been no "shakedown" phase (a "correction" in financial jargon), and because the influx of newbies ("Eternal September") has washed out any attempts at *better* programming ("Mother of All Demos", Nelson's "Dream Machine", etc., on the one hand and e.g. Ada on the other, all of it pretty much ignored in the mainstream machines and software available today. How many people have heard of Jef Raskin, let alone read "Humane Interface"? etc...) because of these things we should not expect programming to be at the level of engineering. We are in the Alchemy phase, not Chemistry. + + +2.) Choice of notation. Without going into a long rant, our fundamental mathematical tools for programming are grotesque. (It would be shocking if the first thing out of the primordial ooze was the perfect programming notation, eh? In point of fact we have Turing Machines, Lambda Calculus, and what was the other one? Anyway, they're clunky.) + +For binary Boolean circuits the notation in "Laws of Form" by George Spencer-Brown is the most elegant and parsimonious: + + AA == A + ((A)) == A + A(AB) == A(B) + +That is a complete system of binary Boolean logic that is more efficient than other notations. (For instance, de Morgan's law doesn't apply: you can convert a formula into it's dual, reduce, and recover the original formula. (Ergo, conventional notation has (non-useful) redundancy.)) + +For orchestrating binary Boolean logic circuits into what we call "programs" the best notation is something called "Joy". It was invented by a philosopher! It has the best aspects of Lisp and Forth. It handles concurrency in a very simple and tractable way. It delivers on the promise of Backus' FP to enable mathematical *algebraic* derivations of algorithms/programs. Etc... + +Anyhow, I'm preparing a demo of Joy, with UI influenced by psycho-ergonomic considerations, that can be compiled down to the logic circuits (and e.g. burned onto an FPGA or whatever.) A new model of computer architecture is implied, using latching sort-nets to allow for dynamic reconfiguration of what amounts to dataflow on the level of the CPU. (No more Von Neumann bottleneck.) \ No newline at end of file diff --git a/implementations/Prolog/docs/reference/ccons.md b/implementations/Prolog/docs/reference/ccons.md new file mode 100644 index 0000000..0afb708 --- /dev/null +++ b/implementations/Prolog/docs/reference/ccons.md @@ -0,0 +1,24 @@ +-------------------- + +## ccons + +(Function) + +Given two items and a list, append the items to the list to make a new list. + + B A [...] ccons + --------------------- + [B A ...] + +### Definition + + cons cons + +### Discussion + +Does `cons` twice. + +### Crosslinks + +[cons](#cons) + diff --git a/implementations/Prolog/docs/reference/cons.md b/implementations/Prolog/docs/reference/cons.md new file mode 100644 index 0000000..cfc19aa --- /dev/null +++ b/implementations/Prolog/docs/reference/cons.md @@ -0,0 +1,27 @@ +-------------------- + +## cons + +(Basis Function) + +Given an item and a list, append the item to the list to make a new list. + + A [...] cons + ------------------ + [A ...] + +### Source + + func(cons, [list(A), B|S], [list([B|A])|S]). + +### Discussion + +Cons is a venerable old function from Lisp. It doesn't inspect the item +but it will not cons onto a non-list. It's inverse operation is called +`uncons`. + +### Crosslinks + +[ccons](#ccons) +[uncons](#uncons) + diff --git a/implementations/Prolog/docs/reference/foobar.txt b/implementations/Prolog/docs/reference/foobar.txt new file mode 100644 index 0000000..d24d6cb --- /dev/null +++ b/implementations/Prolog/docs/reference/foobar.txt @@ -0,0 +1,98 @@ +Implement modular arithmetic semantics for Joy, or + +Implement 'BigNums' for Oberon RISC, or + +Implement mod arith in Joy and use that to implement BigNums in mod-Joy, +then partial reduce/eval etc. to get BigNums for RISC? + + + +OR, let division operator make rationals!? + + + + + +I'm using DCG w/ the lists as machine code, and explicitly passing the +environment around; If I put the machine code into the environment I can +just pass that around and define an asm//n DCG for writing machine code. + + + +Parsing and Compiling Using Prolog + + 1. Introduction + 2. Parsing + 2.1 Bottom-Up + 2.2 Top-Down + 2.3 Recursive Descent + 3. Syntax-Directed Translation + 4. M-Grammars and DCGs + 5. Grammar Properties + 6. Lexical Scanners And Parser Generation + 7. Code Generation + 7.1 Generating Code from Polish + 7.2 Generating Code from Trees + 7.3 A Machine-Independent Algorithm for Code Generation + 7.4 Code Generation from a Labelled Tree + 8. Optimizations + 8.1 Compile-Time Evaluation + 8.2 Peephole Optimization + 9. Using Proposed Extension + 10. Final Remarks + + + + + +type Item + = Integer Int + | Symbol String + | Boolean Bool + + + + +The Web UI + +- Docs for each function + - Crosslinks to other funcs in PatLang style +- "Forge" for creating new funcs + - Type-checking + - Examples + - Docs + - Domain/Applicability + - Mathematical Aspects (Cat Theory) +- Evaluation Contexts + - Stage + - Spreadsheet/Grid + - Factory + - Dataflow + - Hall of Records +- History + - Learning from + - Quoting from + - Changing/Deleting (sometimes you gotta) +- Publishing/Sharing + - Registry of definition/functions + - Money? + + +https://thenewstack.io/rust-creator-graydon-hoare-recounts-the-history-of-compilers/ + + +I've been working (on and off, for years) on making a system inspired by that book and by Jef Raskin's "Humane Interface", et. el., and I'm convinced that software could be made bug-free and cheaply, however I have no hope of convincing other programmers. Instead, I'm going to take it directly to end users (and not tell them that they are learning to program until they already have, so as not to jinx it.) + +Trying to market to other developers would be an uphill battle, but normal people can use it to develop bug-free software easily and with minimal training (it's fun, like playing a video game). + +I should have a demo going in a week or two. I'm learning Elm lang right now to make a web UI for it. The original demo UI is in Python 2 and Tkinter, but I've transitioned to an implementation based on Prolog, where inter-op with TCL/Tk would be more trouble than simple putting a web server in front of it (not to go off on a tangent but search for "pengine" if you want to know more about Prolog-over-TCP.) + + +- - - - + +Graydon Hoare has a talk on the history of compilers but he doesn't mention Prolog once. I think it's possible he doesn't know about the research into logic programming and compilers. + + +"Parsing and Compiling Using Prolog" Jacques Cohen and Tim Hickey +ACM Transactions on Programming Languages and Systems 9(2):125-163 · April 1987 +DOI: 10.1145/22719.22946 · Source: DBLP diff --git a/implementations/Prolog/docs/reference/i.md b/implementations/Prolog/docs/reference/i.md new file mode 100644 index 0000000..8491757 --- /dev/null +++ b/implementations/Prolog/docs/reference/i.md @@ -0,0 +1,22 @@ +-------------------- + +## i + +(Basis Combinator) + +Append a quoted expression onto the pending expression. + + + [Q] i + ----------- + Q + +### Source + + combo(i, [list(P)|S], S, Ei, Eo) :- append(P, Ei, Eo). + +### Discussion + +This is probably the fundamental combinator. You wind up using it in all +kinds of places (for example, the `x` combinator can be defined as `dup i`.) + diff --git a/implementations/Prolog/docs/reference/infra.md b/implementations/Prolog/docs/reference/infra.md new file mode 100644 index 0000000..edea95a --- /dev/null +++ b/implementations/Prolog/docs/reference/infra.md @@ -0,0 +1,29 @@ +-------------------- + +## infra + +(Combinator) + +Accept a quoted program and a list on the stack and run the program with +the list as its stack. Does not affect the stack (below the list.) + + ... [a b c] [Q] infra + --------------------------- + c b a Q [...] swaack + +### Definition + + swons swaack [i] dip swaack + + +### Discussion + +This is one of the more useful combinators. It allows a quoted +expression to serve as a stack for a program, effectively running it in a +kind of "pocket universe". If the list represents a datastructure then +`infra` lets you work on its internal structure. + +### Crosslinks + +[swaack](#swaack) + diff --git a/implementations/Prolog/docs/reference/not_negative.md b/implementations/Prolog/docs/reference/not_negative.md new file mode 100644 index 0000000..7853a98 --- /dev/null +++ b/implementations/Prolog/docs/reference/not_negative.md @@ -0,0 +1,24 @@ +-------------------- + +## !- + +"not negative" + +(Function, Boolean Predicate) + +Integer on top of stack is replaced by Boolean value indicating whether +it is non-negative. + + N !- + ----------- N < 0 + false + + N !- + ---------- N >= 0 + true + + +### Definition + + 0 >= + diff --git a/implementations/Prolog/docs/reference/nullary.md b/implementations/Prolog/docs/reference/nullary.md new file mode 100644 index 0000000..b6eaeb4 --- /dev/null +++ b/implementations/Prolog/docs/reference/nullary.md @@ -0,0 +1,37 @@ +-------------------- + +## nullary + +(Combinator) + +Run a quoted program without using any stack values and leave the first item of the result on the stack. + + ... [P] nullary + --------------------- + ... A + +### Definition + + [stack] dip infra first + +### Derivation + + ... [P] nullary + ... [P] [stack] dip infra first + ... stack [P] infra first + ... [...] [P] infra first + ... [A ...] first + ... A + +### Discussion + +A very useful function that runs any other quoted function and returns +it's first result without disturbing the stack (under the quoted +program.) + +### Crosslinks + +[unary](#unary) +[binary](#binary) +[ternary](#ternary) + diff --git a/implementations/Prolog/docs/reference/ternary.md b/implementations/Prolog/docs/reference/ternary.md new file mode 100644 index 0000000..856b162 --- /dev/null +++ b/implementations/Prolog/docs/reference/ternary.md @@ -0,0 +1,29 @@ +-------------------- + +## ternary + +(Combinator) + + +Run a quoted program using exactly three stack values and leave the first +item of the result on the stack. + + ... z y x [P] unary + ------------------------- + ... A + +### Definition + + binary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly three items from the stack. + +### Crosslinks + +[binary](#binary) +[nullary](#nullary) +[unary](#unary) + diff --git a/implementations/Prolog/docs/reference/unary.md b/implementations/Prolog/docs/reference/unary.md new file mode 100644 index 0000000..ccd3ea4 --- /dev/null +++ b/implementations/Prolog/docs/reference/unary.md @@ -0,0 +1,27 @@ +-------------------- + +## unary + +(Combinator) + +Run a quoted program using exactly one stack value and leave the first item of the result on the stack. + + ... x [P] unary + --------------------- + ... A + +### Definition + + nullary popd + +### Discussion + +Runs any other quoted function and returns its first result while +consuming exactly one item from the stack. + +### Crosslinks + +[binary](#binary) +[nullary](#nullary) +[ternary](#ternary) + diff --git a/implementations/Prolog/docs/reference/uncons.md b/implementations/Prolog/docs/reference/uncons.md new file mode 100644 index 0000000..39f1d63 --- /dev/null +++ b/implementations/Prolog/docs/reference/uncons.md @@ -0,0 +1,25 @@ +-------------------- + +## uncons + +(Basis Function) + +Removes an item from a list and leaves it on the stack under the rest of +the list. You cannot `uncons` an item from an empty list. + + [A ...] uncons + -------------------- + A [...] + +### Source + + func(uncons, Si, So) :- func(cons, So, Si). + +### Discussion + +This is the inverse of `cons`. + +### Crosslinks + +[cons](#cons) + diff --git a/implementations/Prolog/docs/reference/x.md b/implementations/Prolog/docs/reference/x.md new file mode 100644 index 0000000..d956a4f --- /dev/null +++ b/implementations/Prolog/docs/reference/x.md @@ -0,0 +1,18 @@ +-------------------- + +## x + +(Combinator) + + [F] x + ----------- + [F] F + +### Definition + + dup i + +### Discussion + +The `x` combinator ... + diff --git a/implementations/Prolog/docs/user-guide/user-guide.md b/implementations/Prolog/docs/user-guide/user-guide.md new file mode 100644 index 0000000..d5181fe --- /dev/null +++ b/implementations/Prolog/docs/user-guide/user-guide.md @@ -0,0 +1,167 @@ +# User Guide + +There is no use interface as such. At the moment you just load the +`thun.pl` file into SWI Prolog and use some of these "top-level" +predicates to interact with it. + +------------------ + +## `joy/3` + + joy(InputString, StackIn, StackOut) + +### Evaluation + +Accepts a joy expression as a list of codes (in SWI Prolog you can use +backticks to quote a string literal and get codes): + + ?- joy(`+ *`, [int(2), int(3), int(10)], StackOut). + StackOut = [int(50)] ; + false. + + ?- joy(`2 3 + 10 *`, StackIn, StackOut). + StackOut = [int(50)|StackIn] ; + false. + +### Type Checking + +This predicate can also perform type checking: + + ?- joy(`2 [] +`, StackIn, StackOut). + false. + +### Type Inference + +And type inference with CLP(FD) constraints on integer operations and +comparisons: + + ?- joy(`+ *`, StackIn, StackOut). + StackIn = [int(_37782), int(_37792), int(_37802)|_37798], + StackOut = [int(_37824)|_37798], + _37782+_37792#=_37842, + _37842*_37802#=_37824 ; + false. + +------------------ + +## `joy_parse//1` + +If you just want to parse a string into a Joy expression use joy_parse//1 +DCG, like so: + + phrase(joy_parse(Expression), InputString) + +Or directly: + + joy_parse(Expression, InputString, []) + + +Example: + + ?- phrase(joy_parse(Expression), `1 [i]`). + Expression = [int(1), list([symbol(i)])] ; + false. + +------------------ + +## `thun/3` + +Once you have a (type-tagged) Joy exression as Prolog data-structure you +can use the `thun/3` predicate to evaluate it: + + thun(Expression, InputStack, OutputStack) + + +------------------ + +## `sjc/2` + + sjc(Name, InputString) + +Helper function to see to what Prolog code a given Joy expression would +compile. Give it a name (Prolog atom) and a list of code. + + ?- sjc(third, `third`). + func(third, [list([_, _, A|_])|B], [A|B]). + true ; + false. + + ?- sjc(ccons, `ccons`). + func(ccons, [list(C), B, A|D], [list([A, B|C])|D]). + true ; + false. + +Compilation captures CLP(FD) constraints: + + ?- sjc(+*, `+ *`). + func(+*, [int(D), int(E), int(B)|A], [int(C)|A]) :- + maplist(call, + [ clpfd:(F*B#=C), + clpfd:(D+E#=F) + ]). + true ; + false. + +------------------ + +## `show_joy_compile/2` + + show_joy_compile(Name, Expression) + +Same as `sjc/2` but you give it an already-parsed expression. + +------------------ + +## `joy_compile/2` + + joy_compile(Name, Expression) + +This actually asserts the new function definition into the Prolog rule +database. Use with care. + +At some point I'll probably add a build phase that tries to pre-compile +all definitions it can into Prolog rules but for now this is just +experimental. + +------------------ + +## `compiler/4` + + compiler(InputString, MachineCode, StackIn, StackOut) + +Experimental *and* unfinished, this predicate attempts to build a list of +terms representing machine code for the RISC CPU that Prof. Wirth has +specified for his Project Oberon. + +------------------ + +## `grow//0` & `shrink//0` + +These DCGs recursively unfold or fold definitions in a Joy expression: + + ?- phrase(grow, [symbol(third)], Out). + Out = [symbol(rest), symbol(rest), symbol(first)] ; + Out = [symbol(rest), symbol(rest), symbol(first)] ; + Out = [symbol(rest), symbol(second)] ; + Out = [symbol(third)]. + + ?- phrase(shrink, [symbol(rest), symbol(rest), symbol(first)], Out). + Out = [symbol(rrest), symbol(first)] ; + Out = [symbol(third)] ; + Out = [symbol(rest), symbol(second)] ; + Out = [symbol(rest), symbol(rest), symbol(first)]. + +They are more a proof-of-concept than useful at the moment. I imagine +that it might be possible to set up some kind of automated search through +all the variations to see if a more efficient form (after compiling with +whatever optimizations) can be found. + +------------------ + +## `joy_terms_to_string/2` + + joy_terms_to_string(Expr, String) + +Converts a Joy expression into a string (an actual string, not a list of +codes. See the [SWI Prolog manual for more information on strings](https://www.swi-prolog.org/pldoc/man?section=strings).) + diff --git a/implementations/Prolog/issues/boolean-prefix b/implementations/Prolog/issues/boolean-prefix new file mode 100644 index 0000000..3a36b5e --- /dev/null +++ b/implementations/Prolog/issues/boolean-prefix @@ -0,0 +1,21 @@ + ?- phrase(joy_parse(Expression), `truedat`). + Expression = [bool(true), symbol(dat)] . + +Oops! + +I knew about: + + ?- phrase(joy_parse(Expression), `23dat`). + Expression = [int(23), symbol(dat)] . + +should probably fix it too + +still want: + + ?- phrase(joy_parse(Expression), `[2[3]]`). + Expression = [list([int(2), list([int(3)])])] . + + ?- phrase(joy_parse(Expression), `[true[false]]`). + Expression = [list([bool(true), list([bool(false)])])] . + +...to work. That is, you shouldn't need spaces around '[' and ']'. diff --git a/implementations/Prolog/issues/disenstacken b/implementations/Prolog/issues/disenstacken new file mode 100644 index 0000000..3fa2cdf --- /dev/null +++ b/implementations/Prolog/issues/disenstacken @@ -0,0 +1,2 @@ +disenstacken is in the defs.txt +it needs to be updated to reflect the unstack<->disenstacken switch. \ No newline at end of file diff --git a/implementations/Prolog/issues/document-all-functions b/implementations/Prolog/issues/document-all-functions new file mode 100644 index 0000000..9dc8ff0 --- /dev/null +++ b/implementations/Prolog/issues/document-all-functions @@ -0,0 +1,132 @@ +Each function should have full documentation including examples, +deriviation, history, background, crosslinks (like "Pattern Language"), +rationale, details of implementation, etc. + +Still to do: + + % + && + * + + + ++ + - + -- + / + /% + < + <= + <> + = + > + >= + ? + abs + anamorphism + and + app2 + app3 + appN + at + average + bool + branch + clear + cleave + clop + codireco + concat + dinfrirst + dip + dipd + disenstacken + down_to_zero + drop + dup + dupd + dupdd + dupdip + dupdipd + empty? + enstacken + first + flatten + fork + fourth + gcd + genrec + grabN + grba + hypot + ifte + ii + infrst + list? + loop + make_generator + map + neg + not + of + one-or-more? + or + over + pam + pm + pop + popd + popdd + popop + popopd + popopdd + primrec + product + quoted + range + range_to_zero + rest + reverse + rolldown + rollup + rrest + run + second + shift + shunt + size + spiral_next + split_at + sqr + stack + step + step_zero + sum + swaack + swap + swons + take + third + times + tuck + unit + unquoted + unswons + while + words + || + +------- +Done: + + !- + app1 + b + binary + ccons + cons + i + infra + nullary + ternary + unary + uncons + x diff --git a/implementations/Prolog/issues/funcs-nooooo b/implementations/Prolog/issues/funcs-nooooo new file mode 100644 index 0000000..dce52d6 --- /dev/null +++ b/implementations/Prolog/issues/funcs-nooooo @@ -0,0 +1,18 @@ +?- sjc(add_twice, `[36 *] ii`). +func(add_twice, [int(B), int(D)|A], [int(C), int(E)|A]) :- + maplist(call, + [clpfd:(36*B#=C), clpfd:(36*D#=E)]). +true ; +func(add_twice, [symbol(swap), int(D), int(B)|A], [int(C), int(E)|A]) :- + maplist(call, + [clpfd:(36*B#=C), clpfd:(36*D#=E)]). +true ; +func(add_twice, [symbol(dup), int(D)|A], [int(C), int(B)|A]) :- + maplist(call, + [clpfd:(36*B#=C), clpfd:(36*D#=B)]). +true ; +func(add_twice, [symbol(pop), int(D), int(B)|A], [int(C)|A]) :- + maplist(call, + [clpfd:(36*B#=C), clpfd:(36*D#=_)]). +true . + diff --git a/implementations/Prolog/issues/interpolation-literal b/implementations/Prolog/issues/interpolation-literal new file mode 100644 index 0000000..b3ab9ab --- /dev/null +++ b/implementations/Prolog/issues/interpolation-literal @@ -0,0 +1,13 @@ + +What about a kind of interpolation literal? + + {} -> [] + \n -> nth stack item. + +So: + + a b c { \0 { \2 { \0 \1 }}} + --------------------------------- + [ c [ a [ c b ]]] + +And so on... diff --git a/implementations/Prolog/jd.dot b/implementations/Prolog/jd.dot new file mode 100644 index 0000000..6ceca42 --- /dev/null +++ b/implementations/Prolog/jd.dot @@ -0,0 +1,306 @@ +digraph joy_defs { + "--" -> "-"; + "?" -> "bool"; + "?" -> "dup"; + "&&" -> "branch"; + "&&" -> "dip"; + "&&" -> "nullary"; + "&&" -> "nulco"; + "++" -> "+"; + "||" -> "branch"; + "||" -> "dip"; + "||" -> "nullary"; + "||" -> "nulco"; + "!-" -> ">="; + "<{}" -> "swap"; + "<<{}" -> "rolldown"; + "abs" -> "branch"; + "abs" -> "neg"; + "abs" -> "<"; + "abs" -> "dup"; + "anamorphism" -> "genrec"; + "anamorphism" -> "swons"; + "anamorphism" -> "dip"; + "anamorphism" -> "swap"; + "anamorphism" -> "pop"; + "app1" -> "infrst"; + "app1" -> "grba"; + "app2" -> "ii"; + "app2" -> "cons"; + "app2" -> "infrst"; + "app2" -> "dip"; + "app2" -> "swap"; + "app2" -> "grba"; + "app3" -> "appN"; + "appN" -> "disenstacken"; + "appN" -> "map"; + "appN" -> "codi"; + "appN" -> "grabN"; + "at" -> "first"; + "at" -> "drop"; + "average" -> "/"; + "average" -> "cleave"; + "average" -> "size"; + "average" -> "sum"; + "b" -> "dip"; + "b" -> "i"; + "binary" -> "popd"; + "binary" -> "unary"; + "ccccons" -> "ccons"; + "ccons" -> "cons"; + "clear" -> "loop"; + "clear" -> "pop"; + "clear" -> "bool"; + "clear" -> "stack"; + "cleave" -> "popdd"; + "cleave" -> "fork"; + "clop" -> "popdd"; + "clop" -> "cleave"; + "codi" -> "dip"; + "codi" -> "cons"; + "codireco" -> "reco"; + "codireco" -> "codi"; + "dinfrirst" -> "infrst"; + "dinfrirst" -> "dip"; + "dipd" -> "codi"; + "dipd" -> "dip"; + "disenstacken" -> "pop"; + "disenstacken" -> "loop"; + "disenstacken" -> "uncons"; + "disenstacken" -> "?"; + "down_to_zero" -> "while"; + "down_to_zero" -> "--"; + "down_to_zero" -> "dup"; + "down_to_zero" -> ">"; + "drop" -> "times"; + "drop" -> "rest"; + "dupd" -> "dip"; + "dupd" -> "dup"; + "dupdd" -> "dipd"; + "dupdd" -> "dup"; + "dupdip" -> "dip"; + "dupdip" -> "dupd"; + "dupdipd" -> "dipd"; + "dupdipd" -> "dup"; + "enstacken" -> "dip"; + "enstacken" -> "clear"; + "enstacken" -> "stack"; + "flatten" -> "step"; + "flatten" -> "concat"; + "flatten" -> "<{}"; + "fork" -> "app2"; + "fork" -> "i"; + "fourth" -> "third"; + "fourth" -> "rest"; + "gcd" -> "pop"; + "gcd" -> "loop"; + "gcd" -> ">"; + "gcd" -> "dup"; + "gcd" -> "mod"; + "gcd" -> "tuck"; + "genrec" -> "ifte"; + "genrec" -> "concat"; + "genrec" -> "swons"; + "genrec" -> "nullary"; + "genrec" -> "ccccons"; + "genrec" -> "genrec"; + "grabN" -> "times"; + "grabN" -> "cons"; + "grabN" -> "<{}"; + "grba" -> "dip"; + "grba" -> "popd"; + "grba" -> "stack"; + "hypot" -> "sqrt"; + "hypot" -> "+"; + "hypot" -> "ii"; + "hypot" -> "sqr"; + "ifte" -> "branch"; + "ifte" -> "swap"; + "ifte" -> "dipd"; + "ifte" -> "nullary"; + "ii" -> "i"; + "ii" -> "dupdip"; + "ii" -> "dip"; + "infra" -> "dip"; + "infra" -> "i"; + "infra" -> "swaack"; + "infra" -> "swons"; + "infrst" -> "first"; + "infrst" -> "infra"; + "make_generator" -> "ccons"; + "make_generator" -> "codireco"; + "mod" -> "%"; + "neg" -> "-"; + "neg" -> "swap"; + "not" -> "branch"; + "nulco" -> "cons"; + "nulco" -> "nullary"; + "nullary" -> "dinfrirst"; + "nullary" -> "stack"; + "of" -> "at"; + "of" -> "swap"; + "pam" -> "map"; + "pam" -> "i"; + "pm" -> "clop"; + "pm" -> "-"; + "pm" -> "+"; + "popd" -> "dip"; + "popd" -> "pop"; + "popdd" -> "dipd"; + "popdd" -> "pop"; + "popop" -> "pop"; + "popopop" -> "popop"; + "popopop" -> "pop"; + "popopd" -> "dip"; + "popopd" -> "popop"; + "popopdd" -> "dipd"; + "popopdd" -> "popop"; + "product" -> "step"; + "product" -> "*"; + "product" -> "swap"; + "quoted" -> "dip"; + "quoted" -> "unit"; + "range" -> "anamorphism"; + "range" -> "dup"; + "range" -> "-"; + "range" -> "<="; + "range_to_zero" -> "infra"; + "range_to_zero" -> "down_to_zero"; + "range_to_zero" -> "unit"; + "reco" -> "cons"; + "reco" -> "rest"; + "rest" -> "infra"; + "rest" -> "pop"; + "reverse" -> "shunt"; + "reverse" -> "<{}"; + "roll>" -> "swapd"; + "roll>" -> "swap"; + "roll<" -> "swap"; + "roll<" -> "swapd"; + "rollup" -> "roll>"; + "rolldown" -> "roll<"; + "rrest" -> "rest"; + "run" -> "infra"; + "run" -> "<{}"; + "second" -> "first"; + "second" -> "rest"; + "shift" -> "dip"; + "shift" -> "swons"; + "shift" -> "uncons"; + "shunt" -> "step"; + "shunt" -> "swons"; + "size" -> "step_zero"; + "size" -> "++"; + "size" -> "pop"; + "spiral_next" -> "dip"; + "spiral_next" -> "ifte"; + "spiral_next" -> "--"; + "spiral_next" -> "++"; + "spiral_next" -> "&&"; + "spiral_next" -> "||"; + "spiral_next" -> "!-"; + "spiral_next" -> "pop"; + "spiral_next" -> "<>"; + "spiral_next" -> "<="; + "spiral_next" -> "ii"; + "spiral_next" -> "abs"; + "split_at" -> "clop"; + "split_at" -> "take"; + "split_at" -> "drop"; + "split_list" -> "clop"; + "split_list" -> "drop"; + "split_list" -> "reverse"; + "split_list" -> "take"; + "sqr" -> "*"; + "sqr" -> "dup"; + "stackd" -> "dip"; + "stackd" -> "stack"; + "step_zero" -> "step"; + "step_zero" -> "roll>"; + "sum" -> "step_zero"; + "sum" -> "+"; + "swapd" -> "dip"; + "swapd" -> "swap"; + "swons" -> "cons"; + "swons" -> "swap"; + "swoncat" -> "concat"; + "swoncat" -> "swap"; + "tailrec" -> "genrec"; + "tailrec" -> "i"; + "take" -> "pop"; + "take" -> "times"; + "take" -> "shift"; + "take" -> "roll>"; + "ternary" -> "popd"; + "ternary" -> "binary"; + "third" -> "second"; + "third" -> "rest"; + "tuck" -> "swapd"; + "tuck" -> "dup"; + "unary" -> "popd"; + "unary" -> "nullary"; + "uncons" -> "cleave"; + "uncons" -> "rest"; + "uncons" -> "first"; + "unit" -> "cons"; + "unquoted" -> "dip"; + "unquoted" -> "i"; + "unswons" -> "swap"; + "unswons" -> "uncons"; + "while" -> "loop"; + "while" -> "concat"; + "while" -> "dupdipd"; + "while" -> "nulco"; + "while" -> "swap"; + "x" -> "i"; + "x" -> "dup"; + "step" -> "x"; + "step" -> "_step0"; + "_step0" -> "branch"; + "_step0" -> "_stept"; + "_step0" -> "popopop"; + "_step0" -> "_step1"; + "_step1" -> "roll<"; + "_step1" -> "dipd"; + "_step1" -> "?"; + "_stept" -> "x"; + "_stept" -> "dip"; + "_stept" -> "dupdipd"; + "_stept" -> "dipd"; + "_stept" -> "uncons"; + "times" -> "x"; + "times" -> "_times0"; + "_times0" -> "branch"; + "_times0" -> "_timest"; + "_times0" -> "popopop"; + "_times0" -> "_times1"; + "_times1" -> "roll<"; + "_times1" -> "dipd"; + "_times1" -> ">"; + "_times1" -> "dup"; + "_timest" -> "x"; + "_timest" -> "dupdipd"; + "_timest" -> "dip"; + "_timest" -> "--"; + "map" -> "tailrec"; + "map" -> "dip"; + "map" -> "_mape"; + "map" -> "_map?"; + "map" -> "cons"; + "map" -> "_map0"; + "_map?" -> "not"; + "_map?" -> "bool"; + "_map?" -> "pop"; + "_mape" -> "reverse"; + "_mape" -> "popd"; + "_map0" -> "_map2"; + "_map0" -> "dipd"; + "_map0" -> "_map1"; + "_map1" -> "shift"; + "_map1" -> "stackd"; + "_map2" -> "swons"; + "_map2" -> "roll<"; + "_map2" -> "dipd"; + "_map2" -> "cons"; + "_map2" -> "infrst"; +} diff --git a/implementations/Prolog/jd.dot.svg b/implementations/Prolog/jd.dot.svg new file mode 100644 index 0000000..d01d0ce --- /dev/null +++ b/implementations/Prolog/jd.dot.svg @@ -0,0 +1,2671 @@ + + + + + + +joy_defs + + + +-- + +-- + + + +- + +- + + + +--->- + + + + + +? + +? + + + +bool + +bool + + + +?->bool + + + + + +dup + +dup + + + +?->dup + + + + + +&& + +&& + + + +branch + +branch + + + +&&->branch + + + + + +dip + +dip + + + +&&->dip + + + + + +nullary + +nullary + + + +&&->nullary + + + + + +nulco + +nulco + + + +&&->nulco + + + + + +stack + +stack + + + +nullary->stack + + + + + +dinfrirst + +dinfrirst + + + +nullary->dinfrirst + + + + + +nulco->nullary + + + + + +cons + +cons + + + +nulco->cons + + + + + +++ + +++ + + + ++ + ++ + + + +++->+ + + + + + +|| + +|| + + + +||->branch + + + + + +||->dip + + + + + +||->nullary + + + + + +||->nulco + + + + + +!- + +!- + + + +>= + +>= + + + +!-->>= + + + + + +<{} + +<{} + + + +swap + +swap + + + +<{}->swap + + + + + +<<{} + +<<{} + + + +rolldown + +rolldown + + + +<<{}->rolldown + + + + + +roll< + +roll< + + + +rolldown->roll< + + + + + +abs + +abs + + + +abs->dup + + + + + +abs->branch + + + + + +neg + +neg + + + +abs->neg + + + + + +< + +< + + + +abs->< + + + + + +neg->- + + + + + +neg->swap + + + + + +anamorphism + +anamorphism + + + +anamorphism->dip + + + + + +anamorphism->swap + + + + + +genrec + +genrec + + + +anamorphism->genrec + + + + + +swons + +swons + + + +anamorphism->swons + + + + + +pop + +pop + + + +anamorphism->pop + + + + + +genrec->nullary + + + + + +genrec->genrec + + + + + +genrec->swons + + + + + +ccccons + +ccccons + + + +genrec->ccccons + + + + + +concat + +concat + + + +genrec->concat + + + + + +ifte + +ifte + + + +genrec->ifte + + + + + +swons->swap + + + + + +swons->cons + + + + + +app1 + +app1 + + + +infrst + +infrst + + + +app1->infrst + + + + + +grba + +grba + + + +app1->grba + + + + + +first + +first + + + +infrst->first + + + + + +infra + +infra + + + +infrst->infra + + + + + +grba->dip + + + + + +popd + +popd + + + +grba->popd + + + + + +grba->stack + + + + + +app2 + +app2 + + + +app2->dip + + + + + +app2->swap + + + + + +app2->infrst + + + + + +app2->grba + + + + + +ii + +ii + + + +app2->ii + + + + + +app2->cons + + + + + +ii->dip + + + + + +i + +i + + + +ii->i + + + + + +dupdip + +dupdip + + + +ii->dupdip + + + + + +app3 + +app3 + + + +appN + +appN + + + +app3->appN + + + + + +disenstacken + +disenstacken + + + +appN->disenstacken + + + + + +map + +map + + + +appN->map + + + + + +codi + +codi + + + +appN->codi + + + + + +grabN + +grabN + + + +appN->grabN + + + + + +disenstacken->? + + + + + +disenstacken->pop + + + + + +loop + +loop + + + +disenstacken->loop + + + + + +uncons + +uncons + + + +disenstacken->uncons + + + + + +map->dip + + + + + +map->cons + + + + + +tailrec + +tailrec + + + +map->tailrec + + + + + +_mape + +_mape + + + +map->_mape + + + + + +_map? + +_map? + + + +map->_map? + + + + + +_map0 + +_map0 + + + +map->_map0 + + + + + +codi->dip + + + + + +codi->cons + + + + + +grabN-><{} + + + + + +grabN->cons + + + + + +times + +times + + + +grabN->times + + + + + +at + +at + + + +at->first + + + + + +drop + +drop + + + +at->drop + + + + + +drop->times + + + + + +rest + +rest + + + +drop->rest + + + + + +average + +average + + + +/ + +/ + + + +average->/ + + + + + +cleave + +cleave + + + +average->cleave + + + + + +size + +size + + + +average->size + + + + + +sum + +sum + + + +average->sum + + + + + +popdd + +popdd + + + +cleave->popdd + + + + + +fork + +fork + + + +cleave->fork + + + + + +size->++ + + + + + +size->pop + + + + + +step_zero + +step_zero + + + +size->step_zero + + + + + +sum->+ + + + + + +sum->step_zero + + + + + +b + +b + + + +b->dip + + + + + +b->i + + + + + +binary + +binary + + + +binary->popd + + + + + +unary + +unary + + + +binary->unary + + + + + +popd->dip + + + + + +popd->pop + + + + + +unary->nullary + + + + + +unary->popd + + + + + +ccons + +ccons + + + +ccccons->ccons + + + + + +ccons->cons + + + + + +clear + +clear + + + +clear->bool + + + + + +clear->pop + + + + + +clear->loop + + + + + +clear->stack + + + + + +popdd->pop + + + + + +dipd + +dipd + + + +popdd->dipd + + + + + +fork->app2 + + + + + +fork->i + + + + + +clop + +clop + + + +clop->cleave + + + + + +clop->popdd + + + + + +codireco + +codireco + + + +codireco->codi + + + + + +reco + +reco + + + +codireco->reco + + + + + +reco->cons + + + + + +reco->rest + + + + + +dinfrirst->dip + + + + + +dinfrirst->infrst + + + + + +dipd->dip + + + + + +dipd->codi + + + + + +uncons->first + + + + + +uncons->cleave + + + + + +uncons->rest + + + + + +down_to_zero + +down_to_zero + + + +down_to_zero->-- + + + + + +down_to_zero->dup + + + + + +while + +while + + + +down_to_zero->while + + + + + +> + +> + + + +down_to_zero->> + + + + + +while->nulco + + + + + +while->swap + + + + + +while->loop + + + + + +dupdipd + +dupdipd + + + +while->dupdipd + + + + + +while->concat + + + + + +x + +x + + + +times->x + + + + + +_times0 + +_times0 + + + +times->_times0 + + + + + +rest->pop + + + + + +rest->infra + + + + + +dupd + +dupd + + + +dupd->dup + + + + + +dupd->dip + + + + + +dupdd + +dupdd + + + +dupdd->dup + + + + + +dupdd->dipd + + + + + +dupdip->dip + + + + + +dupdip->dupd + + + + + +dupdipd->dup + + + + + +dupdipd->dipd + + + + + +enstacken + +enstacken + + + +enstacken->dip + + + + + +enstacken->clear + + + + + +enstacken->stack + + + + + +flatten + +flatten + + + +flatten-><{} + + + + + +step + +step + + + +flatten->step + + + + + +flatten->concat + + + + + +step->x + + + + + +_step0 + +_step0 + + + +step->_step0 + + + + + +fourth + +fourth + + + +fourth->rest + + + + + +third + +third + + + +fourth->third + + + + + +third->rest + + + + + +second + +second + + + +third->second + + + + + +gcd + +gcd + + + +gcd->dup + + + + + +gcd->pop + + + + + +gcd->loop + + + + + +gcd->> + + + + + +mod + +mod + + + +gcd->mod + + + + + +tuck + +tuck + + + +gcd->tuck + + + + + +%226432 + +%1079413561 + + + +mod->%0 + + + + + +tuck->dup + + + + + +swapd + +swapd + + + +tuck->swapd + + + + + +ifte->branch + + + + + +ifte->nullary + + + + + +ifte->swap + + + + + +ifte->dipd + + + + + +hypot + +hypot + + + +hypot->+ + + + + + +hypot->ii + + + + + +sqrt + +sqrt + + + +hypot->sqrt + + + + + +sqr + +sqr + + + +hypot->sqr + + + + + +sqr->dup + + + + + +* + +* + + + +sqr->* + + + + + +infra->dip + + + + + +infra->swons + + + + + +infra->i + + + + + +swaack + +swaack + + + +infra->swaack + + + + + +make_generator + +make_generator + + + +make_generator->ccons + + + + + +make_generator->codireco + + + + + +not + +not + + + +not->branch + + + + + +of + +of + + + +of->swap + + + + + +of->at + + + + + +pam + +pam + + + +pam->map + + + + + +pam->i + + + + + +pm + +pm + + + +pm->- + + + + + +pm->+ + + + + + +pm->clop + + + + + +popop + +popop + + + +popop->pop + + + + + +popopop + +popopop + + + +popopop->pop + + + + + +popopop->popop + + + + + +popopd + +popopd + + + +popopd->dip + + + + + +popopd->popop + + + + + +popopdd + +popopdd + + + +popopdd->dipd + + + + + +popopdd->popop + + + + + +product + +product + + + +product->swap + + + + + +product->step + + + + + +product->* + + + + + +quoted + +quoted + + + +quoted->dip + + + + + +unit + +unit + + + +quoted->unit + + + + + +unit->cons + + + + + +range + +range + + + +range->- + + + + + +range->dup + + + + + +range->anamorphism + + + + + +<= + +<= + + + +range-><= + + + + + +range_to_zero + +range_to_zero + + + +range_to_zero->down_to_zero + + + + + +range_to_zero->infra + + + + + +range_to_zero->unit + + + + + +reverse + +reverse + + + +reverse-><{} + + + + + +shunt + +shunt + + + +reverse->shunt + + + + + +shunt->swons + + + + + +shunt->step + + + + + +roll> + +roll> + + + +roll>->swap + + + + + +roll>->swapd + + + + + +swapd->dip + + + + + +swapd->swap + + + + + +roll<->swap + + + + + +roll<->swapd + + + + + +rollup + +rollup + + + +rollup->roll> + + + + + +rrest + +rrest + + + +rrest->rest + + + + + +run + +run + + + +run-><{} + + + + + +run->infra + + + + + +second->first + + + + + +second->rest + + + + + +shift + +shift + + + +shift->dip + + + + + +shift->swons + + + + + +shift->uncons + + + + + +step_zero->step + + + + + +step_zero->roll> + + + + + +spiral_next + +spiral_next + + + +spiral_next->-- + + + + + +spiral_next->&& + + + + + +spiral_next->dip + + + + + +spiral_next->++ + + + + + +spiral_next->|| + + + + + +spiral_next->!- + + + + + +spiral_next->abs + + + + + +spiral_next->pop + + + + + +spiral_next->ii + + + + + +spiral_next->ifte + + + + + +spiral_next-><= + + + + + +<> + +<> + + + +spiral_next-><> + + + + + +split_at + +split_at + + + +split_at->drop + + + + + +split_at->clop + + + + + +take + +take + + + +split_at->take + + + + + +take->pop + + + + + +take->times + + + + + +take->roll> + + + + + +take->shift + + + + + +split_list + +split_list + + + +split_list->drop + + + + + +split_list->clop + + + + + +split_list->reverse + + + + + +split_list->take + + + + + +stackd + +stackd + + + +stackd->dip + + + + + +stackd->stack + + + + + +swoncat + +swoncat + + + +swoncat->swap + + + + + +swoncat->concat + + + + + +tailrec->genrec + + + + + +tailrec->i + + + + + +ternary + +ternary + + + +ternary->binary + + + + + +ternary->popd + + + + + +unquoted + +unquoted + + + +unquoted->dip + + + + + +unquoted->i + + + + + +unswons + +unswons + + + +unswons->swap + + + + + +unswons->uncons + + + + + +x->dup + + + + + +x->i + + + + + +_step0->branch + + + + + +_step0->popopop + + + + + +_stept + +_stept + + + +_step0->_stept + + + + + +_step1 + +_step1 + + + +_step0->_step1 + + + + + +_stept->dip + + + + + +_stept->dipd + + + + + +_stept->uncons + + + + + +_stept->dupdipd + + + + + +_stept->x + + + + + +_step1->? + + + + + +_step1->dipd + + + + + +_step1->roll< + + + + + +_times0->branch + + + + + +_times0->popopop + + + + + +_timest + +_timest + + + +_times0->_timest + + + + + +_times1 + +_times1 + + + +_times0->_times1 + + + + + +_timest->-- + + + + + +_timest->dip + + + + + +_timest->dupdipd + + + + + +_timest->x + + + + + +_times1->dup + + + + + +_times1->dipd + + + + + +_times1->> + + + + + +_times1->roll< + + + + + +_mape->popd + + + + + +_mape->reverse + + + + + +_map?->bool + + + + + +_map?->pop + + + + + +_map?->not + + + + + +_map0->dipd + + + + + +_map2 + +_map2 + + + +_map0->_map2 + + + + + +_map1 + +_map1 + + + +_map0->_map1 + + + + + +_map2->swons + + + + + +_map2->infrst + + + + + +_map2->cons + + + + + +_map2->dipd + + + + + +_map2->roll< + + + + + +_map1->shift + + + + + +_map1->stackd + + + + + diff --git a/implementations/Prolog/source/agl.PNG b/implementations/Prolog/source/agl.PNG new file mode 100644 index 0000000..ba9a729 Binary files /dev/null and b/implementations/Prolog/source/agl.PNG differ diff --git a/implementations/Prolog/source/b-joy.pl b/implementations/Prolog/source/b-joy.pl new file mode 100644 index 0000000..152bb6e --- /dev/null +++ b/implementations/Prolog/source/b-joy.pl @@ -0,0 +1,228 @@ +:- use_module(library(clpfd)). +:- use_module(library(dcg/basics)). +:- dynamic func/3. +:- dynamic def/2. +/* + + 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 . + +A version of joy with just lists and symbols, data structures are +logical expressions in LoF notation, optionally organised in lists. +No distinction is made syntactically or semantically between lists-as-forumla +and lists-as-containers, 'tis done by usage. + + [] as zero / false + [[]] as true (1 in Peano arith) + + ((A)(B)) OR + A B AND + ((A) B) B IMPLIES A + + (A(B)) ((A)B) EQUIV (A IMPLIES B) AND (B IMPLIES A) + ((A(B)) ((A)B)) XOR + + + + + _ _ ( ( )) (( ) ) _ + o _ (o( )) ((o) ) o + _ o ( (o)) (( )o) o + o o (o(o)) ((o)o) _ + + _ _ ( ) o + o _ (o) _ + _ o ( )o o + o o (o)o o + + _ _ (( ) ) _ + o _ ((o) ) o + _ o (( )o) _ + o o ((o)o) _ + + + +*/ + +joy(InputString, StackIn, StackOut) :- + phrase(joy_parse(Expression), InputString), !, + thun(Expression, StackIn, StackOut). + +joy_parse([J|Js]) --> blanks, joy_term(J), blanks, joy_parse(Js). +joy_parse([]) --> blanks. +joy_term(list(J)) --> "[", !, joy_parse(J), "]". +joy_term(symbol(S)) --> symbol(S). +symbol(C) --> chars(Chars), !, {atom_string(C, Chars)}. +chars([Ch|Rest]) --> char(Ch), chars(Rest). +chars([Ch]) --> char(Ch). +char(Ch) --> [Ch], {Ch \== 91, Ch \== 93, code_type(Ch, graph)}. + +thun([], S, S). +% thun(E, Si, _) :- show_it(E, Si), fail. % To visualize the evaluation. +thun([Term|E], S0, S) :- thun(Term, E, S0, S). + +thun(list(L), Expr, S0, S) :- thun(Expr, [list(L)|S0], S). +thun(symbol(Name), Expr0, S0, S) :- + ( def(Name, Body), append(Body, Expr0, Expr), S1=S0 + ; func(Name, S0, S1), Expr0=Expr + ; combo(Name, S0, S1, Expr0, Expr) + ), thun(Expr, S1, S). + +show_it(E, Si) :- + joy_terms_to_string(E, Es), + is_list(Si), reverse(Si, Is), + joy_terms_to_string(Is, Sis), + write(Sis), write(' . '), writeln(Es). + +% joy_terms_to_string(So, S) + +func(void, [A|S], [B|S]) :- void(A, B). +% func(or, [A, B|S], [[[B], [A]]|S]). +% func(and, [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(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(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). + +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(_), list([list([])])|S], S, Ei, Eo) :- append(T, Ei, Eo). +combo(branch, [list(_), list(F), list([]) |S], S, Ei, Eo) :- append(F, Ei, Eo). +combo(loop, [list(_), list([]) |S], S, E, E ). +combo(loop, [list(B), list([list([])])|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(_), list([]) |S], S, E, E ). +combo(times, [list(P), list([list([])])|S], S, Ei, Eo) :- append(P, Ei, Eo). +combo(times, [list(P), list([list(L )])|S], S, Ei, Eo) :- + L \= [], append(P, [list(L), list(P), symbol(times)|Ei], Eo). +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). +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). + +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). + + +term_expansion(def(Def), def(Name, Body)) :- + phrase(joy_parse([symbol(Name)|Body]), Def), + % Don't let defs "shadow" functions or combinators. + \+ ( func(Name, _, _) ; combo(Name, _, _, _, _) ). + +% def(``). +def(`and duo unit`). +def(`app2 [grba swap grba swap] dip [infrst] cons ii`). +def(`b [i] dip i`). +def(`cleave fork popdd`). +def(`clop cleave popdd`). +def(`duo unit cons`). +def(`fba [xor xor void] [[and] [xor and] fork or void] clop popdd`). +def(`fork [i] app2`). +def(`grba [stack popd] dip`). +def(`ii [dip] dupdip i`). +def(`infra swons swaack [i] dip swaack`). +def(`infrst infra first`). +def(`or [unit] ii duo`). +def(`popd [pop] dip`). +def(`popdd [pop] dipd`). +def(`popop pop pop`). +def(`swons swap cons`). +def(`uncons-pair [uncons] dip unswons rolldown`). +def(`unswons uncons swap`). +def(`xor [unit] ii [cons] [swap cons] clop duo`). + + +format_joy_expression( V ) --> { var(V), ! }, "...". +format_joy_expression(symbol(S)) --> !, { atom_codes(S, Codes) }, Codes. +format_joy_expression( list(J)) --> "[", format_joy_terms(J), "]". +format_joy_terms( []) --> []. +format_joy_terms( [T]) --> format_joy_expression(T), !. +format_joy_terms([T|Ts]) --> format_joy_expression(T), " ", format_joy_terms(Ts). +joy_terms_to_string(Expr, String) :- + format_joy_terms(Expr, Codes, []), + string_codes(String, Codes). + +/* Reduce arithmetic formula to Mark or Void */ + +void( list([]), list([]) ) :- !. +void(list([list([])]), list([list([])])) :- !. +void(list([ A |_]), list([list([])])) :- void(A, list([]) ), !. +void(list([ A |S]), V ) :- void(A, list([list([])])), void(list(S), V). + + +symbols(E, S) :- symbols(E, [], S). + +symbols(symbol(S)) --> seen_sym(S), !. +symbols(symbol(S)), [S] --> []. +symbols( list([])) --> []. +symbols(list([T|Tail])) --> symbols(T), symbols(list(Tail)). + +seen_sym(Term, List, List) :- member(Term, List). + +fooooo :- forall(def(Symbol, Body), + ( + symbols(list(Body), Deps), + forall(member(Dep, Deps), + ( + write(Symbol), + write(" -> "), + write(Dep), + writeln(";") + ) + ) + ) +). + + +/* + + + +ᴀ?- joy(`[] [ [] [[]] [] ] [or] step void`, Si, So), !, joy_terms_to_string(So, S). +Si = [], +So = [list([list([])])], +S = "[[]]". + +?- joy(`[[]] [ [[]] [[]] [[]] [[]] ] [and] step void`, Si, So), !, joy_terms_to_string(So, S). +Si = [], +So = [list([list([])])], +S = "[[]]". + + + */ \ No newline at end of file diff --git a/implementations/Prolog/source/bleah.code-workspace b/implementations/Prolog/source/bleah.code-workspace new file mode 100644 index 0000000..f804ba3 --- /dev/null +++ b/implementations/Prolog/source/bleah.code-workspace @@ -0,0 +1,14 @@ +{ + "folders": [ + { + "path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\Thun" + }, + { + "path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\yrad-nettles" + }, + { + "path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\prolog-markdown" + } + ], + "settings": {} +} \ No newline at end of file diff --git a/implementations/Prolog/source/canhazmd.pl b/implementations/Prolog/source/canhazmd.pl new file mode 100644 index 0000000..7695384 --- /dev/null +++ b/implementations/Prolog/source/canhazmd.pl @@ -0,0 +1,45 @@ +:- use_module(library(md/md_parse)). + +fn("C:/Users/sforman/Desktop/src/PROLOG/Thun/docs/reference/Functor-Reference.md"). + +do(X) :- + fn(Fn), + md_parse_file(Fn, Blocks), + split_on_hr([_|X], Blocks), !. % Ignore the header for now + + +% Split a list of HTML stuff into sublists on
tags. +split_on_hr([Thing|Rest], Blocks) :- append(Thing, [hr([])|Tail], Blocks), !, split_on_hr(Rest, Tail). +split_on_hr(Blocks, Blocks). + + +bar([h2(Name)|_]) :- writeln(Name). + + +fooober(Name, [preable(Preamble)|Sections]) --> [h2(Name)], parts(Preamble), sections(Sections). + +sections([S|Rest]) --> section(S), sections(Rest). +sections([]) --> []. + +section(definition(Stuff)) --> [h3("Definition")], parts(Stuff). +section(derivation(Stuff)) --> [h3("Derivation")], parts(Stuff). +section(source(Stuff)) --> [h3("Source")], parts(Stuff). +section(discussion(Stuff)) --> [h3("Discussion")], parts(Stuff). +section(crosslinks(Stuff)) --> [h3("Crosslinks")], parts(Stuff). + +parts([P|Ps]) --> part(P), !, parts(Ps). +parts([]) --> []. + +part(p(P)) --> [p(P)]. +part(pre(P)) --> [pre(P)]. + +% ... --> [] | [_], ... . + +/* + +?- do([_, _, X|_]), fooober(Name, Docs, X, _), !. +X = [h2("b"), p([\["(Combinator)"]]), p([\["Run two quoted programs"]]), pre(code(" [P] [Q] b\n---------------\n P Q")), h3("Definition"), pre(code("[i] dip i")), h3("Derivation"), pre(code(...)), h3(...)|...], +Name = "b", +Docs = [preable([p([\["(Combinator)"]]), p([\["Run two quoted programs"]]), pre(code(" [P] [Q] b\n---------------\n P Q"))]), definition([pre(code("[i] dip i"))]), derivation([pre(code("[P] [Q] b\n[P] [Q] [i] dip i\n[P] i [Q] i\n P [Q] i\n P Q"))]), discussion([p([\[...]])]), crosslinks([p([a(..., ...)|...])])]. + + */ \ No newline at end of file diff --git a/implementations/Prolog/source/client/elm.json b/implementations/Prolog/source/client/elm.json new file mode 100644 index 0000000..1208d3d --- /dev/null +++ b/implementations/Prolog/source/client/elm.json @@ -0,0 +1,24 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.4", + "elm/html": "1.0.0", + "elm/url": "1.0.0" + }, + "indirect": { + "elm/json": "1.1.3", + "elm/time": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/implementations/Prolog/source/client/index.html b/implementations/Prolog/source/client/index.html new file mode 100644 index 0000000..6d58003 --- /dev/null +++ b/implementations/Prolog/source/client/index.html @@ -0,0 +1,6127 @@ + + + + + Main + + + + + +

+
+
+
+
+
\ No newline at end of file
diff --git a/implementations/Prolog/source/client/src/Main.elm b/implementations/Prolog/source/client/src/Main.elm
new file mode 100644
index 0000000..1a94815
--- /dev/null
+++ b/implementations/Prolog/source/client/src/Main.elm
@@ -0,0 +1,116 @@
+module Main exposing (main)
+
+import Browser
+import Browser.Navigation as Nav
+import Html exposing (a, b, li, text, ul, Html)
+import Html.Attributes exposing (href)
+import Url
+import Url.Parser exposing (Parser, parse, string, s, ())
+
+-- MAIN
+main : Program () Model Msg
+main =
+  Browser.application
+    { init = init
+    , view = view
+    , update = update
+    , subscriptions = subscriptions
+    , onUrlChange = UrlChanged
+    , onUrlRequest = LinkClicked
+    }
+
+-- MODEL
+type alias Model =
+  { key : Nav.Key
+  , url : Url.Url
+  }
+
+
+init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
+init _ url key =
+  -- ignore flags arg
+  ( Model key url, Cmd.none )
+
+-- UPDATE
+type Msg
+  = LinkClicked Browser.UrlRequest
+  | UrlChanged Url.Url
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+  case msg of
+    LinkClicked urlRequest ->
+      case urlRequest of
+        Browser.Internal url ->
+          -- Don't clutter browser history if the user clicks links to
+          -- the current URL.
+          if url == model.url then
+            ( model, Cmd.none )
+          else
+            ( model, Nav.pushUrl model.key (Url.toString url) )
+
+        Browser.External href ->
+          ( model, Nav.load href )
+
+    UrlChanged url ->
+      ( { model | url = url }
+      , Cmd.none
+      )
+
+-- SUBSCRIPTIONS
+
+subscriptions : Model -> Sub Msg
+subscriptions _ =
+  Sub.none
+
+-- VIEW
+
+view : Model -> Browser.Document Msg
+view model =
+  case parse docFunct model.url of
+    Nothing ->
+      viewGeneric (Url.toString model.url)
+    Just functor_name ->
+      viewFunctorDocs functor_name
+
+
+viewGeneric : String -> Browser.Document Msg
+viewGeneric current =
+  { title = "URL Interceptor: " ++ current
+  , body =
+      [ text "The current URL is: "
+      , b [] [ text current ]
+      , ul []
+          [ viewLink "Home" "/home"
+          , viewLink "Profile" "/profile"
+          , viewLink "Cent" "/reviews/the-century-of-the-self"
+          , viewLink "Pub" "/reviews/public-opinion"
+          , viewLink "cons" "/doc/functors/cons"
+          ]
+      ]
+  }
+
+
+viewFunctorDocs : String -> Browser.Document Msg
+viewFunctorDocs functor_name =
+  { title = "Reference: " ++ functor_name
+  , body =
+      [ text "Reference documentation for "
+      , b [] [ text functor_name ]
+      , ul []
+          [ viewLink "Home" "/home"
+          , viewLink "cons" "/doc/functors/cons"
+          ]
+      ]
+  }
+
+
+viewLink : String -> String -> Html msg
+viewLink link_text path =
+  li [] [ a [ href path ] [ text link_text ] ]
+
+
+docFunct : Parser (String -> a) a
+docFunct =
+  s "doc"  s "functors"  string
diff --git a/implementations/Prolog/source/defs.txt b/implementations/Prolog/source/defs.txt
new file mode 100644
index 0000000..5a40424
--- /dev/null
+++ b/implementations/Prolog/source/defs.txt
@@ -0,0 +1,115 @@
+-- 1 -
+? dup bool
+&& nulco [nullary [false]] dip branch
+++ 1 +
+|| nulco [nullary] dip [true] branch
+!- 0 >=
+<{} [] swap
+<<{} [] rolldown
+abs dup 0 < [] [neg] branch
+anamorphism [pop []] swap [dip swons] genrec
+app1 grba infrst
+app2 [grba swap grba swap] dip [infrst] cons ii
+app3 3 appN
+appN [grabN] codi map disenstacken
+at drop first
+average [sum] [size] cleave /
+b [i] dip i
+binary unary popd
+ccccons ccons ccons
+ccons cons cons
+clear stack bool [pop stack bool] loop
+cleave fork popdd
+clop cleave popdd
+codi cons dip
+codireco codi reco
+dinfrirst dip infrst
+dipd [dip] codi
+disenstacken ? [uncons ?] loop pop
+down_to_zero [0 >] [dup --] while
+drop [rest] times
+dupd [dup] dip
+dupdd [dup] dipd
+dupdip dupd dip
+dupdipd dup dipd
+enstacken stack [clear] dip
+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
+make_generator [codireco] ccons
+mod %
+neg 0 swap -
+not [true] [false] branch
+nulco [nullary] cons
+nullary [stack] dinfrirst
+of swap at
+pam [i] map
+pm [+] [-] clop
+popd [pop] dip
+popdd [pop] dipd
+popop pop pop
+popopop pop popop
+popopd [popop] dip
+popopdd [popop] dipd
+product 1 swap [*] step
+quoted [unit] dip
+range [0 <=] [1 - dup] anamorphism
+range_to_zero unit [down_to_zero] infra
+reco rest cons
+rest [pop] infra
+reverse <{} shunt
+roll> swap swapd
+roll< swapd swap
+rollup roll>
+rolldown roll<
+rrest rest rest
+run <{} infra
+second rest first
+shift uncons [swons] dip
+shunt [swons] step
+size [pop ++] step_zero
+spiral_next [[[abs] ii <=] [[<>] [pop !-] ||] &&] [[!-] [[++]] [[--]] ifte dip] [[pop !-] [--] [++] ifte] ifte
+split_at [drop] [take] clop
+split_list [take reverse] [drop] clop
+sqr dup *
+stackd [stack] dip
+step_zero 0 roll> step
+sum [+] step_zero
+swapd [swap] dip
+swons swap cons
+swoncat swap concat
+tailrec [i] genrec
+take [] roll> [shift] times pop
+ternary binary popd
+third rest second
+tuck dup swapd
+unary nullary popd
+uncons [first] [rest] cleave
+unit [] cons
+unquoted [i] dip
+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
diff --git a/implementations/Prolog/source/derp.pl b/implementations/Prolog/source/derp.pl
new file mode 100644
index 0000000..998de2b
--- /dev/null
+++ b/implementations/Prolog/source/derp.pl
@@ -0,0 +1,130 @@
+% :− module(autodiff2, [mul/3, add/3, pow/3, exp/2, log/2, deriv/3, 2back/1, compile/0]).
+% :− use_module(library(chr)).
+% :− chr_constraint add(?, ?, −), mul(?, ?, −), log(−, −), exp(−, −), pow(+, −, −), 5deriv(?, −, ?), agg(?, −), acc(?, −), acc(−), go, compile.
+
+% mul(0.0,_,Y) ⇔ Y=0.0.
+
+:- module(autodiff, [mul/3, add/3, pow/3, exp/2, llog/2, log/2, deriv/3, back/1, compile/0
+                    ,derivs/3, taylor/4]).
+/**  Reverse mode automatic differentiation
+
+    This module implements a CHR-based approach to reverse-mode automatic differentiation
+    by providing a set of CHR constraints representing arithmetic operators, such as
+    add/3 and mul/3, a constraint deriv/3 to request the derivative of one variable with
+    respect to another, back/1 to initiate derivative back-propagation, and compile/0 to
+    reduce arithmetic constraints to frozen goals for numeric computations.
+    
+    The idea is that the arithmetic constraints are used to build up a representation of
+    a computation graph in the constraint store, with variables in the graph represented by
+    Prolog variables in the store. Then, deriv/3, back/1 and compile/0 must be used in that
+    order to get numeric results, eg:
+    ==
+    ?- foldl(mul,[X1,X2,X3],1.0,Prod), maplist(deriv(Prod),[X1,X2,X3],[D1,D2,D3]),
+       back(Prod), compile, [X1,X2,X3]=[2.0,3.0,4.0].
+    ==
+    Copyright (C) Samer Abdallah, 2017.
+    All rights reserved.
+*/
+:- use_module(library(chr)).
+
+:- chr_constraint add(?,?,-), mul(?,?,-), llog(-,-), log(-,-), exp(-,-), pow(+,-,-),
+                  deriv(?,-,?), agg(?,-), acc(?,-), acc(-), go, compile.
+
+% operations interface with simplifications
+mul(0.0,_,Y) <=> Y=0.0.
+mul(_,0.0,Y) <=> Y=0.0.
+mul(1.0,X,Y) <=> Y=X.
+mul(X,1.0,Y) <=> Y=X.
+mul(X,Y,Z1) \ mul(X,Y,Z2) <=> Z1=Z2.
+pow(1,X,Y) <=> Y=X.
+pow(0,_,Y) <=> Y=1.
+add(0.0,X,Y) <=> Y=X.
+add(X,0.0,Y) <=> Y=X.
+add(X,Y,Z1) \ add(X,Y,Z2) <=> Z1=Z2.
+
+%% back(Y:float) is det.
+%  Initiatiate derivative back-propagation starting from a variable Y. 
+%  Starting with deriv(Y,Y,1.0), this inserts constraints into the store
+%  representing derivatives dY/dX for all variables reachable by traversing
+%  the computation graph backwards from Y, that is all variables that 
+%  contribute to the computation of Y. Once this back-propagation is complete,
+%  then (using go/0) all the deriv/3 constraints are removed and the constraints 
+%  representing the aggregation of the derivatives (acc/1 and agg/2) are processed 
+%  to reduce them to a collection of arithmetic constraints representing the 
+%  computation. This means that the derivatives can themselves be differentiated 
+%  further if desired.
+%  
+%  This process computes ALL the derivatives travelling backwards from Y, but
+%  the caller must pick out which derivatives are to be made available to the
+%  rest of the program by inserting deriv/3 constraints BEFORE calling back/1.
+%
+%  If Y is not a variable, nothing happens. 
+back(Y) :- var(Y) -> deriv(Y,Y,1.0), go; true.
+
+go \ deriv(_,_,_) <=> true.
+go \ acc(DX) <=> acc(0.0,DX).
+go <=> true.
+
+acc(S1,X), agg(Z,X) <=> add(Z,S1,S2), acc(S2,X).
+acc(S,X) <=> S=X.
+
+%% deriv(Y:float,--X:float,D:float) is det.
+%  CHR constraint meaning 'the derivative of Y with respect to X is D'.
+%  It serves two purposes. Firstly, it causes a recursive back-propagation
+%  of derivatives from X to all nodes backward-reachable from X. Secondly,
+%  when used before back/1, it provides access to computed derivatives via
+%  the third argument.
+deriv(L,X,DX) \ deriv(L,X,DX1) <=> DX=DX1.
+deriv(L,_,DX) <=> ground(L) | DX=0.0.
+deriv(_,_,DX) ==> var(DX) | acc(DX).
+deriv(L,Y,DY), pow(K,X,Y)   ==> deriv(L,X,DX), pow_contrib(K,X,DY,Z), agg(Z,DX).
+deriv(L,Y,DY), exp(X,Y)     ==> deriv(L,X,DX), mul(Y,DY,T), agg(T,DX).
+deriv(L,Y,DY), log(X,Y)     ==> deriv(L,X,DX), pow(-1,X,RX), mul(RX,DY,T), agg(T,DX).
+deriv(L,Y,DY), add(X1,X2,Y) ==> maplist(add_contrib(L,DY),[X1,X2]).
+deriv(L,Y,DY), mul(X1,X2,Y) ==> maplist(mul_contrib(L,DY),[X1,X2],[X2,X1]).
+deriv(L,Y,DY), agg(X1,Y)    ==> add_contrib(L,DY,X1).
+
+pow_contrib(K,X,DY,Z)   :- K1 is K - 1, KK is float(K), pow(K1,X,XpowK1), mul(KK,XpowK1,W), mul(DY,W,Z).
+mul_contrib(L,DY,X1,X2) :- var(X1) -> deriv(L,X1,DX1), mul(X2,DY,T1), agg(T1,DX1); true.
+add_contrib(L,DY,X1)    :- var(X1) -> deriv(L,X1,DX1), agg(DY,DX1); true.
+
+acc(X) \ acc(X) <=> true.
+
+%% compile is det.
+%  When this constraint is inserted into the store, it causes any
+%  arithmetic constraints (add/3, mul/3 etc) to be converted into
+%  frozen evaluations, which will yield numeric answers as soon as
+%  their arguments are sufficiently grounded. NB. the computation 
+%  graph is destroyed! Use this after back/1 has been used as many
+%  times as desired to get any derivatives of interest.
+compile \ add(X,Y,Z) <=> delay(X+Y,Z).
+compile \ mul(X,Y,Z) <=> delay(X*Y,Z).
+compile \ add(X,Y,Z) <=> delay(X+Y,Z).
+compile \ log(X,Y)   <=> delay(log(X),Y).
+compile \ exp(X,Y)   <=> delay(exp(X),Y).
+compile \ pow(K,X,Y) <=> delay(X**K,Y).
+compile <=> true.
+
+delay(Expr,Res) :- when(ground(Expr), Res is Expr).
+
+% ------------ multiple derivatives and Taylor series ----------
+
+%% derivs(Y:float,X:float,Ds:list(float)) is det.
+%  Unifies Ds with a list of variables representing derivatives
+%  Y with respect to X, starting with the zeroth order Y itself,
+%  followed by dY/dX, d(dY/dX)/dX, etc.
+derivs(Y,X,[Y|Ds]) :- foldl(d(X),Ds,Y,_).
+d(X,DYDX,Y,DYDX) :- deriv(Y,X,DYDX), back(Y).
+
+%% taylor(+N:nonneg, X:float, Y:float, -Cs:list(float)) is det.
+%  Compute coefficients of the Taylor series expansion of Y
+%  as a function of X, by computing derivatives at X=0.0.
+%  NB. constraint store representation of the computation graph
+%  is destroyed in the process!
+taylor(N,X,Y,Cs0) :-
+   length(Ds,N), derivs(Y,X,Ds),
+   compile, X=0.0,
+   numlist(1,N,Is),
+   foldl(nth_deriv_coeff,Is,Ds,Cs,1.0,_).
+
+nth_deriv_coeff(I,D,C,P1,P2) :- P2 is P1*I, C is D/P1.
\ No newline at end of file
diff --git a/implementations/Prolog/source/derp.py b/implementations/Prolog/source/derp.py
new file mode 100644
index 0000000..2a96c9c
--- /dev/null
+++ b/implementations/Prolog/source/derp.py
@@ -0,0 +1,40 @@
+
+
+def step(stack, expression, dictionary):
+    (program, (seq, stack)) = stack
+    while seq:
+        item, seq = seq
+        stack = joy((item, stack), program, dictionary)[0]
+    return stack, expression, dictionary
+
+
+def step_jit(stack, expression, dictionary):
+    (program, (seq, stack)) = stack
+    try:
+        p = joyc(program)
+    except:
+        return step(stack, expression, dictionary)
+    while seq:
+        item, seq = seq
+        stack = p((item, stack), (), dictionary)[0]
+    return stack, expression, dictionary
+
+
+def step_exact_semantics(stack, expression, dictionary):
+    (program, (seq, stack)) = stack
+    if seq:
+        item, seq = seq
+        stack = item, stack
+        expression = concat(program, (seq, (program, (expression))))
+    return stack, expression, dictionary
+
+
+
+# [+] step
+def fn(stack, expression, dictionary):
+    (s1, (i1, stack)) = stack
+    while s1:
+        (i2, s1) = s1
+        i3 = i2 + i1
+        (i1, stack) = (i3, stack)
+    return (i1, stack), expression, dictionary
diff --git a/implementations/Prolog/source/fuuu.pl b/implementations/Prolog/source/fuuu.pl
new file mode 100644
index 0000000..d34180c
--- /dev/null
+++ b/implementations/Prolog/source/fuuu.pl
@@ -0,0 +1,527 @@
+f, [foo] --> [bar].  % f([bar|A], [foo|A]).
+g, [bas] --> [quo].  % g([quo|A], [bas|A]).
+
+end, [end] --> [].   % end(A, [end|A]).
+
+
+k --> f, g, end.
+% k(A, B) :- f(A, C), g(C, D), end(D, B).
+
+/* So I DON'T know what I was doing.
+
+f replaces foo with bar and then passes the whole enchilada on to the
+next predicate.  I guess I somehow thought it was building an output list
+or something?
+
+ */
+
+/*
+
+?- gronk("fn", `[swap] [] branch `).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        stack = (v2, (v3, stack))
+    else:
+        stack = (v3, (v2, stack))
+    return stack, expression, dictionary
+
+
+
+?- gronk("fn", `[swap] [] branch pop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        (v4, stack) = (v2, (v3, stack))
+    else:
+        (v4, stack) = (v3, (v2, stack))
+    return stack, expression, dictionary
+
+
+
+?- gronk("fn", `over over > [swap] [] branch pop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v2 > v1
+    if v3:
+        (v4, stack) = (v1, (v2, stack))
+    else:
+        (v4, stack) = (v2, (v1, stack))
+    return stack, expression, dictionary
+
+
+
+Here's a case where factoring the pop to after the branch results in
+inefficient code.  (Compare the function below to the versions above.  It
+doesn't create and then immediately discard a v4 variable.)
+
+?- gronk("fn", `[swap pop] [pop] branch`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        stack = (v3, stack)
+    else:
+        stack = (v2, stack)
+    return stack, expression, dictionary
+
+
+ */
+/*
+
+gronk_fn_list([symbol(*)], [int(A),int(A)|B], StackOut, [tab,"return ",stack_to_python(StackOut),", expression, dictionary",nl], CGTail, 1)
+
+
+def fn(stack, expression, dictionary):
+    tos = True
+    while tos:
+        (v1, (v2, stack)) = stack
+        v3 = v2 % v1
+        tos = v3 > 0
+        stack = (v3, (v1, stack))
+    (v4, stack) = stack
+    return stack, expression, dictionary
+
+
+Close, but broken.  THe boundaries between blocks are too permeable.
+
+?- gronk("fn", `true [>] loop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    tos = True
+    while tos:
+        v3 = v1 > v2
+        tos = v3
+    return stack, expression, dictionary
+
+
+
+
+gronk_fn_list(
+    [symbol(*)],
+    [int(A),int(A)|B],
+    StackOut,
+    [tab,"return ",stack_to_python(StackOut),", expression, dictionary",nl],
+    CGTail,
+    1
+    ).
+
+
+
+
+
+
+
+?- gronk("fn", `stack`).
+
+def fn(stack, expression, dictionary):
+    stack = stack
+    return ((), stack), expression, dictionary
+
+SHould be
+
+?- gronk("fn", `stack`).
+
+def fn(stack, expression, dictionary):
+    return (stack, stack), expression, dictionary
+
+
+
+Okay then...
+
+?- gronk("fn", `over over + stack dup`).
+
+def fn(stack, expression, dictionary):
+    (i1, (i2, stack)) = stack
+    v1 = i2 + i1
+    (v2, stack) = ((v1, (i1, (i2, stack))), (v1, (i1, (i2, stack))))
+    return (v2, (v2, stack)), expression, dictionary
+
+
+*/
+
+/*
+
+
+gronk_fn_body([int(A), int(B)|S], StackOut, IndentLevel, [symbol(Sym)|D], E) :-
+    [symbol(Sym)|D]=[symbol(Sym)|F],
+    bin_math_op(Sym, Op),
+    G=F,
+    gronk_fn_body([int(C)|S],
+                  StackOut,
+                  IndentLevel,
+                  G,
+                  H),
+    E=[tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|H].
+
+gronk_fn_body([int(A), int(B)|S], StackOut, IndentLevel, [symbol(Sym)|D], E) :-
+    [symbol(Sym)|D]=[symbol(Sym)|F],
+    bin_bool_op(Sym, Op),
+    G=F,
+    gronk_fn_body([bool(C)|S],
+                  StackOut,
+                  IndentLevel,
+                  G,
+                  H),
+    E=[tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|H].
+
+gronk_fn_body(S, S, _, A, [tab, "return ", stack_to_python(S), ", expression, dictionary", nl|A]).
+
+
+Yeah, that can't be right...  I'm basically in "How did this ever work?" territory.
+
+
+
+
+
+
+
+
+?- gronk("fn", `+ +`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    v4 = v1 + v2
+    v5 = v4 + v3
+    return (v5, stack), expression, dictionary
+
+
+?- gronk("fn", `+ * - div mod`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, (v4, (v5, (v6, stack)))))) = stack
+    v7 = v1 + v2
+    v8 = v7 * v3
+    v9 = v8 - v4
+    v10 = v9 // v5
+    v11 = v10 % v6
+    return (v11, stack), expression, dictionary
+
+
+
+
+
+
+
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+Reversing the order reversed the output...  I wish i knew what I was
+doing... :)
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v1 + v2
+    stack = (v3, stack)
+    return stack, expression, dictionary
+
+
+?- gronk_fn("name", [symbol(+), symbol(+)], Out), code_gen(Out, A, []), !, string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    v4 = v1 + v2
+    v5 = v4 + v3
+    stack = (v5, stack)
+    return stack, expression, dictionary
+
+Whatever, it works now.
+
+ */
+
+
+
+/*
+
+?- gronk_fn("name", [], [], Out), code_gen(Out, In, []).
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+In = "def name(stack, expressio...nary
+".
+
+?- listing(cg).
+cg(A, D) :-
+    A=[C|B],
+    cg(B, E),
+    phrase(C, D, E).
+cg(A, A).
+
+?- gronk_fn("name", [], [], Out), cg(Out,C).
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+C = "def name(stack, expressio...nary
+" ;
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+C = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] .
+
+?- phrase((gronk_fn("name", []), cg), [], Out).
+Out = "def name(stack, expressio...nary
+" ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, "(stack, expression, dictionary):"|...] ;
+Out = [100, 101, 102, 32, "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary"|...] .
+
+Bleah.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+
+Almost, but not quite.  The assignment is happening after the return call!
+
+
+
+=-=-=-=--=-=-=-=-==-=-
+
+?- gronk_fn("name", [], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    stack = stack
+    stack = stack
+    return stack, expression, dictionary
+
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([]), " = stack", nl, tab|...],
+A = "def name(stack, expressio...nary
+",
+S = "def name(stack, expression, dictionary):\n    stack = stack\n    stack = stack\n    return stack, expression, dictionary\n" .
+
+?- gronk_fn("name", [symbol(+)], Out), writeln(Out).
+[def ,name,(stack, expression, dictionary):,nl,tab,stack_to_python([int(_274090),int(_274100)|_274096]), = stack,nl,tab,stack = ,stack_to_python([int(_274110)|_274096]),nl,tab,return stack, expression, dictionary,nl,tabs(1),term_to_python(_274110), = ,term_to_python(_274090), + ,term_to_python(_274100),nl]
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([int(_274090), int(...)|...]), " = stack", nl, tab|...] .
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([int(v1), int(...)]), " = stack", nl, tab|...],
+A = "def name(stack, expressio...+ v2
+",
+S = "def name(stack, expression, dictionary):\n    (v1, (v2, stack)) = stack\n    stack = (v3, stack)\n    return stack, expression, dictionary\n    v3 = v1 + v2\n" .
+
+
+
+
+=-=-=-=--=-=-=-=-==-=-
+
+There we go...
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v1 + v2
+    stack = (v3, stack)
+    return stack, expression, dictionary
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- do(`dup dup +`).
+
+(v5, stack) = stack
+stack = ((v5 + v5), (v5, stack))
+
+true .
+
+That's better.
+
+?- do(`[* / - + dup] [dup + over *] branch * * `).
+
+tos, stack = stack
+if tos:
+    (v16, (v17, stack)) = stack
+    stack = ((v17 * (v16 + v16)), (v17, stack))
+else:
+    (v18, (v19, (v20, (v21, (v22, stack))))) = stack
+    stack = (((v21 - (v20 // (v18 * v19))) + v22), (((v21 - (v20 // (v18 * v19))) + v22), stack))
+(v23, (v24, (v25, stack))) = stack
+stack = (((v23 * v24) * v25), stack)
+
+true .
+
+That's beautiful.
+
+
+Of course, if we carried through the expression for the stack...
+
+
+    tos, stack = stack
+    if tos:
+        (v16, (v17, stack)) = stack
+        (v23, (v24, (v25, stack))) = ((v17 * (v16 + v16)), (v17, stack))
+    else:
+        (v18, (v19, (v20, (v21, (v22, stack))))) = stack
+        (v23, (v24, (v25, stack))) = (((v21 - (v20 // (v18 * v19))) + v22), (((v21 - (v20 // (v18 * v19))) + v22), stack))
+    stack = (((v23 * v24) * v25), stack)
+
+we could assign the new variables directly from the previous stage,
+saving the packing and unpacking of the "stack" tuple.
+
+"Something to think about."
+
+
+With symbolic Booleans this works now (there were a lot of bugs but I
+don't know what they were.)
+
+?- do(`<= [+] [-] branch`).
+
+(v1, (v2, stack)) = stack
+stack = ((v2 <= v1), stack)
+tos, stack = stack
+if tos:
+    (v3, (v4, stack)) = stack
+    stack = ((v4 - v3), stack)
+else:
+    (v5, (v6, stack)) = stack
+    stack = ((v5 + v6), stack)
+
+true.
+
+
+
+Now we can compile GCD:
+
+?- do(`true [tuck % dup 0 >] loop pop`).
+
+stack = True, stack
+tos, stack = stack
+while tos:
+    (v9, (v10, stack)) = stack
+    stack = ((v10 % v9), ((v10 % v9), (v9, stack)))
+    stack = 0, stack
+    (v11, (v12, stack)) = stack
+    stack = ((v12 > v11), stack)
+    tos, stack = stack
+(v13, stack) = stack
+stack = stack
+
+true.
+
+
+It's not ideal, for example, it computes v10 % v9 twice.  :(
+
+We would like, e.g.:
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v11, (v12, stack)) = 0, stack
+    stack = ((v12 > v11), stack)
+    tos, stack = stack
+(v13, stack) = stack
+stack = stack
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v12, stack) = stack
+    stack = ((v12 > 0), stack)
+    tos, stack = stack
+(v13, stack) = stack
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v12, stack) = stack
+    tos = (v12 > 0)
+(v13, stack) = stack
+
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    (v12, stack) = ((vN), ((vN), (v9, stack)))
+    tos = (v12 > 0)
+(v13, stack) = stack
+
+
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = (vN, (v9, stack))
+    tos = (vN > 0)
+(v13, stack) = stack
+
+Anyhow...  I could keep going but you get the idea.  The simple
+mechanical translation results in correct but inefficient code.
+I'm not too worried about it, this is great progress nonetheless, but it
+would be nice to tighten up that code gen.
+
+What's that "stack = stack" doing in there?
+
+
+
+
+
+do(`[[dup dup] [dup] branch dup [dup] loop dup] loop dup`).
+
+do(`[dup] [[dup dup dup] [dup dup] branch] branch`).
+
+
+*/
diff --git a/implementations/Prolog/source/gen-defs+funcs.pl b/implementations/Prolog/source/gen-defs+funcs.pl
new file mode 100644
index 0000000..27907fa
--- /dev/null
+++ b/implementations/Prolog/source/gen-defs+funcs.pl
@@ -0,0 +1,759 @@
+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).
+thun(symbol(--), A, C, D) :-
+    append([symbol(-)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol(?), A, C, D) :-
+    append([symbol(bool)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(&&), A, C, D) :-
+    append(
+           [ symbol(cons),
+             list([symbol(nullary), list([bool(false)])]),
+             symbol(dip),
+             symbol(branch)
+           ],
+           A,
+           B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol(++), A, C, D) :-
+    append([symbol(+)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol('||'), A, C, D) :-
+    append(
+           [ symbol(cons),
+             list([symbol(nullary)]),
+             symbol(dip),
+             list([bool(true)]),
+             symbol(branch)
+           ],
+           A,
+           B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol('!-'), A, C, D) :-
+    append([symbol(>=)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(abs), A, C, D) :-
+    append([int(0), symbol(<), list([]), list([symbol(neg)]), symbol(branch)],
+           A,
+           B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(anamorphism), A, C, D) :-
+    append([symbol(swap), list([symbol(dip), symbol(swons)]), symbol(genrec)],
+           A,
+           B),
+    thun(list([symbol(pop), list([])]), B, C, D).
+thun(symbol(app1), A, C, D) :-
+    append([symbol(infrst)], A, B),
+    thun(symbol(grba), B, C, D).
+thun(symbol(app2), A, C, D) :-
+    append([symbol(dip), list([symbol(infrst)]), symbol(cons), symbol(ii)],
+           A,
+           B),
+    thun(list([symbol(grba), symbol(swap), symbol(grba), symbol(swap)]),
+         B,
+         C,
+         D).
+thun(symbol(app3), A, C, D) :-
+    append([symbol(appN)], A, B),
+    thun(int(3), B, C, D).
+thun(symbol(appN), A, C, D) :-
+    append([symbol(cons), symbol(dip), symbol(map), symbol(disenstacken)],
+           A,
+           B),
+    thun(list([symbol(grabN)]), B, C, D).
+thun(symbol(at), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(drop), B, C, D).
+thun(symbol(average), A, C, D) :-
+    append([list([symbol(size)]), symbol(cleave), symbol(/)], A, B),
+    thun(list([symbol(sum), int(1), symbol('.0'), symbol(*)]),
+         B,
+         C,
+         D).
+thun(symbol(b), A, C, D) :-
+    append([symbol(dip), symbol(i)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(binary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(unary), B, C, D).
+thun(symbol(ccons), A, C, D) :-
+    append([symbol(cons)], A, B),
+    thun(symbol(cons), B, C, D).
+thun(symbol(cleave), A, C, D) :-
+    append([symbol(popdd)], A, B),
+    thun(symbol(fork), B, C, D).
+thun(symbol(clop), A, C, D) :-
+    append([symbol(popdd)], A, B),
+    thun(symbol(cleave), B, C, D).
+thun(symbol(codireco), A, C, D) :-
+    append([symbol(dip), symbol(rest), symbol(cons)], A, B),
+    thun(symbol(cons), B, C, D).
+thun(symbol(dinfrirst), A, C, D) :-
+    append([symbol(infrst)], A, B),
+    thun(symbol(dip), B, C, D).
+thun(symbol(disenstacken), A, C, D) :-
+    append([list([symbol(uncons), symbol(?)]), symbol(loop), symbol(pop)],
+           A,
+           B),
+    thun(symbol(?), B, C, D).
+thun(symbol(down_to_zero), A, C, D) :-
+    append([list([symbol(dup), symbol(--)]), symbol(while)], A, B),
+    thun(list([int(0), symbol(>)]), B, C, D).
+thun(symbol(drop), A, C, D) :-
+    append([symbol(times)], A, B),
+    thun(list([symbol(rest)]), B, C, D).
+thun(symbol(dupdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(dup)]), B, C, D).
+thun(symbol(dupdipd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(enstacken), A, C, D) :-
+    append([list([symbol(clear)]), symbol(dip)], A, B),
+    thun(symbol(stack), B, C, D).
+thun(symbol(fork), A, C, D) :-
+    append([symbol(app2)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(fourth), A, C, D) :-
+    append([symbol(third)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(gcd), A, C, D) :-
+    append(
+           [ list([symbol(tuck), symbol(mod), symbol(dup), int(0), symbol(>)]),
+             symbol(loop),
+             symbol(pop)
+           ],
+           A,
+           B),
+    thun(bool(true), B, C, D).
+thun(symbol(grabN), A, C, D) :-
+    append([symbol(swap), list([symbol(cons)]), symbol(times)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(grba), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(stack), symbol(popd)]), B, C, D).
+thun(symbol(hypot), A, C, D) :-
+    append([symbol(ii), symbol(+), symbol(sqrt)], A, B),
+    thun(list([symbol(sqr)]), B, C, D).
+thun(symbol(ifte), A, C, D) :-
+    append([symbol(dipd), symbol(swap), symbol(branch)], A, B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol(ii), A, C, D) :-
+    append([symbol(dupdip), symbol(i)], A, B),
+    thun(list([symbol(dip)]), B, C, D).
+thun(symbol(infra), A, C, D) :-
+    append([symbol(swaack), list([symbol(i)]), symbol(dip), symbol(swaack)],
+           A,
+           B),
+    thun(symbol(swons), B, C, D).
+thun(symbol(infrst), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(infra), B, C, D).
+thun(symbol(make_generator), A, C, D) :-
+    append([symbol(ccons)], A, B),
+    thun(list([symbol(codireco)]), B, C, D).
+thun(symbol(neg), A, C, D) :-
+    append([symbol(swap), symbol(-)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(not), A, C, D) :-
+    append([list([bool(false)]), symbol(branch)], A, B),
+    thun(list([bool(true)]), B, C, D).
+thun(symbol(nullary), A, C, D) :-
+    append([symbol(dinfrirst)], A, B),
+    thun(list([symbol(stack)]), B, C, D).
+thun(symbol(of), A, C, D) :-
+    append([symbol(at)], A, B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(pam), A, C, D) :-
+    append([symbol(map)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(popd), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(pop)]), B, C, D).
+thun(symbol(popdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(pop)]), B, C, D).
+thun(symbol(popop), A, C, D) :-
+    append([symbol(pop)], A, B),
+    thun(symbol(pop), B, C, D).
+thun(symbol(popopd), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(popop)]), B, C, D).
+thun(symbol(popopdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(popop)]), B, C, D).
+thun(symbol(primrec), A, C, D) :-
+    append([symbol(genrec)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(product), A, C, D) :-
+    append([symbol(swap), list([symbol(*)]), symbol(step)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol(quoted), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(unit)]), B, C, D).
+thun(symbol(range), A, C, D) :-
+    append([list([int(1), symbol(-), symbol(dup)]), symbol(anamorphism)],
+           A,
+           B),
+    thun(list([int(0), symbol(<=)]), B, C, D).
+thun(symbol(range_to_zero), A, C, D) :-
+    append([list([symbol(down_to_zero)]), symbol(infra)], A, B),
+    thun(symbol(unit), B, C, D).
+thun(symbol(reverse), A, C, D) :-
+    append([symbol(swap), symbol(shunt)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(rrest), A, C, D) :-
+    append([symbol(rest)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(run), A, C, D) :-
+    append([symbol(swap), symbol(infra)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(second), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(shunt), A, C, D) :-
+    append([symbol(step)], A, B),
+    thun(list([symbol(swons)]), B, C, D).
+thun(symbol(size), A, C, D) :-
+    append([symbol(swap), list([symbol(pop), symbol(++)]), symbol(step)],
+           A,
+           B),
+    thun(int(0), B, C, D).
+thun(symbol(spiral_next), A, C, D) :-
+    append(
+           [ list(
+                  [ list([symbol('!-')]),
+                    list([list([symbol(++)])]),
+                    list([list([symbol(--)])]),
+                    symbol(ifte),
+                    symbol(dip)
+                  ]),
+             list(
+                  [ list([symbol(pop), symbol('!-')]),
+                    list([symbol(--)]),
+                    list([symbol(++)]),
+                    symbol(ifte)
+                  ]),
+             symbol(ifte)
+           ],
+           A,
+           B),
+    thun(list(
+              [ list([list([symbol(abs)]), symbol(ii), symbol(<=)]),
+                list(
+                     [ list([symbol(<>)]),
+                       list([symbol(pop), symbol('!-')]),
+                       symbol('||')
+                     ]),
+                symbol(&&)
+              ]),
+         B,
+         C,
+         D).
+thun(symbol(split_at), A, C, D) :-
+    append([list([symbol(take)]), symbol(clop)], A, B),
+    thun(list([symbol(drop)]), B, C, D).
+thun(symbol(sqr), A, C, D) :-
+    append([symbol(*)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(step_zero), A, C, D) :-
+    append([symbol('roll>'), symbol(step)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(sum), A, C, D) :-
+    append([symbol(swap), list([symbol(+)]), symbol(step)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(swons), A, C, D) :-
+    append([symbol(cons)], A, B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(take), A, C, D) :-
+    append([symbol(rolldown), list([symbol(shift)]), symbol(times), symbol(pop)],
+           A,
+           B),
+    thun(list([]), B, C, D).
+thun(symbol(ternary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(binary), B, C, D).
+thun(symbol(third), A, C, D) :-
+    append([symbol(second)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(unary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(nullary), B, C, D).
+thun(symbol(unquoted), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(unswons), A, C, D) :-
+    append([symbol(swap)], A, B),
+    thun(symbol(uncons), B, C, D).
+thun(symbol(while), A, C, D) :-
+    append(
+           [ list([symbol(nullary)]),
+             symbol(cons),
+             symbol(dup),
+             symbol(dipd),
+             symbol(concat),
+             symbol(loop)
+           ],
+           A,
+           B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(x), A, C, D) :-
+    append([symbol(i)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(words), [], A, [B|A]) :-
+    words(B).
+thun(symbol(words), [A|B], D, E) :-
+    words(C),
+    thun(A, B, [C|D], E).
+thun(symbol(swap), [], [B, A|C], [A, B|C]).
+thun(symbol(swap), [A|B], [D, C|E], F) :-
+    thun(A, B, [C, D|E], F).
+thun(symbol(dup), [], [A|B], [A, A|B]).
+thun(symbol(dup), [A|B], [C|D], E) :-
+    thun(A, B, [C, C|D], E).
+thun(symbol(pop), [], [_|A], A).
+thun(symbol(pop), [A|B], [_|C], D) :-
+    thun(A, B, C, D).
+thun(symbol(cons), [], [list(B), A|C], [list([A|B])|C]).
+thun(symbol(cons), [A|B], [list(D), C|E], F) :-
+    thun(A, B, [list([C|D])|E], F).
+thun(symbol(concat), [], [list(C), list(B)|A], [list(D)|A]) :-
+    append(B, C, D).
+thun(symbol(concat), [C|D], [list(B), list(A)|F], G) :-
+    append(A, B, E),
+    thun(C, D, [list(E)|F], G).
+thun(symbol(flatten), [], [list(B)|A], [list(C)|A]) :-
+    flatten(B, C).
+thun(symbol(flatten), [B|C], [list(A)|E], F) :-
+    flatten(A, D),
+    thun(B, C, [list(D)|E], F).
+thun(symbol(swaack), [], [list(B)|A], [list(A)|B]).
+thun(symbol(swaack), [A|B], [list(D)|C], E) :-
+    thun(A, B, [list(C)|D], E).
+thun(symbol(stack), [], A, [list(A)|A]).
+thun(symbol(stack), [A|B], C, D) :-
+    thun(A, B, [list(C)|C], D).
+thun(symbol(clear), [], _, []).
+thun(symbol(clear), [A|B], _, C) :-
+    thun(A, B, [], C).
+thun(symbol(first), [], [list([A|_])|B], [A|B]).
+thun(symbol(first), [A|B], [list([C|_])|D], E) :-
+    thun(A, B, [C|D], E).
+thun(symbol(rest), [], [list([_|A])|B], [list(A)|B]).
+thun(symbol(rest), [A|B], [list([_|C])|D], E) :-
+    thun(A, B, [list(C)|D], E).
+thun(symbol(unit), [], [A|B], [list([A])|B]).
+thun(symbol(unit), [A|B], [C|D], E) :-
+    thun(A, B, [list([C])|D], E).
+thun(symbol(rolldown), [], [C, A, B|D], [A, B, C|D]).
+thun(symbol(rolldown), [A|B], [E, C, D|F], G) :-
+    thun(A, B, [C, D, E|F], G).
+thun(symbol(dupd), [], [A, B|C], [A, B, B|C]).
+thun(symbol(dupd), [A|B], [C, D|E], F) :-
+    thun(A, B, [C, D, D|E], F).
+thun(symbol(over), [], [B, A|C], [A, B, A|C]).
+thun(symbol(over), [A|B], [D, C|E], F) :-
+    thun(A, B, [C, D, C|E], F).
+thun(symbol(tuck), [], [A, B|C], [A, B, A|C]).
+thun(symbol(tuck), [A|B], [C, D|E], F) :-
+    thun(A, B, [C, D, C|E], F).
+thun(symbol(shift), [], [list([B|A]), list(C)|D], [list(A), list([B|C])|D]).
+thun(symbol(shift), [A|B], [list([D|C]), list(E)|F], G) :-
+    thun(A,
+         B,
+         [list(C), list([D|E])|F],
+         G).
+thun(symbol(rollup), [], [B, C, A|D], [A, B, C|D]).
+thun(symbol(rollup), [A|B], [D, E, C|F], G) :-
+    thun(A, B, [C, D, E|F], G).
+thun(symbol(uncons), [], [list([B|A])|C], [list(A), B|C]).
+thun(symbol(uncons), [A|B], [list([D|C])|E], F) :-
+    thun(A, B, [list(C), D|E], F).
+thun(symbol(bool), [], [int(0)|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [int(0)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [list([])|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [bool(false)|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [int(B)|A], [bool(true)|A]) :-
+    B#\=0.
+thun(symbol(bool), [B|C], [int(A)|D], E) :-
+    A#\=0,
+    thun(B, C, [bool(true)|D], E).
+thun(symbol(bool), [], [list([_|_])|A], [bool(true)|A]).
+thun(symbol(bool), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(bool), [], [bool(true)|A], [bool(true)|A]).
+thun(symbol(bool), [A|B], [bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('empty?'), [], [list([])|A], [bool(true)|A]).
+thun(symbol('empty?'), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('empty?'), [], [list([_|_])|A], [bool(false)|A]).
+thun(symbol('empty?'), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [list(_)|A], [bool(true)|A]).
+thun(symbol('list?'), [A|B], [list(_)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('list?'), [], [bool(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [bool(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [int(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [int(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [symbol(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [symbol(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('one-or-more?'), [], [list([_|_])|A], [bool(true)|A]).
+thun(symbol('one-or-more?'), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('one-or-more?'), [], [list([])|A], [bool(false)|A]).
+thun(symbol('one-or-more?'), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(true), bool(true)|A], [bool(true)|A]).
+thun(symbol(and), [A|B], [bool(true), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(and), [], [bool(true), bool(false)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(true), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(false), bool(true)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(false), bool(true)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(false), bool(false)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(false), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(or), [], [bool(true), bool(true)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(true), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(true), bool(false)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(true), bool(false)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(false), bool(true)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(false), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(false), bool(false)|A], [bool(false)|A]).
+thun(symbol(or), [A|B], [bool(false), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(+), [], [int(C), int(D)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C+D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C+D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C+D
+        ;   E is C+D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C+D)
+    ).
+thun(symbol(+), [E|F], [int(A), int(B)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A+B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A+B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A+B
+        ;   D is A+B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A+B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(-), [], [int(D), int(C)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C-D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C-D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C-D
+        ;   E is C-D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C-D)
+    ).
+thun(symbol(-), [E|F], [int(B), int(A)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A-B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A-B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A-B
+        ;   D is A-B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A-B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(*), [], [int(C), int(D)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C*D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C*D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C*D
+        ;   E is C*D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C*D)
+    ).
+thun(symbol(*), [E|F], [int(A), int(B)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A*B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A*B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A*B
+        ;   D is A*B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A*B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(/), [], [int(D), int(C)|A], [int(B)|A]) :-
+    B#=C div D.
+thun(symbol(/), [C|D], [int(B), int(A)|F], G) :-
+    E#=A div B,
+    thun(C, D, [int(E)|F], G).
+thun(symbol('%'), [], [int(D), int(C)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D),
+            D=\=0
+        ->  B=:=C mod D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C mod D)
+        )
+    ;   integer(C),
+        integer(D),
+        D=\=0
+    ->  (   var(B)
+        ->  B is C mod D
+        ;   E is C mod D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C mod D)
+    ).
+thun(symbol('%'), [E|F], [int(B), int(A)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B),
+            B=\=0
+        ->  C=:=A mod B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A mod B)
+        )
+    ;   integer(A),
+        integer(B),
+        B=\=0
+    ->  (   var(C)
+        ->  C is A mod B
+        ;   D is A mod B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A mod B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol('/%'), [], [int(D), int(C)|A], [int(B), int(E)|A]) :-
+    B#=C div D,
+    (   integer(E)
+    ->  (   integer(C),
+            integer(D),
+            D=\=0
+        ->  E=:=C mod D
+        ;   F=E,
+            clpfd:clpfd_equal(F, C mod D)
+        )
+    ;   integer(C),
+        integer(D),
+        D=\=0
+    ->  (   var(E)
+        ->  E is C mod D
+        ;   F is C mod D,
+            clpfd:clpfd_equal(E, F)
+        )
+    ;   clpfd:clpfd_equal(E, C mod D)
+    ).
+thun(symbol('/%'), [E|F], [int(B), int(A)|H], I) :-
+    ( G#=A div B,
+      (   integer(C)
+      ->  (   integer(A),
+              integer(B),
+              B=\=0
+          ->  C=:=A mod B
+          ;   D=C,
+              clpfd:clpfd_equal(D, A mod B)
+          )
+      ;   integer(A),
+          integer(B),
+          B=\=0
+      ->  (   var(C)
+          ->  C is A mod B
+          ;   D is A mod B,
+              clpfd:clpfd_equal(C, D)
+          )
+      ;   clpfd:clpfd_equal(C, A mod B)
+      )
+    ),
+    thun(E, F, [int(G), int(C)|H], I).
+thun(symbol(pm), [], [int(C), int(D)|A], [int(B), int(F)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C+D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C+D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C+D
+        ;   E is C+D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C+D)
+    ),
+    (   integer(F)
+    ->  (   integer(D),
+            integer(C)
+        ->  F=:=D-C
+        ;   G=F,
+            clpfd:clpfd_equal(G, D-C)
+        )
+    ;   integer(D),
+        integer(C)
+    ->  (   var(F)
+        ->  F is D-C
+        ;   G is D-C,
+            clpfd:clpfd_equal(F, G)
+        )
+    ;   clpfd:clpfd_equal(F, D-C)
+    ).
+thun(symbol(pm), [G|H], [int(A), int(B)|I], J) :-
+    ( (   integer(C)
+      ->  (   integer(A),
+              integer(B)
+          ->  C=:=A+B
+          ;   D=C,
+              clpfd:clpfd_equal(D, A+B)
+          )
+      ;   integer(A),
+          integer(B)
+      ->  (   var(C)
+          ->  C is A+B
+          ;   D is A+B,
+              clpfd:clpfd_equal(C, D)
+          )
+      ;   clpfd:clpfd_equal(C, A+B)
+      ),
+      (   integer(E)
+      ->  (   integer(B),
+              integer(A)
+          ->  E=:=B-A
+          ;   F=E,
+              clpfd:clpfd_equal(F, B-A)
+          )
+      ;   integer(B),
+          integer(A)
+      ->  (   var(E)
+          ->  E is B-A
+          ;   F is B-A,
+              clpfd:clpfd_equal(E, F)
+          )
+      ;   clpfd:clpfd_equal(E, B-A)
+      )
+    ),
+    thun(G, H, [int(C), int(E)|I], J).
+thun(symbol(>), [], [int(C), int(B)|A], [E|A]) :-
+    B#>C#<==>D,
+    r_truth(D, E).
+thun(symbol(>), [D|E], [int(B), int(A)|G], H) :-
+    ( A#>B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<), [], [int(C), int(B)|A], [E|A]) :-
+    B#D,
+    r_truth(D, E).
+thun(symbol(<), [D|E], [int(B), int(A)|G], H) :-
+    ( A#C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(=), [], [int(C), int(B)|A], [E|A]) :-
+    B#=C#<==>D,
+    r_truth(D, E).
+thun(symbol(=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(>=), [], [int(C), int(B)|A], [E|A]) :-
+    B#>=C#<==>D,
+    r_truth(D, E).
+thun(symbol(>=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#>=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<=), [], [int(C), int(B)|A], [E|A]) :-
+    B#=D,
+    r_truth(D, E).
+thun(symbol(<=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#=C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<>), [], [int(C), int(B)|A], [E|A]) :-
+    B#\=C#<==>D,
+    r_truth(D, E).
+thun(symbol(<>), [D|E], [int(B), int(A)|G], H) :-
+    ( A#\=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+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).
diff --git a/implementations/Prolog/source/gen-defs.pl b/implementations/Prolog/source/gen-defs.pl
new file mode 100644
index 0000000..dec6e2e
--- /dev/null
+++ b/implementations/Prolog/source/gen-defs.pl
@@ -0,0 +1,320 @@
+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).
+thun(symbol(--), A, C, D) :-
+    append([symbol(-)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol(?), A, C, D) :-
+    append([symbol(bool)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(&&), A, C, D) :-
+    append(
+           [ symbol(cons),
+             list([symbol(nullary), list([bool(false)])]),
+             symbol(dip),
+             symbol(branch)
+           ],
+           A,
+           B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol(++), A, C, D) :-
+    append([symbol(+)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol('||'), A, C, D) :-
+    append(
+           [ symbol(cons),
+             list([symbol(nullary)]),
+             symbol(dip),
+             list([bool(true)]),
+             symbol(branch)
+           ],
+           A,
+           B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol('!-'), A, C, D) :-
+    append([symbol(>=)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(abs), A, C, D) :-
+    append([int(0), symbol(<), list([]), list([symbol(neg)]), symbol(branch)],
+           A,
+           B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(anamorphism), A, C, D) :-
+    append([symbol(swap), list([symbol(dip), symbol(swons)]), symbol(genrec)],
+           A,
+           B),
+    thun(list([symbol(pop), list([])]), B, C, D).
+thun(symbol(app1), A, C, D) :-
+    append([symbol(infrst)], A, B),
+    thun(symbol(grba), B, C, D).
+thun(symbol(app2), A, C, D) :-
+    append([symbol(dip), list([symbol(infrst)]), symbol(cons), symbol(ii)],
+           A,
+           B),
+    thun(list([symbol(grba), symbol(swap), symbol(grba), symbol(swap)]),
+         B,
+         C,
+         D).
+thun(symbol(app3), A, C, D) :-
+    append([symbol(appN)], A, B),
+    thun(int(3), B, C, D).
+thun(symbol(appN), A, C, D) :-
+    append([symbol(cons), symbol(dip), symbol(map), symbol(disenstacken)],
+           A,
+           B),
+    thun(list([symbol(grabN)]), B, C, D).
+thun(symbol(at), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(drop), B, C, D).
+thun(symbol(average), A, C, D) :-
+    append([list([symbol(size)]), symbol(cleave), symbol(/)], A, B),
+    thun(list([symbol(sum), int(1), symbol('.0'), symbol(*)]),
+         B,
+         C,
+         D).
+thun(symbol(b), A, C, D) :-
+    append([symbol(dip), symbol(i)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(binary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(unary), B, C, D).
+thun(symbol(ccons), A, C, D) :-
+    append([symbol(cons)], A, B),
+    thun(symbol(cons), B, C, D).
+thun(symbol(cleave), A, C, D) :-
+    append([symbol(popdd)], A, B),
+    thun(symbol(fork), B, C, D).
+thun(symbol(clop), A, C, D) :-
+    append([symbol(popdd)], A, B),
+    thun(symbol(cleave), B, C, D).
+thun(symbol(codireco), A, C, D) :-
+    append([symbol(dip), symbol(rest), symbol(cons)], A, B),
+    thun(symbol(cons), B, C, D).
+thun(symbol(dinfrirst), A, C, D) :-
+    append([symbol(infrst)], A, B),
+    thun(symbol(dip), B, C, D).
+thun(symbol(disenstacken), A, C, D) :-
+    append([list([symbol(uncons), symbol(?)]), symbol(loop), symbol(pop)],
+           A,
+           B),
+    thun(symbol(?), B, C, D).
+thun(symbol(down_to_zero), A, C, D) :-
+    append([list([symbol(dup), symbol(--)]), symbol(while)], A, B),
+    thun(list([int(0), symbol(>)]), B, C, D).
+thun(symbol(drop), A, C, D) :-
+    append([symbol(times)], A, B),
+    thun(list([symbol(rest)]), B, C, D).
+thun(symbol(dupdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(dup)]), B, C, D).
+thun(symbol(dupdipd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(enstacken), A, C, D) :-
+    append([list([symbol(clear)]), symbol(dip)], A, B),
+    thun(symbol(stack), B, C, D).
+thun(symbol(fork), A, C, D) :-
+    append([symbol(app2)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(fourth), A, C, D) :-
+    append([symbol(third)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(gcd), A, C, D) :-
+    append(
+           [ list([symbol(tuck), symbol(mod), symbol(dup), int(0), symbol(>)]),
+             symbol(loop),
+             symbol(pop)
+           ],
+           A,
+           B),
+    thun(bool(true), B, C, D).
+thun(symbol(grabN), A, C, D) :-
+    append([symbol(swap), list([symbol(cons)]), symbol(times)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(grba), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(stack), symbol(popd)]), B, C, D).
+thun(symbol(hypot), A, C, D) :-
+    append([symbol(ii), symbol(+), symbol(sqrt)], A, B),
+    thun(list([symbol(sqr)]), B, C, D).
+thun(symbol(ifte), A, C, D) :-
+    append([symbol(dipd), symbol(swap), symbol(branch)], A, B),
+    thun(list([symbol(nullary)]), B, C, D).
+thun(symbol(ii), A, C, D) :-
+    append([symbol(dupdip), symbol(i)], A, B),
+    thun(list([symbol(dip)]), B, C, D).
+thun(symbol(infra), A, C, D) :-
+    append([symbol(swaack), list([symbol(i)]), symbol(dip), symbol(swaack)],
+           A,
+           B),
+    thun(symbol(swons), B, C, D).
+thun(symbol(infrst), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(infra), B, C, D).
+thun(symbol(make_generator), A, C, D) :-
+    append([symbol(ccons)], A, B),
+    thun(list([symbol(codireco)]), B, C, D).
+thun(symbol(neg), A, C, D) :-
+    append([symbol(swap), symbol(-)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(not), A, C, D) :-
+    append([list([bool(false)]), symbol(branch)], A, B),
+    thun(list([bool(true)]), B, C, D).
+thun(symbol(nullary), A, C, D) :-
+    append([symbol(dinfrirst)], A, B),
+    thun(list([symbol(stack)]), B, C, D).
+thun(symbol(of), A, C, D) :-
+    append([symbol(at)], A, B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(pam), A, C, D) :-
+    append([symbol(map)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(popd), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(pop)]), B, C, D).
+thun(symbol(popdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(pop)]), B, C, D).
+thun(symbol(popop), A, C, D) :-
+    append([symbol(pop)], A, B),
+    thun(symbol(pop), B, C, D).
+thun(symbol(popopd), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(popop)]), B, C, D).
+thun(symbol(popopdd), A, C, D) :-
+    append([symbol(dipd)], A, B),
+    thun(list([symbol(popop)]), B, C, D).
+thun(symbol(primrec), A, C, D) :-
+    append([symbol(genrec)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(product), A, C, D) :-
+    append([symbol(swap), list([symbol(*)]), symbol(step)], A, B),
+    thun(int(1), B, C, D).
+thun(symbol(quoted), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(unit)]), B, C, D).
+thun(symbol(range), A, C, D) :-
+    append([list([int(1), symbol(-), symbol(dup)]), symbol(anamorphism)],
+           A,
+           B),
+    thun(list([int(0), symbol(<=)]), B, C, D).
+thun(symbol(range_to_zero), A, C, D) :-
+    append([list([symbol(down_to_zero)]), symbol(infra)], A, B),
+    thun(symbol(unit), B, C, D).
+thun(symbol(reverse), A, C, D) :-
+    append([symbol(swap), symbol(shunt)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(rrest), A, C, D) :-
+    append([symbol(rest)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(run), A, C, D) :-
+    append([symbol(swap), symbol(infra)], A, B),
+    thun(list([]), B, C, D).
+thun(symbol(second), A, C, D) :-
+    append([symbol(first)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(shunt), A, C, D) :-
+    append([symbol(step)], A, B),
+    thun(list([symbol(swons)]), B, C, D).
+thun(symbol(size), A, C, D) :-
+    append([symbol(swap), list([symbol(pop), symbol(++)]), symbol(step)],
+           A,
+           B),
+    thun(int(0), B, C, D).
+thun(symbol(spiral_next), A, C, D) :-
+    append(
+           [ list(
+                  [ list([symbol('!-')]),
+                    list([list([symbol(++)])]),
+                    list([list([symbol(--)])]),
+                    symbol(ifte),
+                    symbol(dip)
+                  ]),
+             list(
+                  [ list([symbol(pop), symbol('!-')]),
+                    list([symbol(--)]),
+                    list([symbol(++)]),
+                    symbol(ifte)
+                  ]),
+             symbol(ifte)
+           ],
+           A,
+           B),
+    thun(list(
+              [ list([list([symbol(abs)]), symbol(ii), symbol(<=)]),
+                list(
+                     [ list([symbol(<>)]),
+                       list([symbol(pop), symbol('!-')]),
+                       symbol('||')
+                     ]),
+                symbol(&&)
+              ]),
+         B,
+         C,
+         D).
+thun(symbol(split_at), A, C, D) :-
+    append([list([symbol(take)]), symbol(clop)], A, B),
+    thun(list([symbol(drop)]), B, C, D).
+thun(symbol(sqr), A, C, D) :-
+    append([symbol(*)], A, B),
+    thun(symbol(dup), B, C, D).
+thun(symbol(step_zero), A, C, D) :-
+    append([symbol('roll>'), symbol(step)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(sum), A, C, D) :-
+    append([symbol(swap), list([symbol(+)]), symbol(step)], A, B),
+    thun(int(0), B, C, D).
+thun(symbol(swons), A, C, D) :-
+    append([symbol(cons)], A, B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(take), A, C, D) :-
+    append([symbol(rolldown), list([symbol(shift)]), symbol(times), symbol(pop)],
+           A,
+           B),
+    thun(list([]), B, C, D).
+thun(symbol(ternary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(binary), B, C, D).
+thun(symbol(third), A, C, D) :-
+    append([symbol(second)], A, B),
+    thun(symbol(rest), B, C, D).
+thun(symbol(unary), A, C, D) :-
+    append([symbol(popd)], A, B),
+    thun(symbol(nullary), B, C, D).
+thun(symbol(unquoted), A, C, D) :-
+    append([symbol(dip)], A, B),
+    thun(list([symbol(i)]), B, C, D).
+thun(symbol(unswons), A, C, D) :-
+    append([symbol(swap)], A, B),
+    thun(symbol(uncons), B, C, D).
+thun(symbol(while), A, C, D) :-
+    append(
+           [ list([symbol(nullary)]),
+             symbol(cons),
+             symbol(dup),
+             symbol(dipd),
+             symbol(concat),
+             symbol(loop)
+           ],
+           A,
+           B),
+    thun(symbol(swap), B, C, D).
+thun(symbol(x), A, C, D) :-
+    append([symbol(i)], A, B),
+    thun(symbol(dup), B, C, D).
+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).
+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).
diff --git a/implementations/Prolog/source/gen-funcs.pl b/implementations/Prolog/source/gen-funcs.pl
new file mode 100644
index 0000000..4f3cbc3
--- /dev/null
+++ b/implementations/Prolog/source/gen-funcs.pl
@@ -0,0 +1,462 @@
+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).
+thun(symbol(A), C, F, G) :-
+    def(A, [D|B]),
+    append(B, C, E),
+    thun(D, E, F, G).
+thun(symbol(words), [], A, [B|A]) :-
+    words(B).
+thun(symbol(words), [A|B], D, E) :-
+    words(C),
+    thun(A, B, [C|D], E).
+thun(symbol(swap), [], [B, A|C], [A, B|C]).
+thun(symbol(swap), [A|B], [D, C|E], F) :-
+    thun(A, B, [C, D|E], F).
+thun(symbol(dup), [], [A|B], [A, A|B]).
+thun(symbol(dup), [A|B], [C|D], E) :-
+    thun(A, B, [C, C|D], E).
+thun(symbol(pop), [], [_|A], A).
+thun(symbol(pop), [A|B], [_|C], D) :-
+    thun(A, B, C, D).
+thun(symbol(cons), [], [list(B), A|C], [list([A|B])|C]).
+thun(symbol(cons), [A|B], [list(D), C|E], F) :-
+    thun(A, B, [list([C|D])|E], F).
+thun(symbol(concat), [], [list(C), list(B)|A], [list(D)|A]) :-
+    append(B, C, D).
+thun(symbol(concat), [C|D], [list(B), list(A)|F], G) :-
+    append(A, B, E),
+    thun(C, D, [list(E)|F], G).
+thun(symbol(flatten), [], [list(B)|A], [list(C)|A]) :-
+    flatten(B, C).
+thun(symbol(flatten), [B|C], [list(A)|E], F) :-
+    flatten(A, D),
+    thun(B, C, [list(D)|E], F).
+thun(symbol(swaack), [], [list(B)|A], [list(A)|B]).
+thun(symbol(swaack), [A|B], [list(D)|C], E) :-
+    thun(A, B, [list(C)|D], E).
+thun(symbol(stack), [], A, [list(A)|A]).
+thun(symbol(stack), [A|B], C, D) :-
+    thun(A, B, [list(C)|C], D).
+thun(symbol(clear), [], _, []).
+thun(symbol(clear), [A|B], _, C) :-
+    thun(A, B, [], C).
+thun(symbol(first), [], [list([A|_])|B], [A|B]).
+thun(symbol(first), [A|B], [list([C|_])|D], E) :-
+    thun(A, B, [C|D], E).
+thun(symbol(rest), [], [list([_|A])|B], [list(A)|B]).
+thun(symbol(rest), [A|B], [list([_|C])|D], E) :-
+    thun(A, B, [list(C)|D], E).
+thun(symbol(unit), [], [A|B], [list([A])|B]).
+thun(symbol(unit), [A|B], [C|D], E) :-
+    thun(A, B, [list([C])|D], E).
+thun(symbol(rolldown), [], [C, A, B|D], [A, B, C|D]).
+thun(symbol(rolldown), [A|B], [E, C, D|F], G) :-
+    thun(A, B, [C, D, E|F], G).
+thun(symbol(dupd), [], [A, B|C], [A, B, B|C]).
+thun(symbol(dupd), [A|B], [C, D|E], F) :-
+    thun(A, B, [C, D, D|E], F).
+thun(symbol(over), [], [B, A|C], [A, B, A|C]).
+thun(symbol(over), [A|B], [D, C|E], F) :-
+    thun(A, B, [C, D, C|E], F).
+thun(symbol(tuck), [], [A, B|C], [A, B, A|C]).
+thun(symbol(tuck), [A|B], [C, D|E], F) :-
+    thun(A, B, [C, D, C|E], F).
+thun(symbol(shift), [], [list([B|A]), list(C)|D], [list(A), list([B|C])|D]).
+thun(symbol(shift), [A|B], [list([D|C]), list(E)|F], G) :-
+    thun(A,
+         B,
+         [list(C), list([D|E])|F],
+         G).
+thun(symbol(rollup), [], [B, C, A|D], [A, B, C|D]).
+thun(symbol(rollup), [A|B], [D, E, C|F], G) :-
+    thun(A, B, [C, D, E|F], G).
+thun(symbol(uncons), [], [list([B|A])|C], [list(A), B|C]).
+thun(symbol(uncons), [A|B], [list([D|C])|E], F) :-
+    thun(A, B, [list(C), D|E], F).
+thun(symbol(bool), [], [int(0)|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [int(0)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [list([])|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [bool(false)|A], [bool(false)|A]).
+thun(symbol(bool), [A|B], [bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(bool), [], [int(B)|A], [bool(true)|A]) :-
+    B#\=0.
+thun(symbol(bool), [B|C], [int(A)|D], E) :-
+    A#\=0,
+    thun(B, C, [bool(true)|D], E).
+thun(symbol(bool), [], [list([_|_])|A], [bool(true)|A]).
+thun(symbol(bool), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(bool), [], [bool(true)|A], [bool(true)|A]).
+thun(symbol(bool), [A|B], [bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('empty?'), [], [list([])|A], [bool(true)|A]).
+thun(symbol('empty?'), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('empty?'), [], [list([_|_])|A], [bool(false)|A]).
+thun(symbol('empty?'), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [list(_)|A], [bool(true)|A]).
+thun(symbol('list?'), [A|B], [list(_)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('list?'), [], [bool(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [bool(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [int(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [int(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('list?'), [], [symbol(_)|A], [bool(false)|A]).
+thun(symbol('list?'), [A|B], [symbol(_)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol('one-or-more?'), [], [list([_|_])|A], [bool(true)|A]).
+thun(symbol('one-or-more?'), [A|B], [list([_|_])|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol('one-or-more?'), [], [list([])|A], [bool(false)|A]).
+thun(symbol('one-or-more?'), [A|B], [list([])|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(true), bool(true)|A], [bool(true)|A]).
+thun(symbol(and), [A|B], [bool(true), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(and), [], [bool(true), bool(false)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(true), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(false), bool(true)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(false), bool(true)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(and), [], [bool(false), bool(false)|A], [bool(false)|A]).
+thun(symbol(and), [A|B], [bool(false), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(or), [], [bool(true), bool(true)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(true), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(true), bool(false)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(true), bool(false)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(false), bool(true)|A], [bool(true)|A]).
+thun(symbol(or), [A|B], [bool(false), bool(true)|C], D) :-
+    thun(A, B, [bool(true)|C], D).
+thun(symbol(or), [], [bool(false), bool(false)|A], [bool(false)|A]).
+thun(symbol(or), [A|B], [bool(false), bool(false)|C], D) :-
+    thun(A, B, [bool(false)|C], D).
+thun(symbol(+), [], [int(C), int(D)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C+D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C+D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C+D
+        ;   E is C+D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C+D)
+    ).
+thun(symbol(+), [E|F], [int(A), int(B)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A+B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A+B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A+B
+        ;   D is A+B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A+B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(-), [], [int(D), int(C)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C-D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C-D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C-D
+        ;   E is C-D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C-D)
+    ).
+thun(symbol(-), [E|F], [int(B), int(A)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A-B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A-B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A-B
+        ;   D is A-B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A-B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(*), [], [int(C), int(D)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C*D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C*D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C*D
+        ;   E is C*D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C*D)
+    ).
+thun(symbol(*), [E|F], [int(A), int(B)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B)
+        ->  C=:=A*B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A*B)
+        )
+    ;   integer(A),
+        integer(B)
+    ->  (   var(C)
+        ->  C is A*B
+        ;   D is A*B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A*B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol(/), [], [int(D), int(C)|A], [int(B)|A]) :-
+    B#=C div D.
+thun(symbol(/), [C|D], [int(B), int(A)|F], G) :-
+    E#=A div B,
+    thun(C, D, [int(E)|F], G).
+thun(symbol('%'), [], [int(D), int(C)|A], [int(B)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D),
+            D=\=0
+        ->  B=:=C mod D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C mod D)
+        )
+    ;   integer(C),
+        integer(D),
+        D=\=0
+    ->  (   var(B)
+        ->  B is C mod D
+        ;   E is C mod D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C mod D)
+    ).
+thun(symbol('%'), [E|F], [int(B), int(A)|G], H) :-
+    (   integer(C)
+    ->  (   integer(A),
+            integer(B),
+            B=\=0
+        ->  C=:=A mod B
+        ;   D=C,
+            clpfd:clpfd_equal(D, A mod B)
+        )
+    ;   integer(A),
+        integer(B),
+        B=\=0
+    ->  (   var(C)
+        ->  C is A mod B
+        ;   D is A mod B,
+            clpfd:clpfd_equal(C, D)
+        )
+    ;   clpfd:clpfd_equal(C, A mod B)
+    ),
+    thun(E, F, [int(C)|G], H).
+thun(symbol('/%'), [], [int(D), int(C)|A], [int(B), int(E)|A]) :-
+    B#=C div D,
+    (   integer(E)
+    ->  (   integer(C),
+            integer(D),
+            D=\=0
+        ->  E=:=C mod D
+        ;   F=E,
+            clpfd:clpfd_equal(F, C mod D)
+        )
+    ;   integer(C),
+        integer(D),
+        D=\=0
+    ->  (   var(E)
+        ->  E is C mod D
+        ;   F is C mod D,
+            clpfd:clpfd_equal(E, F)
+        )
+    ;   clpfd:clpfd_equal(E, C mod D)
+    ).
+thun(symbol('/%'), [E|F], [int(B), int(A)|H], I) :-
+    ( G#=A div B,
+      (   integer(C)
+      ->  (   integer(A),
+              integer(B),
+              B=\=0
+          ->  C=:=A mod B
+          ;   D=C,
+              clpfd:clpfd_equal(D, A mod B)
+          )
+      ;   integer(A),
+          integer(B),
+          B=\=0
+      ->  (   var(C)
+          ->  C is A mod B
+          ;   D is A mod B,
+              clpfd:clpfd_equal(C, D)
+          )
+      ;   clpfd:clpfd_equal(C, A mod B)
+      )
+    ),
+    thun(E, F, [int(G), int(C)|H], I).
+thun(symbol(pm), [], [int(C), int(D)|A], [int(B), int(F)|A]) :-
+    (   integer(B)
+    ->  (   integer(C),
+            integer(D)
+        ->  B=:=C+D
+        ;   E=B,
+            clpfd:clpfd_equal(E, C+D)
+        )
+    ;   integer(C),
+        integer(D)
+    ->  (   var(B)
+        ->  B is C+D
+        ;   E is C+D,
+            clpfd:clpfd_equal(B, E)
+        )
+    ;   clpfd:clpfd_equal(B, C+D)
+    ),
+    (   integer(F)
+    ->  (   integer(D),
+            integer(C)
+        ->  F=:=D-C
+        ;   G=F,
+            clpfd:clpfd_equal(G, D-C)
+        )
+    ;   integer(D),
+        integer(C)
+    ->  (   var(F)
+        ->  F is D-C
+        ;   G is D-C,
+            clpfd:clpfd_equal(F, G)
+        )
+    ;   clpfd:clpfd_equal(F, D-C)
+    ).
+thun(symbol(pm), [G|H], [int(A), int(B)|I], J) :-
+    ( (   integer(C)
+      ->  (   integer(A),
+              integer(B)
+          ->  C=:=A+B
+          ;   D=C,
+              clpfd:clpfd_equal(D, A+B)
+          )
+      ;   integer(A),
+          integer(B)
+      ->  (   var(C)
+          ->  C is A+B
+          ;   D is A+B,
+              clpfd:clpfd_equal(C, D)
+          )
+      ;   clpfd:clpfd_equal(C, A+B)
+      ),
+      (   integer(E)
+      ->  (   integer(B),
+              integer(A)
+          ->  E=:=B-A
+          ;   F=E,
+              clpfd:clpfd_equal(F, B-A)
+          )
+      ;   integer(B),
+          integer(A)
+      ->  (   var(E)
+          ->  E is B-A
+          ;   F is B-A,
+              clpfd:clpfd_equal(E, F)
+          )
+      ;   clpfd:clpfd_equal(E, B-A)
+      )
+    ),
+    thun(G, H, [int(C), int(E)|I], J).
+thun(symbol(>), [], [int(C), int(B)|A], [E|A]) :-
+    B#>C#<==>D,
+    r_truth(D, E).
+thun(symbol(>), [D|E], [int(B), int(A)|G], H) :-
+    ( A#>B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<), [], [int(C), int(B)|A], [E|A]) :-
+    B#D,
+    r_truth(D, E).
+thun(symbol(<), [D|E], [int(B), int(A)|G], H) :-
+    ( A#C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(=), [], [int(C), int(B)|A], [E|A]) :-
+    B#=C#<==>D,
+    r_truth(D, E).
+thun(symbol(=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(>=), [], [int(C), int(B)|A], [E|A]) :-
+    B#>=C#<==>D,
+    r_truth(D, E).
+thun(symbol(>=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#>=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<=), [], [int(C), int(B)|A], [E|A]) :-
+    B#=D,
+    r_truth(D, E).
+thun(symbol(<=), [D|E], [int(B), int(A)|G], H) :-
+    ( A#=C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+thun(symbol(<>), [], [int(C), int(B)|A], [E|A]) :-
+    B#\=C#<==>D,
+    r_truth(D, E).
+thun(symbol(<>), [D|E], [int(B), int(A)|G], H) :-
+    ( A#\=B#<==>C,
+      r_truth(C, F)
+    ),
+    thun(D, E, [F|G], H).
+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).
diff --git a/implementations/Prolog/source/joy2dot.pl b/implementations/Prolog/source/joy2dot.pl
new file mode 100644
index 0000000..bbd0e0f
--- /dev/null
+++ b/implementations/Prolog/source/joy2dot.pl
@@ -0,0 +1,153 @@
+/*
+
+    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 .
+
+
+Run with e.g.:
+
+    $ swipl -g fooooo -g halt source/joy2dot.pl  > jd.dot
+
+
+*/
+:- use_module(library(dcg/basics)).
+:- dynamic def/2.
+
+
+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([]) --> [].
+
+
+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)}.
+
+
+
+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) :-
+        retractall(def(Symbol, _)),
+        assertz(def(Symbol, Body)).
+
+% 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").
+
+/*
+
+term_expansion(def(Def), def(Name, Body)) :-
+    text_to_expression(Def, [symbol(Name)|Body]).
+
+
+% def(``).
+def(`and duo unit`).
+def(`app2 [grba swap grba swap] dip [infrst] cons ii`).
+def(`b [i] dip i`).
+def(`cleave fork popdd`).
+def(`clop cleave popdd`).
+def(`duo unit cons`).
+def(`fba [xor xor void] [[and] [xor and] fork or void] clop popdd`).
+def(`fork [i] app2`).
+def(`grba [stack popd] dip`).
+def(`ii [dip] dupdip i`).
+def(`infra swons swaack [i] dip swaack`).
+def(`infrst infra first`).
+def(`or [unit] ii duo`).
+def(`popd [pop] dip`).
+def(`popdd [pop] dipd`).
+def(`popop pop pop`).
+def(`swons swap cons`).
+% def(`uncons-pair [uncons] dip unswons rolldown`).
+def(`unswons uncons swap`).
+def(`xor [unit] ii [cons] [swap cons] clop duo`).
+
+*/
+
+symbols(E, S) :- symbols(E, [], S).
+
+symbols(symbol(S))      --> seen_sym(S), !.
+symbols(symbol(S)), [S] --> [].
+symbols(  bool(_))      --> [].
+symbols(   int(_))      --> [].
+symbols(  list(L))      --> symbols(L).
+
+symbols([])             --> [].
+symbols([T|Tail])       --> symbols(T), symbols(Tail).
+
+seen_sym(Term, List, List) :- member(Term, List).
+
+write_sym(Symbol) :- write('"'), write(Symbol), write('"').
+
+fooooo :- 
+    writeln("digraph joy_defs {"),
+    % writeln("    rankdir=LR;"),
+    forall(
+        def(Symbol, Body),
+        (
+            symbols(list(Body), Deps),
+            forall(
+                member(Dep, Deps),
+                (
+                    write("    "),
+                    write_sym(Symbol),
+                    write(" -> "),
+                    write_sym(Dep),
+                    writeln(";")
+                )
+            )
+        )
+    ),
+    writeln("}"). 
+
diff --git a/implementations/Prolog/source/joy2py.pl b/implementations/Prolog/source/joy2py.pl
new file mode 100644
index 0000000..81ed8e5
--- /dev/null
+++ b/implementations/Prolog/source/joy2py.pl
@@ -0,0 +1,919 @@
+/*
+
+████████╗██╗  ██╗██╗   ██╗███╗   ██╗
+╚══██╔══╝██║  ██║██║   ██║████╗  ██║
+   ██║   ███████║██║   ██║██╔██╗ ██║
+   ██║   ██╔══██║██║   ██║██║╚██╗██║
+   ██║   ██║  ██║╚██████╔╝██║ ╚████║
+   ╚═╝   ╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═══╝
+
+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 .
+
+(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 ::= 
+
+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, !.
+
+
+
+
+/*
+
+
+ ██████╗ ██████╗  ██████╗ ███╗   ██╗██╗  ██╗
+██╔════╝ ██╔══██╗██╔═══██╗████╗  ██║██║ ██╔╝
+██║  ███╗██████╔╝██║   ██║██╔██╗ ██║█████╔╝
+██║   ██║██╔══██╗██║   ██║██║╚██╗██║██╔═██╗
+╚██████╔╝██║  ██║╚██████╔╝██║ ╚████║██║  ██╗
+ ╚═════╝ ╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═══╝╚═╝  ╚═╝
+
+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(
+    [list(Body), symbol(step)|Js],
+    [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("").
diff --git a/implementations/Prolog/source/joy_defs.dot b/implementations/Prolog/source/joy_defs.dot
new file mode 100644
index 0000000..981b8d0
--- /dev/null
+++ b/implementations/Prolog/source/joy_defs.dot
@@ -0,0 +1,46 @@
+digraph joy_defs {
+    and -> unit;
+    and -> duo;
+    app2 -> ii;
+    app2 -> cons;
+    app2 -> infrst;
+    app2 -> dip;
+    app2 -> swap;
+    app2 -> grba;
+    b -> dip;
+    b -> i;
+    cleave -> popdd;
+    cleave -> fork;
+    clop -> popdd;
+    clop -> cleave;
+    duo -> cons;
+    duo -> unit;
+    fork -> app2;
+    fork -> i;
+    grba -> dip;
+    grba -> popd;
+    grba -> stack;
+    ii -> i;
+    ii -> dupdip;
+    ii -> dip;
+    infra -> dip;
+    infra -> i;
+    infra -> swaack;
+    infra -> swons;
+    infrst -> first;
+    infrst -> infra;
+    or -> duo;
+    or -> ii;
+    or -> unit;
+    popd -> dip;
+    popd -> pop;
+    popdd -> dipd;
+    popdd -> pop;
+    swons -> cons;
+    swons -> swap;
+    xor -> duo;
+    xor -> clop;
+    xor -> swap;
+    xor -> cons;
+    xor -> ii;
+}
diff --git a/implementations/Prolog/source/joy_defs.png b/implementations/Prolog/source/joy_defs.png
new file mode 100644
index 0000000..97ebf9f
Binary files /dev/null and b/implementations/Prolog/source/joy_defs.png differ
diff --git a/implementations/Prolog/source/more-notes.txt b/implementations/Prolog/source/more-notes.txt
new file mode 100644
index 0000000..824398a
--- /dev/null
+++ b/implementations/Prolog/source/more-notes.txt
@@ -0,0 +1,114 @@
+?- gronk("fn", `stackd`).
+
+def fn(stack, expression, dictionary):
+    (v1, stack) = stack
+    return (v1, ((), stack)), expression, dictionary
+
+using the func/3
+
+func(stackd, [A|B], [A, list(B)|B]).
+
+
+However, compiling with 
+
+gronk_fn_list([list(Body), symbol(dip)|Js], ...
+
+we get
+
+?- gronk("fn", `stackd`).
+
+def fn(stack, expression, dictionary):
+    (v1, stack) = stack
+    stack = (stack, stack)
+    return (v1, stack), expression, dictionary
+
+
+=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
+
+What would "[dup] cons dip" compile to?
+
+
+    def fn(stack, expression, dictionary):
+        (v1, (v2, stack)) = stack
+        return (v2, (v1, (v1, stack))), expression, dictionary
+
+E.g.:
+
+    ?- sjc(fn, `[dup] cons dip`).
+    func(fn, [B, A|C], [A, B, B|C]).
+    true .
+
+Hmm...
+
+
+
+/*
+?- gronk("fn", `[+] step`).
+
+    def fn(stack, expression, dictionary):
+        (s1, (i1, stack)) = stack
+        while s1:
+            (i2, s1) = s1
+            i1 = i1 + i2
+        return (i1, stack), expression, dictionary
+
+
+So just the above works great, but initializing it with a zero leads to
+BS:
+
+?- gronk("fn", `0 swap [+] step`).
+
+    def fn(stack, expression, dictionary):
+        (s1, stack) = stack
+        while s1:
+            (i1, s1) = s1
+            0 = 0 + i1
+        return (0, stack), expression, dictionary
+
+        
+We want something like this:
+
+    def fn(stack, expression, dictionary):
+        (s1, stack) = stack
+        v1 = 0
+        while s1:
+            (i1, s1) = s1
+            v1 = v1 + i1
+        return (v1, stack), expression, dictionary
+
+
+Hmmm....
+
+
+
+ */
+ 
+
+
+/*
+
+?- gronk("swaack", `swaack`).
+
+def swaack(stack, expression, dictionary):
+    (s1, stack) = stack
+    stack = (stack, s1)
+    return stack, expression, dictionary
+
+true.
+
+?- gronk("swaack", `[swaack] dip`).
+
+def swaack(stack, expression, dictionary):
+    (v1, (s1, stack)) = stack
+    stack = (stack, s1)
+    return (v1, stack), expression, dictionary
+
+true.
+
+
+*/
+
+['C:/Users/sforman/Desktop/src/PROLOG/Thun/source/thun.pl'].
+['C:/Users/sforman/Desktop/src/PROLOG/Thun/source/joy2py.pl'].
+
+@command:editor.action.selectToBracket
\ No newline at end of file
diff --git a/implementations/Prolog/source/nerdsniped.txt b/implementations/Prolog/source/nerdsniped.txt
new file mode 100644
index 0000000..99f4271
--- /dev/null
+++ b/implementations/Prolog/source/nerdsniped.txt
@@ -0,0 +1,62 @@
+
+
+https://c9x.me/notes/2019-01-15.html
+
+    uint32_t mulinv(uint32_t a) {
+        uint32_t b = a;   /* 1/a mod 2² */
+        b *= 2 - a*b;     /* 1/a mod 2⁴ */
+        b *= 2 - a*b;     /* 1/a mod 2⁸ */
+        b *= 2 - a*b;     /* 1/a mod 2¹⁶ */
+        b *= 2 - a*b;     /* 1/a mod 2³² */
+        return b;
+    }
+
+In Joy:
+
+
+    b *= 2 - a*b
+
+    b = b * (2 - a*b)
+
+
+
+    a 2 a b * - b *
+    a 2 a*b   - b *
+    a 2-(a*b)   b *
+    a b*(2-(a*b))
+
+    a b over over
+    a b a b [* 2 swap -] dip *
+    a b a * 2 swap - b *
+    a b*a   2 swap - b *
+    a 2 b*a        - b *
+    a 2-b*a          b *
+    a (2-b*a)*b
+
+    G == over over [* 2 swap -] dip *
+    mulinv == dup 5 [G] times popd
+
+Can compile G (mulinv must wait on times.)
+
+    ?- gronk("fn", `over over [* 2 swap -] dip *`).
+
+    def fn(stack, expression, dictionary):
+        (i1, (i2, stack)) = stack
+        i3 = i1 * i2
+        i4 = 2 - i3
+        i5 = i4 * i1
+        return (i5, (i2, stack)), expression, dictionary
+
+
+
+Using Unary
+
+    a b [F] dupdip *
+    a b F b *
+    a b * 2 swap - b *
+
+
+    G == [* 2 swap -] dupdip *
+    mulinv == dup 5 [[G] unary] times popd
+
+Bleah.
\ No newline at end of file
diff --git a/implementations/Prolog/source/notes.txt b/implementations/Prolog/source/notes.txt
new file mode 100644
index 0000000..9c0dfcb
--- /dev/null
+++ b/implementations/Prolog/source/notes.txt
@@ -0,0 +1,317 @@
+By using LoF to represent values all operations are effectively binary
+digital circuits.  So this is a way to model hardware by orchestrating it
+with Joy code.  For example, an 8-bit integer zero could be represented
+as [[][][][][][][][]] and so on:
+
+    [ []  []  []  []  []  []  []  [] ] 0
+    [ []  []  []  []  []  []  [] [[]]] 1
+    [ []  []  []  []  []  [] [[]] [] ] 2
+    [ []  []  []  []  []  [] [[]][[]]] 3
+
+Treating [] as zero and [[]] as one.
+
+
+Sum = a xor b xor c
+Carry = (b and a) or (c and (b xor a))
+
+Sum = a ⊕ b ⊕ c
+Carry = (b ∧ a) ∨ (c ∧ (b ⊕ a))
+
+∧∨⊕
+
+def full_bit_adder(a, b, c):
+    '''Based on the definitions from Wikipedia.'''
+    return (
+        simplify(xor(xor(a, b), c)),
+        simplify(or_(and_(a, b), and_(c, xor(a, b)))),
+    )
+
+c b a
+    [xor xor void]
+    [[and] [xor and] fork or void]
+    clop popdd
+
+
+c b a [and] [xor and] clop
+c  (b and a)    (c and (b xor a))  or
+c ((b and a) or (c and (b xor a)))
+
+
+fba == [xor xor void] [[and] [xor and] fork or void] clop popdd
+
+
+So we have a full-bit adder (with carry in and out), it's a trinary
+function with binary output.
+
+
+       carry b a fba
+    -------------------
+        carry' (a+b)
+
+
+Now we need a function that takes two 8-bit "numbers" and a carry bit and
+returns a single 8-bit number with the carry bit out.
+
+
+       carry [.b.] [.a.] +
+    -------------------------
+          carry' [a+b]
+
+
+The first thing that comes to my mind as a "2step" combinator:
+
+
+        [b ...] [a ...] [F] 2step
+    ---------------------------------
+       b a F [,,,] [,,,] [F] 2step
+
+And so on; if lists aren't the same length...?
+
+Could just zip the tho lists and use step.  Then merge zip and the step
+form?
+
+I think you would still want to define zip in terms of 2step.
+
+zipF == <<{} [unswons] dip uncons [duo swap [cons] dip] dip
+
+How's that work:
+
+   [b ...] [a ...] <<{} [unswons] dip uncons [duo swap [cons] dip] dip
+[] [b ...] [a ...]      [unswons] dip uncons [duo swap [cons] dip] dip
+[] [b ...] unswons [a ...]            uncons [duo swap [cons] dip] dip
+[] [...] b         [a ...]            uncons [duo swap [cons] dip] dip
+[] [...] b a [...]                           [duo swap [cons] dip] dip
+[] [...] b a duo swap [cons] dip [...]
+[] [...] [b a]   swap [cons] dip [...]
+[] [b a] [...]        [cons] dip [...]
+                                       Opps!  swons!
+[] [b a] [...]        [swons] dip [...]
+[] [b a] swons [...]              [...]
+[[b a]]        [...]              [...]
+
+[[b a]] [...] [...]
+
+The other bug in this is that you wind up with the pairs in the new list
+in reverse order from the original lists.  Time to review recursion
+combinators...
+
+Or, just collect the bits at the end?
+
+    c8b == [] [[[[[[[[[]]]]]]]]] [cons] times 
+
+To deal with the Carry bit let it ride at TOS then grab the bits under it
+and swap to get the result byte above the carry bit.
+
+    fin == [c8b] dip swap
+
+Or rewrite fba to have carry on tos?
+
+   c [b ...] [a ...] [uncons] dip unswons rolldown
+   c [b ...] uncons [a ...]       unswons rolldown
+   c b [...]        [a ...]       unswons rolldown
+   c b [...]        [...] a               rolldown
+   c b a [...] [...]
+
+Okay, then:
+
+   c b a [...] [...] [fba swap] dipd
+   c b a fba swap [...] [...]
+   c' a+b    swap [...] [...]
+   a+b c'         [...] [...]
+
+
+So (using ints as shorthand for Peano numbers):
+
+      F == [uncons] dip unswons rolldown [fba swap] dipd
+    c8b == [] 8 [cons] times 
+      + == 8 [F] times popop [c8b] dip swap
+
+Note the function that uncons's a pair from two lists compiles to a
+primitive nicely:
+
+    ?- sjc(uncons-pair, `[uncons] dip unswons rolldown`).
+    func(uncons-pair, [list([C|A]), list([D|B])|E], [list(A), list(B), C, D|E]).
+
+
+    uncons-pair == [uncons] dip unswons rolldown
+      F == uncons-pair [fba swap] dipd
+    c8b == [] 8 [cons] times 
+      + == 8 [F] times popop [c8b] dip swap
+
+Also c8b:
+
+    ?- sjc(foo, `[] 8 [cons] times`).
+    func(foo, [H, G, F, E, D, C, B, A|I], [list([A, B, C, D, E, F, G, H])|I]).
+
+
+    sjc(foo, `[[] 8 [cons] times] dip swap`).
+
+    func(foo, [int(I), H, G, F, E, D, C, B, A|J], [list([A, B, C, D, E, F, G, H]), int(I)|J]).
+
+Hmm...  (I'm using main thun, it hallucinates literals...)  Easy enough
+to fix manually...
+
+    func(foo, [I, H, G, F, E, D, C, B, A|J], [list([A, B, C, D, E, F, G, H]), I|J]).
+
+But it would be nice to figure out exactly why it can't hallucinate the
+most general case (first) and make it do that.
+
+- - - -
+
+THe other thing to do would be to build up the formulas with (atoms) vars
+for the input signals and then use LoF simplification to precompute
+formulas for each output bit (including carry) and the write one function
+that directly builds the output byte and carry from the input byte and
+carry by direct unification in Prolog and then run `cons [void] map
+uncons` on it to reduce the formulas.
+
+
+- - -  -
+
+
+Sum = a xor b xor c
+Carry = (b and a) or (c and (b xor a))
+
+Sum = a ⊕ b ⊕ c
+Carry = (b ∧ a) ∨ (c ∧ (b ⊕ a))
+
+∧∨⊕¬∥¿
+
+c b a
+    [⊕ ⊕           ¿]
+    [[∧] [⊕ ∧] ∥ ∨ ¿]
+    ∥ppp
+
+
+∥ = [i] app2
+∥p == ∥ popdd
+∥pp == ∥p popdd
+∥ppp == ∥pp popdd
+
+
+cleave == fork popdd
+clop == cleave popdd
+clopp == clop popdd
+
+
+
+
+[⊕ ⊕ ¿] [[∧] [⊕ ∧] ∥ ∨ ¿] ∥ppp
+
+
+- - - -
+
+list\(([^)]+)\)
+
+or == [unit] ii unit cons
+and == unit cons unit
+not == unit
+
+or == [not] ii not cons
+and == not cons not
+
+xor == [unit unit cons] [swap unit unit cons] cleave unit cons
+
+
+------------------------------
+
+
+Messing about with binary Boolean semantics and the Joy programming
+language, implementing a full-bit adder.
+
+https://en.wikipedia.org/wiki/Adder_(electronics)#Full_adder
+
+> A full adder adds binary numbers and accounts for values carried in as
+well as out. A one-bit full-adder adds three one-bit numbers, often
+written as A, B, and Cin; A and B are the operands, and Cin is a bit
+carried in from the previous less-significant stage.
+
+As logical expression with operators:
+
+    sum = a xor b xor c
+    carry = (b and a) or (c and (b xor a))
+
+Replace the words with common symbols (APL envy?)
+
+    sum = a ⊕ b ⊕ c
+    carry = (b ∧ a) ∨ (c ∧ (b ⊕ a))
+
+As Python psuedo-code:
+
+    def full_bit_adder(a, b, c):
+        return (
+            simplify(xor(xor(a, b), c)),
+            simplify(or_(and_(a, b), and_(c, xor(a, b)))),
+        )
+
+As Joy:
+
+        [xor xor simplify]
+        [[and] [xor and] fork or simplify]
+        clop popdd
+
+With cute symbols:
+
+    [⊕ ⊕ ¿] [[∧] [⊕ ∧] ∥ ∨ ¿] ∥ppp
+
+Factoring out the simplify function (represented by '¿'):
+
+    [⊕ ⊕] [[∧] [⊕ ∧] ∥ ∨] ∥ppp [¿] ii
+
+One thing to note, the parentheses in the equational and Python forms are
+encoding operator precedence while the square brackets in the Joy
+expression encode the control-flow-independence of the sub-functions of
+the main function, they *quote* the sub-subfunctions so they can be
+arguments to the '∥' and '∥ppp' concurrency combinators.
+
+- - - -
+
+"Selfie" as an alternate target to Oberon.
+
+https://selfie.cs.uni-salzburg.at/
+https://news.ycombinator.com/item?id=22427189
+https://github.com/cksystemsteaching/selfie/blob/master/semantics.md
+
+
+- - - -
+
+https://www.geoffreylitt.com/wildcard/salon2020/
+
+Wildcard: Spreadsheet-Driven Customization of Web Applications
+By Geoffrey Litt and Daniel Jackson
+
+
+
+https://edtr.io/
+https://news.ycombinator.com/item?id=22451568
+
+https://handsontable.com/
+JavaScript data grid that looks and feels like a spreadsheet.
+
+https://www.tampermonkey.net/
+Tampermonkey is a userscript manager
+
+
+
+https://www.cs.kent.ac.uk/people/staff/dat/miranda/
+https://en.wikipedia.org/wiki/Miranda_(programming_language)
+https://news.ycombinator.com/item?id=22447185
+
+
+
+https://ncatlab.org/nlab/show/differentiation
+file:///C:/Users/sforman/Desktop/FooNolder/1803.10228.pdf
+Demystifying Differentiable Programming:Shift/Reset the Penultimate Backpropagator
+https://news.ycombinator.com/item?id=22343285
+
+
+Domain Modelling made Functional
+https://www.youtube.com/watch?v=Up7LcbGZFuo
+
+
+
+
+https://langserver.org/
+https://news.ycombinator.com/item?id=22442133
+
+
diff --git a/implementations/Prolog/source/thun.pl b/implementations/Prolog/source/thun.pl
new file mode 100644
index 0000000..462d4d3
--- /dev/null
+++ b/implementations/Prolog/source/thun.pl
@@ -0,0 +1,2817 @@
+/*
+
+████████╗██╗  ██╗██╗   ██╗███╗   ██╗
+╚══██╔══╝██║  ██║██║   ██║████╗  ██║
+   ██║   ███████║██║   ██║██╔██╗ ██║
+   ██║   ██╔══██║██║   ██║██║╚██╗██║
+   ██║   ██║  ██║╚██████╔╝██║ ╚████║
+   ╚═╝   ╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═══╝
+
+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 .
+
+(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 ::= 
+
+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(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").
+
+
+symbols(E, S) :- symbols(E, [], S).
+
+symbols(symbol(S))      --> seen_sym(S), !.
+symbols(symbol(S)), [S] --> [].
+symbols(  bool(_))      --> [].
+symbols(   int(_))      --> [].
+symbols(  list(L))      --> symbols(L).
+
+symbols([])             --> [].
+symbols([T|Tail])       --> symbols(T), symbols(Tail).
+
+seen_sym(Term, List, List) :- member(Term, List).
+
+write_sym(Symbol) :- write('"'), write(Symbol), write('"').
+
+/*
+
+Run with e.g.:
+
+    $ swipl -g fooooo -g halt source/thun.pl  > jd.dot
+
+*/
+fooooo :- 
+    writeln("digraph joy_defs {"),
+    % writeln("    rankdir=LR;"),
+    forall(
+        def(Symbol, Body),
+        (
+            symbols(list(Body), Deps),
+            forall(
+                member(Dep, Deps),
+                (
+                    write("    "),
+                    write_sym(Symbol),
+                    write(" -> "),
+                    write_sym(Dep),
+                    writeln(";")
+                )
+            )
+        )
+    ),
+    writeln("}"). 
+
+
+
+% 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).
+
+
+/*
+
+ ██████╗ ██████╗ ███╗   ███╗██████╗ ██╗██╗     ███████╗██████╗
+██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║██║     ██╔════╝██╔══██╗
+██║     ██║   ██║██╔████╔██║██████╔╝██║██║     █████╗  ██████╔╝
+██║     ██║   ██║██║╚██╔╝██║██╔═══╝ ██║██║     ██╔══╝  ██╔══██╗
+╚██████╗╚██████╔╝██║ ╚═╝ ██║██║     ██║███████╗███████╗██║  ██║
+ ╚═════╝ ╚═════╝ ╚═╝     ╚═╝╚═╝     ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
+  _         ___         _
+ | |_ ___  | _ \_ _ ___| |___  __ _
+ |  _/ _ \ |  _/ '_/ _ \ | _ \/ _` |
+  \__\___/ |_| |_| \___/_|___/\__, |
+                              |___/
+
+This is an experimental compiler from Joy expressions to Prolog code.
+As you will see it's also doing type inference and type checking.
+
+For many Joy expressions the existing code is enough to "compile" them to
+Prolog code.  E.g. the definition of 'third' is 'rest rest first' and
+that's enough for the code to generate the "type" of the expression:
+
+    ?- joy(`third`, Si, So).
+    Si = [list([_32906, _32942, _32958|_32960])|_32898],
+    So = [_32958|_32898] .
+
+Because 'third' is just manipulating lists (the stack is a list too) the
+type signature is the whole of the (Prolog) implementation of the
+function:
+
+    ?- sjc(third, `third`).
+    func(third, [list([_, _, A|_])|B], [A|B]).
+
+So that's nice.
+
+Functions that involve just math require capturing the constraints
+recorded by the CLP(FD) subsystem.  SWI Prolog provide a predicate
+call_residue_vars/2 to do just that.  Together with copy_term/3 it's
+possible to collect all the information needed to capture functions
+made out of math and stack/list manipulation.  (I do not understand the
+details of how they work.  Markus Triska said they would do the trick and
+they did.)
+
+https://www.swi-prolog.org/pldoc/doc_for?object=call_residue_vars/2
+
+https://www.swi-prolog.org/pldoc/doc_for?object=copy_term/3
+
+I think this is sort of like "gradual" or "dependent" types.  But the
+formal theory there is beyond me.  In any event, it captures the integer
+constraints established by the expressions as well as the "types" of
+inputs and outputs.
+
+    ?- sjc(fn, `* + * -`).
+    func(fn, [int(H), int(I), int(F), int(D), int(C)|A], [int(B)|A]) :-
+        maplist(call,
+
+                [ clpfd:(B+E#=C),
+                clpfd:(G*D#=E),
+                clpfd:(J+F#=G),
+                clpfd:(H*I#=J)
+                ]).
+
+For functions involving 'branch', compilation results in one rule for each
+(reachable) path of the branch:
+
+    ?- sjc(fn, `[+] [-] branch`).
+
+    func(fn, [bool(true), int(C), int(D)|A], [int(B)|A]) :-
+        maplist(call, [clpfd:(B+C#=D)]).
+
+    func(fn, [bool(false), int(B), int(C)|A], [int(D)|A]) :-
+        maplist(call, [clpfd:(B+C#=D)]).
+
+(Note that in the subtraction case (bool(true)) the CLP(FD) constraints
+are coded as addition but the meaning is the same (subtraction) because of
+how the logic variables are named:  B + C #= D  <==>  B #= D - C.)
+
+?- sjc(fn, `[[+] [-] branch] [pop *] branch`).
+
+    func(fn, [bool(true), _, int(B), int(C)|A], [int(D)|A]) :-
+        maplist(call, [clpfd:(B*C#=D)]).
+
+    func(fn, [bool(false), bool(true), int(C), int(D)|A], [int(B)|A]) :-
+        maplist(call, [clpfd:(B+C#=D)]).
+
+    func(fn, [bool(false), bool(false), int(B), int(C)|A], [int(D)|A]) :-
+        maplist(call, [clpfd:(B+C#=D)]).
+
+Three paths, three rules.  Neat, eh?
+
+That leaves loop, genrec, and x combinators...
+
+
+*/
+
+joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule).
+
+show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), portray_clause(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])).
+
+sjc(Name, InputString) :-
+    text_to_expression(InputString, Expression),
+    show_joy_compile(Name, Expression).
+
+/*
+
+?- def(Name, _), compilable(Name).
+Name = -- ;
+Name = ? ;
+Name = ++ ;
+Name = '!-' ;
+Name = abs ;
+Name = ccons ;
+Name = fourth ;
+Name = neg ;
+Name = not ;
+Name = popop ;
+Name = reco ;
+Name = rrest ;
+Name = second ;
+Name = sqr ;
+Name = swons ;
+Name = third ;
+Name = unswons ;
+false.
+
+ */
+
+rules_of(Name, Expression, Rules) :- findall(Rule, jcmpl(Name, Expression, Rule), Rules).
+
+foo(Name-Body) :-
+    (  can_compile(Name)
+    ->  call_with_depth_limit(rules_of(Name, Body, Rules), 100, _),
+        maplist(portray_clause, Rules),
+        nl
+    ; true % write(Name), writeln(" can't compile")
+    ).
+
+do :-
+    findall(Name-Body, def(Name, Body), Defs),
+    maplist(foo, Defs).
+
+can_compile(-).
+can_compile(*).
+can_compile(/).
+can_compile(+).
+can_compile(<).
+can_compile(<=).
+can_compile(<>).
+can_compile(=).
+can_compile(>).
+can_compile(>=).
+can_compile(bool).
+can_compile(branch).
+can_compile(cons).
+can_compile(dup).
+can_compile(first).
+can_compile(pop).
+can_compile(rest).
+can_compile(rolldown).
+can_compile(rollup).
+can_compile(swap).
+can_compile(uncons).
+can_compile(unit).
+
+compilable(int(_)) :- !.
+compilable(bool(_)) :- !.
+compilable(Symbol) :- can_compile(Symbol), !.
+compilable(Symbol) :-
+    def(Symbol, Body),
+    symbols(list(Body), Syms),
+    forall(member(Dep, Syms), compilable(Dep)).
+
+
+
+
+/*
+
+Experiments with compilation.
+
+?- sjc(fn, `[+ dup bool] loop`).
+
+func(fn, [bool(false)|A], A).
+
+func(fn, [bool(true), int(B), int(C)|A], [int(0)|A]) :-
+    maplist(call, [clpfd:(B+C#=0)]).
+
+func(fn, [bool(true), int(D), int(E), int(B)|A], [int(0)|A]) :-
+    maplist(call,
+            [ clpfd:(B in inf.. -1\/1..sup),
+              clpfd:(C+B#=0),
+              clpfd:(C in inf.. -1\/1..sup),
+              clpfd:(D+E#=C)
+            ]).
+
+func(fn, [bool(true), int(F), int(G), int(D), int(B)|A], [int(0)|A]) :-
+    maplist(call,
+            [ clpfd:(B in inf.. -1\/1..sup),
+              clpfd:(C+B#=0),
+              clpfd:(C in inf.. -1\/1..sup),
+              clpfd:(E+D#=C),
+              clpfd:(E in inf.. -1\/1..sup),
+              clpfd:(F+G#=E)
+            ]).
+
+
+
+What if we unify a couple of the heads?  Changing the variable names on
+oneside so they are all unique, we have:
+
+func(fn, [bool(true), int(B), int(C)|A], [int(0)|A]) = func(fn, [bool(true), int(D), int(E), int(G)|F], [int(0)|F]).
+
+
+
+And:
+
+?- func(fn, [bool(true), int(B), int(C)|A], [int(0)|A]) = func(fn, [bool(true), int(D), int(E), int(G)|F], [int(0)|F]).
+B = D,
+C = E,
+A = F, F = [int(G)|F].
+
+
+
+Interesting...  note the circular term for the rest of the stack.
+
+
+func(fn, [bool(true), int(B), int(C)|        A], [int(0)|A])
+func(fn, [bool(true), int(D), int(E), int(G)|F], [int(0)|F]).
+
+SO B=D and C=E, yeah,
+and from the output stack we have the "rest" of the stack A=F
+but from the input stack we have [int(G)|F]=F
+
+We already know that this function can consume two or more integers from
+the stack under thr right conditions.  So I /think/ this circular term
+represents that fact.
+
+
+
+THe definition of this silly function if written by hand...
+
+The false case is easy enough:
+
+    func(fn, [bool(false)|A], A).
+
+But the true case is a little tricky:
+
+             true [+ dup bool] loop
+    ----------------------------------
+       + dup bool [+ dup bool] loop
+
+And we want the result to actually be:
+
+
+             true fn
+    -------------------
+       + dup bool fn
+
+That is, we want the compiled version to be defined in terms of itself (a
+feature absent from the above mechanically-derived forms.)  We can't put
+the symbol of the fn onto the pending expression because we are making a
+func, not a combinator, so we don't ahve the expression to work with.
+Is that just a quirk of the compiler code above?  It can only make funcs
+because it's written that way, it's hard-coded.  How would it know to
+make a combinator rather than a func?
+
+In any event, by hand I might write a combinator like this:
+
+    combo(fn, [bool(false)|S], S, E,  E ).
+    combo(fn, [bool(true) |S], S, Ei, Eo) :-
+        append([symbol('+'), symbol(dup), symbol(bool), symbol(fn)], Ei, Eo).
+
+This works like the definition above, prepending code onto the pending
+expression.  Then you might try:
+
+    sjc(fn_body, `+ dup bool`)
+
+Which, as it turns out, has only two solutions:
+
+    ?- sjc(fn_body, `+ dup bool`).
+
+    func(fn_body, [int(B), int(C)|A], [bool(false), int(0)|A]) :- B + C #= 0.
+
+    func(fn_body, [int(C), int(D)|A], [bool(true), int(B)|A]) :-
+        maplist(call,
+                [ clpfd:(B in inf.. -1\/1..sup),
+                clpfd:(C+D#=B)
+                ]).
+
+Leading to an abbreviated version of the combinator:
+
+             true fn
+    ------------------- w/ fn_body == + dup bool
+          fn_body fn
+
+    combo(fn, [bool(false)|S], S, E,  E ).
+    combo(fn, [bool(true) |S], S, Ei, Eo) :-
+        append([symbol(fn_body), symbol(fn)], Ei, Eo).
+
+
+
+
+    fn [fn_body] loop
+    fn_body + dup bool
+
+
+I tried it and it works, in the sense that the above Prolog defintions
+get the same solutions:
+
+?- sjc(fn, `fn`).
+func(fn, [bool(false)|A], A).
+true ;
+func(fn, [bool(true), int(B), int(C)|A], [int(0)|A]) :-
+    maplist(call, [clpfd:(B+C#=0)]).
+true ;
+func(fn, [bool(true), int(D), int(E), int(B)|A], [int(0)|A]) :-
+    maplist(call,
+
+            [ clpfd:(B in inf.. -1\/1..sup),
+              clpfd:(C+B#=0),
+              clpfd:(C in inf.. -1\/1..sup),
+              clpfd:(D+E#=C)
+            ]).
+true ;
+func(fn, [bool(true), int(F), int(G), int(D), int(B)|A], [int(0)|A]) :-
+    maplist(call,
+
+            [ clpfd:(B in inf.. -1\/1..sup),
+              clpfd:(C+B#=0),
+              clpfd:(C in inf.. -1\/1..sup),
+              clpfd:(E+D#=C),
+              clpfd:(E in inf.. -1\/1..sup),
+              clpfd:(F+G#=E)
+            ]).
+
+So that's nice.
+
+
+
+This leads me to think that a viable strategy might be to:
+1) Find the sub-functions that can compile to funcs and compile them.
+2) For each combinator create a new combinator defintion that uses the
+   funcs defined above.
+
+It seems like it would be easy to go from this:
+
+    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).
+
+To this:
+
+    combo(fn, [bool(false)|S], S, E,  E ).
+    combo(fn, [bool(true) |S], S, Ei, Eo) :-
+        append([symbol(fn_body), symbol(fn)], Ei, Eo).
+
+for some:
+
+    fn == [fn_body] loop
+
+
+
+Incremental transformation?
+
+       fn == [+ dup bool] loop
+    --------------------------------
+        fn_body == + dup bool
+             fn == [fn_body] loop
+
+
+        fn == [fn_body] loop
+
+But we want to compile a combinator that works like this:
+
+           ... false fn
+        ------------------
+                ...
+
+              ... true fn
+        --------------------
+           ... fn_body fn
+
+
+
+
+
+ ██████╗ ██████╗ ███╗   ███╗██████╗ ██╗██╗     ███████╗██████╗
+██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║██║     ██╔════╝██╔══██╗
+██║     ██║   ██║██╔████╔██║██████╔╝██║██║     █████╗  ██████╔╝
+██║     ██║   ██║██║╚██╔╝██║██╔═══╝ ██║██║     ██╔══╝  ██╔══██╗
+╚██████╗╚██████╔╝██║ ╚═╝ ██║██║     ██║███████╗███████╗██║  ██║
+ ╚═════╝ ╚═════╝ ╚═╝     ╚═╝╚═╝     ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
+  _         ___      _   _
+ | |_ ___  | _ \_  _| |_| |_  ___ _ _
+ |  _/ _ \ |  _/ || |  _| ' \/ _ \ ' \
+  \__\___/ |_|  \_, |\__|_||_\___/_||_|
+                |__/
+
+
+
+Compile to Python:
+
+    def fn(stack, expression):
+        while stack[0]:
+            stack, expression = fn_body(stack[1], expression)
+        return stack[1], expression
+
+Well, that was easy.
+
+
+
+
+
+ ██████╗ ███████╗███╗   ██╗ ██████╗ ██████╗ ██████╗ ███████╗        ███████╗███╗   ██╗
+██╔════╝ ██╔════╝████╗  ██║██╔════╝██╔═══██╗██╔══██╗██╔════╝        ██╔════╝████╗  ██║
+██║  ███╗█████╗  ██╔██╗ ██║██║     ██║   ██║██║  ██║█████╗          █████╗  ██╔██╗ ██║
+██║   ██║██╔══╝  ██║╚██╗██║██║     ██║   ██║██║  ██║██╔══╝          ██╔══╝  ██║╚██╗██║
+╚██████╔╝███████╗██║ ╚████║╚██████╗╚██████╔╝██████╔╝███████╗███████╗██║     ██║ ╚████║
+ ╚═════╝ ╚══════╝╚═╝  ╚═══╝ ╚═════╝ ╚═════╝ ╚═════╝ ╚══════╝╚══════╝╚═╝     ╚═╝  ╚═══╝
+
+
+
+*/
+
+% gencode_ident(Prefix, Codes) :-
+%     gensym(Prefix, Atom),
+%     atom_codes(Atom, Codes).
+
+% compile_loop(F, Body) -->
+%     { gencode_ident(fn_loop_, F)
+%     , gencode_ident(fn_loop_body_, B)
+%     }, nl,
+%     gencode_loop(F, B), nl,
+%     gencode_fn(B, Body), nl.
+
+% gencode_fn(Name, Body) -->
+%     "def ", Name,"(stack, expression):", nl,
+%         gencode_list(Body),
+%         tab, "return stack, expression", nl.
+
+% gencode_loop(F, B) -->
+%     "def ", F, "(stack, expression):", nl,
+%         tab, "while stack[0]:", nl,
+%         tab, tab, "stack, expression = ", B, "(stack[1], expression)", nl,
+%         tab, "return stack[1], expression", nl.
+
+% gencode_list(List) -->
+%     tab, "pass", nl.
+
+
+
+% ???
+
+% foo([list(Body), loop|Tail]) -->
+%     % We can't stop and generate loop and loop body functions inside the
+%     % current function, can we?  I mean, if we get the indentation right
+%     % I think it would be syntactically correct Python code.
+%     compile_loop(Name, Body),  % Schedule generation of the resulting functions...
+%     tab, "stack, expression = ", Name, "(stack, expression)", nl,
+%     foo(Tail).
+
+% foo([Symbol|Tail]) -->
+%     { symbol_is_primitive(Symbol)
+%     , atom_codes(Symbol, Name)
+%     },
+%     tab, "stack, expression = ", Name, "(stack, expression)", nl,
+%     foo(Tail).
+
+% foo([]) --> [].
+
+
+% symbol_is_primitive(sin).  % What should be Python-built-in?
+% symbol_is_primitive(cos).
+
+
+
+/*
+
+
+So, what if we have a tabulator predicate.
+
+*/
+
+tabs(N) --> { N #> 0, M #= N - 1 },
+    tab, tabs(M).
+
+tabs(0) --> [].
+
+nl --> "\n".
+
+tab --> "    ".
+
+
+/*
+
+And we compile the loop inline:
+
+    while stack[0]:
+        stack, expression = fn_body(stack[1], expression)
+    stack = stack[1]
+
+*/
+
+
+gencode_fn(Name, Body) -->
+    { reset_gensym(v) },
+    "def ", Name,"(stack, expression, dictionary):", nl,
+        gencode_list_tail(Body, 1),
+        tab, "return stack, expression, dictionary", nl.
+
+
+gencode_loop(Body, IndentLevel) -->
+    {J #= IndentLevel + 1},
+    tabs(IndentLevel), "tos, stack = stack", nl,
+    tabs(IndentLevel), "while tos:", nl,
+    gencode_list(Body, J),
+    tabs(J), "tos, stack = stack", nl.
+
+
+gencode_branch(BodyTrue, BodyFalse, IndentLevel) -->
+    {J #= IndentLevel + 1},
+    tabs(IndentLevel), "tos, stack = stack", nl,
+    tabs(IndentLevel), "if tos:", nl,
+    gencode_list(BodyTrue, J),
+    tabs(IndentLevel), "else:", nl,
+    gencode_list(BodyFalse, J).
+
+
+gencode_list([X|Xs], IndentLevel) -->
+    gencode_list_tail([X|Xs], IndentLevel).
+
+gencode_list([], IndentLevel) -->
+    tabs(IndentLevel), "pass", nl.
+
+
+gencode_list_tail([bool(true)|Tail], IndentLevel) -->
+    tabs(IndentLevel), "stack = True, stack", nl,
+    gencode_list_tail(Tail, IndentLevel).
+
+gencode_list_tail([bool(false)|Tail], IndentLevel) -->
+    tabs(IndentLevel), "stack = False, stack", nl,
+    gencode_list_tail(Tail, IndentLevel).
+
+gencode_list_tail([int(I)|Tail], IndentLevel) -->
+    { integer(I)
+    , number_codes(I, Int)
+    },
+    tabs(IndentLevel), "stack = ", Int, ", stack", nl,
+    gencode_list_tail(Tail, IndentLevel).
+
+
+gencode_list_tail([list(Body), symbol(i)|Tail], IndentLevel) -->
+    { append(Body, Tail, Expr) },
+    gencode_list_tail(Expr, IndentLevel).
+
+gencode_list_tail([list(Body), symbol(loop)|Tail], IndentLevel) -->
+    gencode_loop(Body, IndentLevel),
+    gencode_list_tail(Tail, IndentLevel).
+
+gencode_list_tail([list(BodyFalse), list(BodyTrue), symbol(branch)|Tail], IndentLevel) -->
+    gencode_branch(BodyTrue, BodyFalse, IndentLevel),
+    gencode_list_tail(Tail, IndentLevel).
+
+gencode_list_tail([symbol(+)|Tail], IndentLevel) --> !,
+    { Fin = [int(A), int(B)|S]
+    , Fout = [int(C)|S]
+    },
+    tabs(IndentLevel), stack_to_python(Fin), " = stack", nl,
+    tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), " + ", term_to_python(B), nl,
+    tabs(IndentLevel), "stack = ", stack_to_python(Fout), nl,
+    gencode_list_tail(Tail, IndentLevel).
+
+gencode_list_tail([symbol(F), NotSym|Tail], IndentLevel) -->
+    { func(F, Fin, Fout), NotSym \= symbol(_) },
+    tabs(IndentLevel), stack_to_python(Fin), " = stack", nl,
+    tabs(IndentLevel), "stack = ", stack_to_python(Fout), nl,
+    gencode_list_tail([NotSym|Tail], IndentLevel).
+
+% Combine functions.
+
+gencode_list_tail([symbol(F), symbol(G)|Tail], IndentLevel) -->
+    { func(F, Fin, Fout)
+    , func(G, Gin, Gout)
+    , Fout=Gin
+    },
+    gencode_list_tail([func(Fin, Gout)|Tail], IndentLevel).
+
+gencode_list_tail([func(Fin, Fout), symbol(G)|Tail], IndentLevel) -->
+    { func(G, Gin, Gout)
+    , Fout=Gin
+    },
+    gencode_list_tail([func(Fin, Gout)|Tail], IndentLevel).
+
+gencode_list_tail([func(Fin, Fout), NotSym|Tail], IndentLevel) -->
+    { nonvar(NotSym)
+    , NotSym \= symbol(_)
+    },
+    gencode_list_tail([func(Fin, Fout)], IndentLevel),
+    gencode_list_tail([NotSym|Tail], IndentLevel).
+
+gencode_list_tail([symbol(F)], IndentLevel) -->
+    { func(F, Fin, Fout) },
+    tabs(IndentLevel), stack_to_python(Fin), " = stack", nl,
+    tabs(IndentLevel), "stack = ", stack_to_python(Fout), nl.
+
+gencode_list_tail([func(Fin, Fout)], IndentLevel) -->
+    tabs(IndentLevel), stack_to_python(Fin), " = stack", nl,
+    tabs(IndentLevel), "stack = ", stack_to_python(Fout), nl.
+
+
+gencode_list_tail([], _) --> [].
+
+
+% lib_func(Name, Codes).
+
+lib_func(crap, "dup").
+
+
+
+
+/*
+
+[_39088|_39090]  ->  (a, stack)
+[_39088,_39088,_39088|_39090]  ->  (a, (a, (a, stack)))
+
+
+
+
+?- do(`dup dup`).
+
+(v1, ()) = stack
+stack = (v1, (v1, (v1, ())))
+
+
+So far, so goof, er, good...
+
+Probably broken in horrible, obvious ways.
+
+
+?- sjc(fn, `dup dup +`).
+func(fn, [int(A)|B], [int(A+A), int(A)|B]).
+true .
+
+
+(v23, stack) = stack                 # [int(A)|B]
+stack = ((v23 + v23), (v23, stack))  # [int(A+A), int(A)|B]
+
+Hmm......
+
+HMM.........
+
+
+
+
+
+
+███████╗████████╗ █████╗  ██████╗██╗  ██╗     ████████╗ ██████╗         ██████╗ ██╗   ██╗████████╗██╗  ██╗ ██████╗ ███╗   ██╗
+██╔════╝╚══██╔══╝██╔══██╗██╔════╝██║ ██╔╝     ╚══██╔══╝██╔═══██╗        ██╔══██╗╚██╗ ██╔╝╚══██╔══╝██║  ██║██╔═══██╗████╗  ██║
+███████╗   ██║   ███████║██║     █████╔╝         ██║   ██║   ██║        ██████╔╝ ╚████╔╝    ██║   ███████║██║   ██║██╔██╗ ██║
+╚════██║   ██║   ██╔══██║██║     ██╔═██╗         ██║   ██║   ██║        ██╔═══╝   ╚██╔╝     ██║   ██╔══██║██║   ██║██║╚██╗██║
+███████║   ██║   ██║  ██║╚██████╗██║  ██╗███████╗██║   ╚██████╔╝███████╗██║        ██║      ██║   ██║  ██║╚██████╔╝██║ ╚████║
+╚══════╝   ╚═╝   ╚═╝  ╚═╝ ╚═════╝╚═╝  ╚═╝╚══════╝╚═╝    ╚═════╝ ╚══════╝╚═╝        ╚═╝      ╚═╝   ╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═══╝
+
+
+
+ */
+
+% stack_to_python(F) --> { writeln(F), fail }.
+
+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), ")".
+
+
+/*
+term_to_python(bool(Term)) --> term_to_python(Term).
+
+term_to_python(int(A + B)) --> "(", term_to_python(A), " + ", term_to_python(B), ")".
+term_to_python(    A + B)  --> "(", term_to_python(A), " + ", term_to_python(B), ")".
+term_to_python(int(A - B)) --> "(", term_to_python(A), " - ", term_to_python(B), ")".
+term_to_python(    A - B)  --> "(", term_to_python(A), " - ", term_to_python(B), ")".
+term_to_python(int(A * B)) --> "(", term_to_python(A), " * ", term_to_python(B), ")".
+term_to_python(    A * B)  --> "(", term_to_python(A), " * ", term_to_python(B), ")".
+term_to_python(int(A div B)) --> "(", term_to_python(A), " // ", term_to_python(B), ")".
+term_to_python(    A div B)  --> "(", term_to_python(A), " // ", term_to_python(B), ")".
+term_to_python(int(A mod B)) --> "(", term_to_python(A), " % ", term_to_python(B), ")".
+term_to_python(    A mod B)  --> "(", term_to_python(A), " % ", term_to_python(B), ")".
+
+% term_to_python(bool(true)) --> "True".
+% term_to_python(bool(false)) --> "False".
+
+term_to_python(bool(A > B)) --> "(", term_to_python(A), " > ", term_to_python(B), ")".
+term_to_python(     A > B)  --> "(", term_to_python(A), " > ", term_to_python(B), ")".
+term_to_python(bool(A < B)) --> "(", term_to_python(A), " < ", term_to_python(B), ")".
+term_to_python(     A < B)  --> "(", term_to_python(A), " < ", term_to_python(B), ")".
+term_to_python(bool(A =< B)) --> "(", term_to_python(A), " <= ", term_to_python(B), ")".
+term_to_python(     A =< B)  --> "(", term_to_python(A), " <= ", term_to_python(B), ")".
+term_to_python(bool(A >= B)) --> "(", term_to_python(A), " >= ", term_to_python(B), ")".
+term_to_python(     A >= B)  --> "(", term_to_python(A), " >= ", term_to_python(B), ")".
+term_to_python(bool(eq(A, B))) --> "(", term_to_python(A), " == ", term_to_python(B), ")".
+term_to_python(     eq(A, B))  --> "(", term_to_python(A), " == ", term_to_python(B), ")".
+term_to_python(bool(neq(A, B))) --> "(", term_to_python(A), " != ", term_to_python(B), ")".
+term_to_python(     neq(A, B))  --> "(", term_to_python(A), " != ", term_to_python(B), ")".
+
+ */
+% stack_to_python([Term|Tail]) -->
+%     { Term = [_|_] },
+%     "(", stack_to_python(Term), ", ", stack_to_python(Tail), ")".
+
+
+
+% gencode_list(_Body, IndentLevel) -->
+%     tabs(IndentLevel), "pass".
+
+
+do(Input) :-
+    text_to_expression(Input, Expr),
+    phrase(gencode_list(Expr, 0), PythonCodes, []), !,
+    string_codes(PythonSource, PythonCodes),
+    writeln(""),
+    writeln(PythonSource).
+
+/*
+
+compile_function("gcd", `true [tuck % dup 0 >] loop pop`).
+
+*/
+
+compile_function(Name, BodyText) :-
+    text_to_expression(BodyText, Expr),
+    phrase(gencode_fn(Name, Expr), PythonCodes, []), !,
+    string_codes(PythonSource, PythonCodes),
+    writeln(""),
+    writeln(PythonSource).
+
+
+/*
+
+?- compile_function("gcd", `true [tuck % dup 0 >] loop pop`).
+
+def gcd(stack, expression, dictionary):
+    stack = True, stack
+    tos, stack = stack
+    while tos:
+        (v1, (v2, stack)) = stack
+        stack = ((v2 % v1), ((v2 % v1), (v1, stack)))
+        stack = 0, stack
+        (v3, (v4, stack)) = stack
+        stack = ((v4 > v3), stack)
+        tos, stack = stack
+    (v5, stack) = stack
+    stack = stack
+    return stack, expression, dictionary
+
+true.
+
+
+So now we can compile functions consisting of basic integer math, binary
+Boolean logic, and loops and branches.  A function like:
+
+    foo == [bar] cons i
+
+Would be problematical though.  (FOr one thing, I need to write the code
+to deal with list literals, and modify the handling of the i combinator.)
+
+
+--------------------------------------------------------------
+
+    ?- do(`+`).
+
+    (v3, (v4, stack)) = stack
+    stack = ((v3 + v4), stack)
+
+    true.
+
+How to make it do like this instead?
+
+    (v3, (v4, stack)) = stack
+    v5 = v3 + v4
+    stack = ((v5), stack)
+
+More to the point:
+
+    ?- do(`+ dup`).
+
+    (v5, (v6, stack)) = stack
+    stack = ((v5 + v6), ((v5 + v6), stack))
+
+should be:
+
+    (v5, (v6, stack)) = stack
+    v7 = v5 + v6
+    stack = (v7, (v7, stack))
+
+to avoid duplication of work, eh?
+
+
+?- compile_function("fn", `+ dup`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v1 + v2
+    stack = (v3, stack)
+    (v4, stack) = stack
+    stack = (v4, (v4, stack))
+    return stack, expression, dictionary
+
+true.
+
+Hmm, better, but we want the v3 and v4 vars to be unified in Prolog
+before generating the Python code, to prevent redundant stack chatter.
+
+
+
+
+ ██████╗ ██████╗  ██████╗ ███╗   ██╗██╗  ██╗
+██╔════╝ ██╔══██╗██╔═══██╗████╗  ██║██║ ██╔╝
+██║  ███╗██████╔╝██║   ██║██╔██╗ ██║█████╔╝
+██║   ██║██╔══██╗██║   ██║██║╚██╗██║██╔═██╗
+╚██████╔╝██║  ██║╚██████╔╝██║ ╚████║██║  ██╗
+ ╚═════╝ ╚═╝  ╚═╝ ╚═════╝ ╚═╝  ╚═══╝╚═╝  ╚═╝
+
+
+
+
+
+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, Cs, CGTail, 1).
+
+
+gronk_fn_list(
+    [list(BodyFalse), list(BodyTrue), symbol(branch)|Js],
+    [bool(B)|StackIn],
+    StackOut,
+    CodeGens,
+    COut,
+    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, Cs0, True, J),
+    gronk_fn_list(BodyFalse, StackIn, StackF, Cs1, False, J),
+    gronk_fn_list(Js, Stack, StackOut, Ck, COut, IndentLevel).
+
+/*
+
+?- gronk("fn", `[swap] [] branch `).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        stack = (v2, (v3, stack))
+    else:
+        stack = (v3, (v2, stack))
+    return stack, expression, dictionary
+
+
+
+?- gronk("fn", `[swap] [] branch pop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        (v4, stack) = (v2, (v3, stack))
+    else:
+        (v4, stack) = (v3, (v2, stack))
+    return stack, expression, dictionary
+
+
+
+?- gronk("fn", `over over > [swap] [] branch pop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v2 > v1
+    if v3:
+        (v4, stack) = (v1, (v2, stack))
+    else:
+        (v4, stack) = (v2, (v1, stack))
+    return stack, expression, dictionary
+
+
+
+Here's a case where factoring the pop to after the branch results in
+inefficient code.  (Compare the function below to the versions above.  It
+doesn't create and then immediately discard a v4 variable.)
+
+?- gronk("fn", `[swap pop] [pop] branch`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    if v1:
+        stack = (v3, stack)
+    else:
+        stack = (v2, stack)
+    return stack, expression, dictionary
+
+
+ */
+
+gronk_fn_list(
+    [list(Body), symbol(loop)|Js],
+    [bool(B)|StackIn],
+    StackOut,
+    CodeGens,
+    COut,
+    IndentLevel)
+    :-
+    !,
+    J #= IndentLevel + 1,
+    CodeGens = [
+        % tabs(IndentLevel), "stack = ", stack_to_python(StackIn), "  # Repack-the-stack hack.", nl,
+        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], Cs, [tabs(J), stack_to_python(StackIn), " = ", stack_to_python(Stack), nl|Ck], J),
+    gronk_fn_list(Js, StackIn, StackOut, Ck, COut, IndentLevel).
+                    % ^^^^^^^  wha!? not Stack!?
+/*
+
+gronk_fn_list([symbol(*)], [int(A),int(A)|B], StackOut, [tab,"return ",stack_to_python(StackOut),", expression, dictionary",nl], CGTail, 1)
+
+
+def fn(stack, expression, dictionary):
+    tos = True
+    while tos:
+        (v1, (v2, stack)) = stack
+        v3 = v2 % v1
+        tos = v3 > 0
+        stack = (v3, (v1, stack))
+    (v4, stack) = stack
+    return stack, expression, dictionary
+
+
+Close, but broken.  THe boundaries between blocks are too permeable.
+
+?- gronk("fn", `true [>] loop`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    tos = True
+    while tos:
+        v3 = v1 > v2
+        tos = v3
+    return stack, expression, dictionary
+
+
+
+
+gronk_fn_list(
+    [symbol(*)],
+    [int(A),int(A)|B],
+    StackOut,
+    [tab,"return ",stack_to_python(StackOut),", expression, dictionary",nl],
+    CGTail,
+    1
+    ).
+
+
+
+
+
+
+
+?- gronk("fn", `stack`).
+
+def fn(stack, expression, dictionary):
+    stack = stack
+    return ((), stack), expression, dictionary
+
+SHould be
+
+?- gronk("fn", `stack`).
+
+def fn(stack, expression, dictionary):
+    return (stack, stack), expression, dictionary
+
+
+
+Okay then...
+
+?- gronk("fn", `over over + stack dup`).
+
+def fn(stack, expression, dictionary):
+    (i1, (i2, stack)) = stack
+    v1 = i2 + i1
+    (v2, stack) = ((v1, (i1, (i2, stack))), (v1, (i1, (i2, stack))))
+    return (v2, (v2, stack)), expression, dictionary
+
+
+*/
+
+gronk_fn_list(
+    [symbol(stack)|Js],
+    StackIn,
+    StackOut,
+    [tabs(IndentLevel), stack_to_python(Stack), " = (", stack_to_python(StackIn), ", ", stack_to_python(StackIn), ")", nl|Cs],
+    CGTail,
+    IndentLevel)
+    :-
+    !,  % green cut
+    gronk_fn_list(Js, Stack, StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [symbol(Sym)|Js],
+    [int(B), int(A)|StackIn],
+    StackOut,
+    [tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|Cs],
+    CGTail,
+    IndentLevel)
+    :-
+    bin_math_op(Sym, Op), !,  % green cut
+    gronk_fn_list(Js, [int(C)|StackIn], StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [symbol(Sym)|Js],
+    [int(B), int(A)|StackIn],
+    StackOut,
+    [tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|Cs],
+    CGTail,
+    IndentLevel)
+    :-
+    bin_bool_op(Sym, Op), !,  % green cut
+    gronk_fn_list(Js, [bool(C)|StackIn], StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [symbol(Sym)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    yin(Sym),
+    func(Sym, StackIn, Stack), !,  % green cut
+    gronk_fn_list(Js, Stack, StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [symbol(Sym)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    yin(Sym),
+    def(Sym, Body), !,  % green cut
+    append(Body, Js, Expr),
+    gronk_fn_list(Expr, StackIn, StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [bool(true)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    !,  % green cut
+    gronk_fn_list(Js, [bool("True")|StackIn], StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [bool(false)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    !,  % green cut
+    gronk_fn_list(Js, [bool("False")|StackIn], StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [int(I)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    !,  % green cut
+    gronk_fn_list(Js, [int(I)|StackIn], StackOut, Cs, CGTail, IndentLevel).
+
+gronk_fn_list(
+    [list(L)|Js],
+    StackIn,
+    StackOut,
+    Cs,
+    CGTail,
+    IndentLevel)
+    :-
+    !,  % green cut
+    gronk_fn_list(Js, [list(L)|StackIn], StackOut, Cs, CGTail, 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(dup).
+yin(tuck).
+yin(over).
+yin(swap).
+yin(pop).
+yin(rolldown).
+yin(rollup).
+yin(dupd).
+yin(cons).
+yin(uncons).
+yin(first).
+yin(rest).
+yin(unit).
+yin(shift).
+yin(Sym) :- def(Sym, Body), maplist(yins, Body).
+
+yins(symbol(Sym)) :- yin(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).
+
+
+/*
+
+
+gronk_fn_body([int(A), int(B)|S], StackOut, IndentLevel, [symbol(Sym)|D], E) :-
+    [symbol(Sym)|D]=[symbol(Sym)|F],
+    bin_math_op(Sym, Op),
+    G=F,
+    gronk_fn_body([int(C)|S],
+                  StackOut,
+                  IndentLevel,
+                  G,
+                  H),
+    E=[tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|H].
+
+gronk_fn_body([int(A), int(B)|S], StackOut, IndentLevel, [symbol(Sym)|D], E) :-
+    [symbol(Sym)|D]=[symbol(Sym)|F],
+    bin_bool_op(Sym, Op),
+    G=F,
+    gronk_fn_body([bool(C)|S],
+                  StackOut,
+                  IndentLevel,
+                  G,
+                  H),
+    E=[tabs(IndentLevel), term_to_python(C), " = ", term_to_python(A), Op, term_to_python(B), nl|H].
+
+gronk_fn_body(S, S, _, A, [tab, "return ", stack_to_python(S), ", expression, dictionary", nl|A]).
+
+
+Yeah, that can't be right...  I'm basically in "How did this ever work?" territory.
+
+
+
+
+
+
+
+
+?- gronk("fn", `+ +`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    v4 = v1 + v2
+    v5 = v4 + v3
+    return (v5, stack), expression, dictionary
+
+
+?- gronk("fn", `+ * - div mod`).
+
+def fn(stack, expression, dictionary):
+    (v1, (v2, (v3, (v4, (v5, (v6, stack)))))) = stack
+    v7 = v1 + v2
+    v8 = v7 * v3
+    v9 = v8 - v4
+    v10 = v9 // v5
+    v11 = v10 % v6
+    return (v11, stack), expression, dictionary
+
+
+
+
+
+
+
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+Reversing the order reversed the output...  I wish i knew what I was
+doing... :)
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v1 + v2
+    stack = (v3, stack)
+    return stack, expression, dictionary
+
+
+?- gronk_fn("name", [symbol(+), symbol(+)], Out), code_gen(Out, A, []), !, string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, (v3, stack))) = stack
+    v4 = v1 + v2
+    v5 = v4 + v3
+    stack = (v5, stack)
+    return stack, expression, dictionary
+
+Whatever, it works now.
+
+ */
+
+
+
+
+
+
+
+
+code_gen([Head|Tail]) --> Head, code_gen(Tail).
+code_gen([]) --> [].
+
+cg, Term --> [Term], cg.
+cg --> [].
+
+compile_fn(Name) --> gronk_fn(Name), cg, !.
+
+
+/*
+
+?- gronk_fn("name", [], [], Out), code_gen(Out, In, []).
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+In = "def name(stack, expressio...nary
+".
+
+?- listing(cg).
+cg(A, D) :-
+    A=[C|B],
+    cg(B, E),
+    phrase(C, D, E).
+cg(A, A).
+
+?- gronk_fn("name", [], [], Out), cg(Out,C).
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+C = "def name(stack, expressio...nary
+" ;
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary", nl],
+C = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] .
+
+?- phrase((gronk_fn("name", []), cg), [], Out).
+Out = "def name(stack, expressio...nary
+" ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, 40|...] ;
+Out = [100, 101, 102, 32, 110, 97, 109, 101, "(stack, expression, dictionary):"|...] ;
+Out = [100, 101, 102, 32, "name", "(stack, expression, dictionary):", nl, tab, "return stack, expression, dictionary"|...] .
+
+Bleah.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+
+Almost, but not quite.  The assignment is happening after the return call!
+
+
+
+=-=-=-=--=-=-=-=-==-=-
+
+?- gronk_fn("name", [], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    stack = stack
+    stack = stack
+    return stack, expression, dictionary
+
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([]), " = stack", nl, tab|...],
+A = "def name(stack, expressio...nary
+",
+S = "def name(stack, expression, dictionary):\n    stack = stack\n    stack = stack\n    return stack, expression, dictionary\n" .
+
+?- gronk_fn("name", [symbol(+)], Out), writeln(Out).
+[def ,name,(stack, expression, dictionary):,nl,tab,stack_to_python([int(_274090),int(_274100)|_274096]), = stack,nl,tab,stack = ,stack_to_python([int(_274110)|_274096]),nl,tab,return stack, expression, dictionary,nl,tabs(1),term_to_python(_274110), = ,term_to_python(_274090), + ,term_to_python(_274100),nl]
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([int(_274090), int(...)|...]), " = stack", nl, tab|...] .
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    stack = (v3, stack)
+    return stack, expression, dictionary
+    v3 = v1 + v2
+
+Out = ["def ", "name", "(stack, expression, dictionary):", nl, tab, stack_to_python([int(v1), int(...)]), " = stack", nl, tab|...],
+A = "def name(stack, expressio...+ v2
+",
+S = "def name(stack, expression, dictionary):\n    (v1, (v2, stack)) = stack\n    stack = (v3, stack)\n    return stack, expression, dictionary\n    v3 = v1 + v2\n" .
+
+
+
+
+=-=-=-=--=-=-=-=-==-=-
+
+There we go...
+
+?- gronk_fn("name", [symbol(+)], Out), code_gen(Out, A, []), string_codes(S, A), writeln(""), writeln(S).
+
+def name(stack, expression, dictionary):
+    (v1, (v2, stack)) = stack
+    v3 = v1 + v2
+    stack = (v3, stack)
+    return stack, expression, dictionary
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- do(`dup dup +`).
+
+(v5, stack) = stack
+stack = ((v5 + v5), (v5, stack))
+
+true .
+
+That's better.
+
+?- do(`[* / - + dup] [dup + over *] branch * * `).
+
+tos, stack = stack
+if tos:
+    (v16, (v17, stack)) = stack
+    stack = ((v17 * (v16 + v16)), (v17, stack))
+else:
+    (v18, (v19, (v20, (v21, (v22, stack))))) = stack
+    stack = (((v21 - (v20 // (v18 * v19))) + v22), (((v21 - (v20 // (v18 * v19))) + v22), stack))
+(v23, (v24, (v25, stack))) = stack
+stack = (((v23 * v24) * v25), stack)
+
+true .
+
+That's beautiful.
+
+
+Of course, if we carried through the expression for the stack...
+
+
+    tos, stack = stack
+    if tos:
+        (v16, (v17, stack)) = stack
+        (v23, (v24, (v25, stack))) = ((v17 * (v16 + v16)), (v17, stack))
+    else:
+        (v18, (v19, (v20, (v21, (v22, stack))))) = stack
+        (v23, (v24, (v25, stack))) = (((v21 - (v20 // (v18 * v19))) + v22), (((v21 - (v20 // (v18 * v19))) + v22), stack))
+    stack = (((v23 * v24) * v25), stack)
+
+we could assign the new variables directly from the previous stage,
+saving the packing and unpacking of the "stack" tuple.
+
+"Something to think about."
+
+
+With symbolic Booleans this works now (there were a lot of bugs but I
+don't know what they were.)
+
+?- do(`<= [+] [-] branch`).
+
+(v1, (v2, stack)) = stack
+stack = ((v2 <= v1), stack)
+tos, stack = stack
+if tos:
+    (v3, (v4, stack)) = stack
+    stack = ((v4 - v3), stack)
+else:
+    (v5, (v6, stack)) = stack
+    stack = ((v5 + v6), stack)
+
+true.
+
+
+
+Now we can compile GCD:
+
+?- do(`true [tuck % dup 0 >] loop pop`).
+
+stack = True, stack
+tos, stack = stack
+while tos:
+    (v9, (v10, stack)) = stack
+    stack = ((v10 % v9), ((v10 % v9), (v9, stack)))
+    stack = 0, stack
+    (v11, (v12, stack)) = stack
+    stack = ((v12 > v11), stack)
+    tos, stack = stack
+(v13, stack) = stack
+stack = stack
+
+true.
+
+
+It's not ideal, for example, it computes v10 % v9 twice.  :(
+
+We would like, e.g.:
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v11, (v12, stack)) = 0, stack
+    stack = ((v12 > v11), stack)
+    tos, stack = stack
+(v13, stack) = stack
+stack = stack
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v12, stack) = stack
+    stack = ((v12 > 0), stack)
+    tos, stack = stack
+(v13, stack) = stack
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = ((vN), ((vN), (v9, stack)))
+    (v12, stack) = stack
+    tos = (v12 > 0)
+(v13, stack) = stack
+
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    (v12, stack) = ((vN), ((vN), (v9, stack)))
+    tos = (v12 > 0)
+(v13, stack) = stack
+
+
+
+
+tos = True
+while tos:
+    (v9, (v10, stack)) = stack
+    vN = v10 % v9
+    stack = (vN, (v9, stack))
+    tos = (vN > 0)
+(v13, stack) = stack
+
+Anyhow...  I could keep going but you get the idea.  The simple
+mechanical translation results in correct but inefficient code.
+I'm not too worried about it, this is great progress nonetheless, but it
+would be nice to tighten up that code gen.
+
+What's that "stack = stack" doing in there?
+
+
+
+
+
+do(`[[dup dup] [dup] branch dup [dup] loop dup] loop dup`).
+
+do(`[dup] [[dup dup dup] [dup dup] branch] branch`).
+
+
+*/
+
+
+/*
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- sjc(fn, `[] loop`).
+
+func(fn, [bool(false)|A], A).
+
+func(fn, [bool(true), bool(false)|A], A).
+
+func(fn, [bool(true), bool(true), bool(false)|A], A).
+
+func(fn, [bool(true), bool(true), bool(true), bool(false)|A], A).
+
+So...
+
+    `[] loop` ::= true* false
+
+sorta...
+
+
+The quine '[[dup cons] dup cons]' works fine:
+
+?- sjc(fn, `dup cons`).
+func(fn, [list(A)|B], [list([list(A)|A])|B]).
+
+?- sjc(fn, `[dup cons] dup cons`).
+func(fn, A, [list([list([symbol(dup), symbol(cons)]), symbol(dup), symbol(cons)])|A]).
+
+?- sjc(fn, `[dup cons] dup cons i`).
+func(fn, A, [list([list([symbol(dup), symbol(cons)]), symbol(dup), symbol(cons)])|A]).
+
+?- sjc(fn, `[dup cons] dup cons i i i i`).
+func(fn, A, [list([list([symbol(dup), symbol(cons)]), symbol(dup), symbol(cons)])|A]).
+
+
+In the right context the system will "hallucinate" programs:
+
+?- sjc(fn, `x`).
+func(fn, [list([])|A], [list([])|A]).
+
+func(fn, [list([int(A)])|B], [int(A), list([int(A)])|B]).
+
+func(fn, [list([bool(A)])|B], [bool(A), list([bool(A)])|B]).
+
+func(fn, [list([list(A)])|B], [list(A), list([list(A)])|B]).
+
+func(fn, [list([symbol(?)])|A], [bool(true), list([symbol(?)])|A]).
+
+func(fn, [list([symbol(app1)]), list([]), A|B], [A, A|B]).
+
+func(fn, [list([symbol(app1)]), list([int(A)]), B|C], [int(A), B|C]).
+
+func(fn, [list([symbol(app1)]), list([bool(A)]), B|C], [bool(A), B|C]).
+
+With iterative deepening this might be very interesting...
+
+
+Infinite loops are infinite:
+
+?- sjc(fn, `[x] x`).
+ERROR: Out of global-stack.
+
+
+?- sjc(fn, `sum`).
+func(fn, [list([])|A], [int(0)|A]).
+
+func(fn, [list([int(A)])|B], [int(A)|B]) :-
+    maplist(call, [clpfd:(A in inf..sup)]).
+
+func(fn, [list([int(C), int(B)])|A], [int(D)|A]) :-
+    maplist(call, [clpfd:(B+C#=D)]).
+
+func(fn, [list([int(E), int(D), int(B)])|A], [int(C)|A]) :-
+    maplist(call,
+
+            [ clpfd:(B+F#=C),
+              clpfd:(D+E#=F)
+            ]).
+
+func(fn, [list([int(G), int(F), int(D), int(B)])|A], [int(C)|A]) :-
+    maplist(call,
+
+            [ clpfd:(B+E#=C),
+              clpfd:(D+H#=E),
+              clpfd:(F+G#=H)
+            ]).
+
+
+TODO: genrec, fix points.
+
+
+
+
+ ██████╗ ██████╗ ███╗   ███╗██████╗ ██╗██╗     ███████╗██████╗
+██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║██║     ██╔════╝██╔══██╗
+██║     ██║   ██║██╔████╔██║██████╔╝██║██║     █████╗  ██████╔╝
+██║     ██║   ██║██║╚██╔╝██║██╔═══╝ ██║██║     ██╔══╝  ██╔══██╗
+╚██████╗╚██████╔╝██║ ╚═╝ ██║██║     ██║███████╗███████╗██║  ██║
+ ╚═════╝ ╚═════╝ ╚═╝     ╚═╝╚═╝     ╚═╝╚══════╝╚══════╝╚═╝  ╚═╝
+  _         __  __         _    _             ___         _
+ | |_ ___  |  \/  |__ _ __| |_ (_)_ _  ___   / __|___  __| |___
+ |  _/ _ \ | |\/| / _` / _| ' \| | ' \/ -_) | (__/ _ \/ _` / -_)
+  \__\___/ |_|  |_\__,_\__|_||_|_|_||_\___|  \___\___/\__,_\___|
+
+Options for getting machine code out of Joy (in Prolog) code?
+
+1) Translate Joy to Factor and delegate to Factor's native code
+generation.
+
+2) Use e.g. GNU Prolog to compile the Prolog code of Joy.
+
+3) Translate to:
+
+    3a) LLVM IR.
+
+    3b) Some subset of C.
+
+    3c) Python for Cython.
+
+    3d) WASM?  Something else...?
+
+But those all rely on a big pile of OPC (Other Ppl's Code).  WHich brings
+me to...
+
+4) Oberon RISC CPU machine code.  The one I really want to do.  I have an
+assembler for it, there are emulators and FPGA incarnations, and it's
+small and clean.
+
+    4a) Prolog machine description of the RISC chip.
+
+    4b) How to actually compile Joy to asm?  There is a wealth of
+    available information and research to draw on, but most of it is in
+    the context of conventional languages.  Static Joy code presents few
+    problems but the dynamic nature of most Joy programs does, I think.
+    (I.e. a lot of Joy code starts by constructing some other Joy code
+    and running it.  It remains to be seen how much of a challenge that
+    will be.  In the limit, you need Prolog at runtime to JIT compile.)
+
+    4c) Self-hosting requires Prolog-in-Joy.
+
+
+ ___ ___ ___  ___   __  __         _    _             ___        _
+| _ |_ _/ __|/ __| |  \/  |__ _ __| |_ (_)_ _  ___   / __|___ __| |___
+|   /| |\__ | (__  | |\/| / _` / _| ' \| | ' \/ -_) | (__/ _ / _` / -_)
+|_|_|___|___/\___| |_|  |_\__,_\__|_||_|_|_||_\___|  \___\___\__,_\___|
+
+This is an experimental compiler from Joy expressions to machine code.
+
+One interesting twist is that Joy doesn't mention variables, just the
+operators, so they have to be inferred from the ops.
+
+So let's take e.g. '+'?
+
+It seems we want to maintain a mapping from stack locations to registers,
+and maybe from locations in lists on the stack, and to memory locations as
+well as registers?
+
+But consider 'pop', the register pointed to by stack_0 is put back in an
+available register pool, but then all the stack_N mappings have to point
+to stack_N+1 (i.e. stack_0 must now point to what stack_1 pointed to and
+stack_1 must point to stack_2, and so on...)
+
+What if we keep a stack of register/RAM locations in the same order as
+the Joy stack?
+
+Reference counting for registers?  Can it be avoided?  When you "free" a
+register you can just check the stack to see if it's still in there and,
+if not, release it back to the free pool.  You can amortize that w/o
+keeping a counter by keeping a linear list of registers alongside the
+stack and pushing and popping registers from it as they are used/free'd
+and then checking if a register is ready for reclaimation is just
+member/3.  Or you can just keep a reference count for each register...
+Would it be useful to put CLP(FD) constraints on the ref counts?
+
+reggy(FreePool, References, ValueMap)
+
+*/
+
+% encode_list(List, FP, FP, Addr) --> [],
+%     {addr(list(List))=Addr}.
+
+% get_reggy([], _, _) :- writeln('Out of Registers'), fail.
+% get_reggy([Reg|FreePool], Reg, FreePool).
+
+% get_reg(Reg, reggy(FreePool0, References, V), reggy(FreePool, [Reg|References], V)) --> [],
+%     {get_reggy(FreePool0, Reg, FreePool)}.
+
+% free_reg(Reg, reggy(FreePool0, References0, V0), reggy(FreePool, References, V)) --> [],
+%     { select(Reg, References0, References),
+%     (  member(Reg, References)  % If reg is still in use
+%     -> FreePool=     FreePool0, V0=V % we can't free it yet
+%     ;  FreePool=[Reg|FreePool0], % otherwise we put it back in the pool.
+%        del_assoc(Reg, V0, _, V)
+%     )}.
+
+% add_ref(Reg, reggy(FreePool, References, V), reggy(FreePool, [Reg|References], V)) --> [].
+
+% assoc_reg(Reg, Value, reggy(FreePool, References, V0), reggy(FreePool, References, V)) --> [],
+%     {put_assoc(Reg, V0, Value, V)}.
+
+% thun_compile(E, Si, So, FP) -->
+%     {empty_assoc(V),
+%      FP0=reggy([r0, r1, r2, r3,
+%                r4, r5, r6, r7,
+%                r8, r9, rA, rB,
+%                rC, rD, rE, rF], [], V)},
+%     thun_compile(E, Si, So, FP0, FP).
+
+% thun_compile([], S, S, FP, FP) --> [].
+% thun_compile([Term|Rest], Si, So, FP0, FP1) --> thun_compile(Term, Rest, Si, So, FP0, FP1).
+
+% thun_compile(int(I), E, Si, So, FP0, FP) -->
+%     [mov_imm(R, int(I))],
+%     get_reg(R, FP0, FP1), assoc_reg(R, int(I), FP1, FP2),
+%     thun_compile(E, [R|Si], So, FP2, FP).
+
+% thun_compile(bool(B), E, Si, So, FP0, FP) -->
+%     get_reg(R, FP0, FP1), assoc_reg(R, bool(B), FP1, FP2),
+%     thun_compile(E, [R|Si], So, FP2, FP).
+
+% thun_compile(list(L), E, Si, So, FP0, FP) -->
+%     encode_list(L, FP0, FP1, Addr),
+%     get_reg(R, FP1, FP2),
+%     [load_imm(R, Addr)],
+%     assoc_reg(R, Addr, FP2, FP3),
+%     thun_compile(E, [R|Si], So, FP3, FP).
+
+% thun_compile(symbol(Name), E, Si, So, FP0, FP) -->   {def(Name, _)}, !,         def_compile(Name, E, Si, So, FP0, FP).
+% thun_compile(symbol(Name), E, Si, So, FP0, FP) -->  {func(Name, _, _)}, !,     func_compile(Name, E, Si, So, FP0, FP).
+% thun_compile(symbol(Name), E, Si, So, FP0, FP) --> {combo(Name, _, _, _, _)}, combo_compile(Name, E, Si, So, FP0, FP).
+
+% % I'm going to assume that any defs that can be compiled to funcs already
+% % have been.  Defs that can't be pre-compiled shove their body expression
+% % onto the pending expression (continuation) to be compiled "inline".
+
+% def_compile(Def, E, Si, So, FP0, FP) -->
+%     {def(Def, Body),
+%     append(Body, E, Eo)},
+%     thun_compile(Eo, Si, So, FP0, FP).
+
+
+% % swap (et. al.) doesn't change register refs nor introspect values
+% % so we can delegate its effect to the semantic relation.
+% non_alloc(swap).
+% non_alloc(rollup).
+% non_alloc(rolldown).
+
+% % Functions delegate to a per-function compilation relation.
+
+% func_compile(+, E, [A, B|S], So, FP0, FP) --> !,
+%     free_reg(A, FP0, FP1),
+%     free_reg(B, FP1, FP2),
+%     get_reg(R, FP2, FP3),
+%     assoc_reg(R, int(_), FP3, FP4),
+%     [add(R, A, B)],
+%     % Update value in the context?
+%     thun_compile(E, [R|S], So, FP4, FP).
+
+% func_compile(dup, E, [A|S], So, FP0, FP) --> !,
+%     add_ref(A, FP0, FP1),
+%     thun_compile(E, [A, A|S], So, FP1, FP).
+
+% func_compile(pop, E, [A|S], So, FP0, FP) --> !,
+%     free_reg(A, FP0, FP1),
+%     thun_compile(E, S, So, FP1, FP).
+
+% func_compile(cons, E, [List, Item|S], So, FP0, FP) --> !,
+%     % Assume list is already stored in RAM
+%     % and item ...
+%     % allocate a cons cell
+%     [alloc_cons(list(Item, List))],
+%     % https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-33.html#%_sec_5.3
+%     % TODO whence the output list in So?
+%     thun_compile(E, S, So, FP0, FP).
+
+% func_compile(Func, E, Si, So, FP0, FP) --> { non_alloc(Func), !,
+%     func(Func, Si, S) },
+%     thun_compile(E, S, So, FP0, FP).
+
+% func_compile(_Func, E, Si, So, FP0, FP) -->
+%     % look up function, compile it...
+%     {Si = S},
+%     thun_compile(E, S, So, FP0, FP).
+
+
+% combo_compile(_Combo, E, Si, So, FP0, FP) -->
+%     % look up combinator, compile it...
+%     {Si = S, E = Eo},
+%     thun_compile(Eo, S, So, FP0, FP).
+
+
+% compiler(InputString, MachineCode, StackIn, StackOut) :-
+%     phrase(joy_parse(Expression), InputString), !,
+%     phrase(thun_compile(Expression, StackIn, StackOut, _), MachineCode, []).
+
+
+% show_compiler(InputString, StackIn, StackOut) :-
+%     phrase(joy_parse(Expression), InputString), !,
+%     phrase(thun_compile(Expression, StackIn, StackOut, reggy(_, _, V)), MachineCode, []),
+%     maplist(portray_clause, MachineCode),
+%     assoc_to_list(V, VP),
+%     portray_clause(VP).
+
+
+/*
+
+?- compiler(`1 2 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(_18272, int(1)), mov_imm(_18298, int(2))],
+StackOut = [_18298, _18272|StackIn].
+
+
+- - - -
+
+
+?- compiler(`1 2 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r1, int(1)), mov_imm(r2, int(2)), add(r1, r2, r1)],
+StackOut = [r1|StackIn].
+
+?- compiler(`1 2 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r1, int(1)), mov_imm(r2, int(2)), add(r1, r2, r1)],
+StackOut = [r1|StackIn].
+
+?- compiler(`1 2 + 3 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r1, int(1)), mov_imm(r2, int(2)), add(r1, r2, r1), mov_imm(r3, int(3)), add(r1, r3, r1)],
+StackOut = [r1|StackIn].
+
+?- compiler(`1 2 + +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r1, int(1)), mov_imm(r2, int(2)), add(r1, r2, r1), add(_37848, r1, _37848)],
+StackIn = StackOut, StackOut = [_37848|_37850].
+
+?- compiler(`+ +`, MachineCode, StackIn, StackOut).
+MachineCode = [add(_37270, _37264, _37270), add(_37688, _37270, _37688)],
+StackIn = [_37264, _37270, _37688|_37690],
+StackOut = [_37688|_37690].
+
+?- compiler(`+ +`, MachineCode, [r1, r2, r3], StackOut).
+MachineCode = [add(r2, r1, r2), add(r3, r2, r3)],
+StackOut = [r3].
+
+?- compiler(`+ +`, MachineCode, [r1, r2, r3, r4, r5, r6, r7], StackOut).
+MachineCode = [add(r2, r1, r2), add(r3, r2, r3)],
+StackOut = [r3, r4, r5, r6, r7].
+
+- - - - -
+
+
+?- compiler(`1 2 3 + +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r0, int(1)), mov_imm(r1, int(2)), mov_imm(r2, int(3)), add(r1, r2, r1), add(r0, r1, r0)],
+StackOut = [r0|StackIn].
+
+
+register free seems to work...
+
+?- compiler(`1 2 + 3 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r0, int(1)), mov_imm(r1, int(2)), add(r0, r1, r0), mov_imm(r1, int(3)), add(r0, r1, r0)],
+StackOut = [r0|StackIn] ;
+false.
+
+- - - -
+
+?- compiler(`1 2 dup + 3 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r0, int(1)), mov_imm(r1, int(2)), add(r1, r1, r1), mov_imm(r2, int(3)), add(r1, r2, r1)],
+StackOut = [r1, r0|StackIn] .
+
+?- compiler(`dup +`, MachineCode, StackIn, StackOut).
+MachineCode = [add(_37000, _37000, _37000)],
+StackIn = StackOut, StackOut = [_37000|_37002].
+
+?- compiler(`dup +`, MachineCode, [r0], StackOut).
+MachineCode = [add(r0, r0, r0)],
+StackOut = [r0].
+
+?- compiler(`dup +`, MachineCode, [r0], [r0]).
+MachineCode = [add(r0, r0, r0)].
+
+- - - -
+
+?- compiler(`1 2 3 4 5 + + + 6 7 + 8 + +`, MachineCode, StackIn, StackOut), maplist(portray_clause, MachineCode).
+mov_imm(r0, int(1)).
+mov_imm(r1, int(2)).
+mov_imm(r2, int(3)).
+mov_imm(r3, int(4)).
+mov_imm(r4, int(5)).
+add(r3, r4, r3).
+add(r2, r3, r2).
+add(r1, r2, r1).
+mov_imm(r2, int(6)).
+mov_imm(r3, int(7)).
+add(r2, r3, r2).
+mov_imm(r3, int(8)).
+add(r2, r3, r2).
+add(r1, r2, r1).
+
+
+Fun!
+
+- - - -
+
+Test that returning registers before asking for new ones
+does reuse registers that are unused and preserve registers
+that are still in use.
+
+?- show_compiler(`1 dup 2 + swap 3 +`, StackIn, StackOut).
+mov_imm(r0, int(1)).
+mov_imm(r1, int(2)).
+add(r1, r1, r0).
+mov_imm(r2, int(3)).
+add(r0, r2, r0).
+[r0-int(_), r1-int(_)].
+StackOut = [r0, r1|StackIn] .
+
+
+
+
+███╗   ███╗███████╗████████╗ █████╗       ██████╗ ██████╗  ██████╗  ██████╗ ██████╗  █████╗ ███╗   ███╗███╗   ███╗██╗███╗   ██╗ ██████╗
+████╗ ████║██╔════╝╚══██╔══╝██╔══██╗      ██╔══██╗██╔══██╗██╔═══██╗██╔════╝ ██╔══██╗██╔══██╗████╗ ████║████╗ ████║██║████╗  ██║██╔════╝
+██╔████╔██║█████╗     ██║   ███████║█████╗██████╔╝██████╔╝██║   ██║██║  ███╗██████╔╝███████║██╔████╔██║██╔████╔██║██║██╔██╗ ██║██║  ███╗
+██║╚██╔╝██║██╔══╝     ██║   ██╔══██║╚════╝██╔═══╝ ██╔══██╗██║   ██║██║   ██║██╔══██╗██╔══██║██║╚██╔╝██║██║╚██╔╝██║██║██║╚██╗██║██║   ██║
+██║ ╚═╝ ██║███████╗   ██║   ██║  ██║      ██║     ██║  ██║╚██████╔╝╚██████╔╝██║  ██║██║  ██║██║ ╚═╝ ██║██║ ╚═╝ ██║██║██║ ╚████║╚██████╔╝
+╚═╝     ╚═╝╚══════╝   ╚═╝   ╚═╝  ╚═╝      ╚═╝     ╚═╝  ╚═╝ ╚═════╝  ╚═════╝ ╚═╝  ╚═╝╚═╝  ╚═╝╚═╝     ╚═╝╚═╝     ╚═╝╚═╝╚═╝  ╚═══╝ ╚═════╝
+
+
+
+
+
+
+
+███████╗██╗  ██╗██████╗  █████╗ ███╗   ██╗██████╗         ██╗     ██████╗ ██████╗ ███╗   ██╗████████╗██████╗  █████╗  ██████╗████████╗
+██╔════╝╚██╗██╔╝██╔══██╗██╔══██╗████╗  ██║██╔══██╗       ██╔╝    ██╔════╝██╔═══██╗████╗  ██║╚══██╔══╝██╔══██╗██╔══██╗██╔════╝╚══██╔══╝
+█████╗   ╚███╔╝ ██████╔╝███████║██╔██╗ ██║██║  ██║      ██╔╝     ██║     ██║   ██║██╔██╗ ██║   ██║   ██████╔╝███████║██║        ██║
+██╔══╝   ██╔██╗ ██╔═══╝ ██╔══██║██║╚██╗██║██║  ██║     ██╔╝      ██║     ██║   ██║██║╚██╗██║   ██║   ██╔══██╗██╔══██║██║        ██║
+███████╗██╔╝ ██╗██║     ██║  ██║██║ ╚████║██████╔╝    ██╔╝       ╚██████╗╚██████╔╝██║ ╚████║   ██║   ██║  ██║██║  ██║╚██████╗   ██║
+╚══════╝╚═╝  ╚═╝╚═╝     ╚═╝  ╚═╝╚═╝  ╚═══╝╚═════╝     ╚═╝         ╚═════╝ ╚═════╝ ╚═╝  ╚═══╝   ╚═╝   ╚═╝  ╚═╝╚═╝  ╚═╝ ╚═════╝   ╚═╝
+
+*/
+
+% Simple DCGs to expand/contract definitions.
+
+expando, Body --> [symbol(Def)], {def(Def, Body)}.
+contracto, [symbol(Def)] --> {def(Def, Body)}, Body.
+
+% Apply expando/contracto more than once, and descend into sub-lists.
+% The K term is one of expando or contracto, and the J term is used
+% on sub-lists, i.e. expando/grow and contracto/shrink.
+% BTW, "rebo" is a meaningless name, don't break your brain
+% trying to figure it out.
+
+rebo(K, J)            -->       K      ,                         rebo(K, J).
+rebo(K, J), [list(E)] --> [list([H|T])], !, {call(J, [H|T], E)}, rebo(K, J).
+rebo(K, J), [   A   ] --> [     A     ], !,                      rebo(K, J).
+rebo(_, _)            --> [].
+
+to_fixed_point(DCG, Ei, Eo) :-
+    phrase(DCG, Ei, E),  % Apply DCG...
+    (Ei=E -> Eo=E ; to_fixed_point(DCG, E, Eo)).  % ...until a fixed-point is reached.
+
+grow   --> to_fixed_point(rebo(expando,   grow  )).
+shrink --> to_fixed_point(rebo(contracto, shrink)).
+
+% ?- phrase(grow, [symbol(third)], Out).
+% Out = [symbol(rest), symbol(rest), symbol(first)] ;
+% Out = [symbol(rest), symbol(rest), symbol(first)] ;
+% Out = [symbol(rest), symbol(second)] ;
+% Out = [symbol(third)].
+
+% ?- phrase(shrink, [symbol(rest), symbol(rest), symbol(first)], Out).
+% Out = [symbol(rrest), symbol(first)] ;
+% Out = [symbol(third)] ;
+% Out = [symbol(rest), symbol(second)] ;
+% Out = [symbol(rest), symbol(rest), symbol(first)].
+
+
+/*
+
+███████╗ ██████╗ ██████╗ ███╗   ███╗ █████╗ ████████╗████████╗███████╗██████╗
+██╔════╝██╔═══██╗██╔══██╗████╗ ████║██╔══██╗╚══██╔══╝╚══██╔══╝██╔════╝██╔══██╗
+█████╗  ██║   ██║██████╔╝██╔████╔██║███████║   ██║      ██║   █████╗  ██████╔╝
+██╔══╝  ██║   ██║██╔══██╗██║╚██╔╝██║██╔══██║   ██║      ██║   ██╔══╝  ██╔══██╗
+██║     ╚██████╔╝██║  ██║██║ ╚═╝ ██║██║  ██║   ██║      ██║   ███████╗██║  ██║
+╚═╝      ╚═════╝ ╚═╝  ╚═╝╚═╝     ╚═╝╚═╝  ╚═╝   ╚═╝      ╚═╝   ╚══════╝╚═╝  ╚═╝
+
+
+?- phrase(joy_parse(E), `22 18 true [false] [1[2[3]]]`), !, format_joy_terms(E, A, []), string_codes(S, A).
+E = [int(22), int(18), bool(true), list([bool(false)]), list([int(1), list([...|...])])],
+A = [50, 50, 32, 49, 56, 32, 116, 114, 117|...],
+S = "22 18 true [false] [1 [2 [3]]]".
+
+*/
+
+format_joy_expression(   int(I)) --> { number_codes(I, Codes) }, Codes.
+format_joy_expression(  bool(B)) --> {   atom_codes(B, Codes) }, Codes.
+format_joy_expression(symbol(S)) --> {   atom_codes(S, Codes) }, Codes.
+format_joy_expression(  list(J)) --> "[", format_joy_terms(J), "]".
+
+format_joy_terms(    []) --> [].
+format_joy_terms(   [T]) --> format_joy_expression(T), !.
+format_joy_terms([T|Ts]) --> format_joy_expression(T), " ", format_joy_terms(Ts).
+
+joy_terms_to_string(Expr, String) :-
+    format_joy_terms(Expr, Codes, []),
+    string_codes(String, Codes).
+
+
+/*
+
+██████╗  █████╗ ██████╗ ████████╗██╗ █████╗ ██╗
+██╔══██╗██╔══██╗██╔══██╗╚══██╔══╝██║██╔══██╗██║
+██████╔╝███████║██████╔╝   ██║   ██║███████║██║
+██╔═══╝ ██╔══██║██╔══██╗   ██║   ██║██╔══██║██║
+██║     ██║  ██║██║  ██║   ██║   ██║██║  ██║███████╗
+╚═╝     ╚═╝  ╚═╝╚═╝  ╚═╝   ╚═╝   ╚═╝╚═╝  ╚═╝╚══════╝
+
+██████╗ ███████╗██████╗ ██╗   ██╗ ██████╗███████╗██████╗
+██╔══██╗██╔════╝██╔══██╗██║   ██║██╔════╝██╔════╝██╔══██╗
+██████╔╝█████╗  ██║  ██║██║   ██║██║     █████╗  ██████╔╝
+██╔══██╗██╔══╝  ██║  ██║██║   ██║██║     ██╔══╝  ██╔══██╗
+██║  ██║███████╗██████╔╝╚██████╔╝╚██████╗███████╗██║  ██║
+╚═╝  ╚═╝╚══════╝╚═════╝  ╚═════╝  ╚═════╝╚══════╝╚═╝  ╚═╝
+
+Partial Reducer from "The Art of Prolog" by Sterling and Shapiro
+Program 18.3, pg. 362 */
+
+process(Program, ReducedProgram) :-
+    findall(PC1, (member(C1, Program), preduce(C1, PC1)), ReducedProgram).
+
+preduce( (A :- B), (Pa :- Pb) ) :- !, preduce(B, Pb), preduce(A, Pa).
+preduce(     true,       true ) :- !.
+preduce(   (A, B),    Residue ) :- !, preduce(A, Pa), preduce(B, Pb), combine(Pa, Pb, Residue).
+% preduce(        A,          B ) :- should_fold(A, B), !.
+preduce(        A,    Residue ) :- should_unfold(A), !, clause(A, B), preduce(B, Residue).
+preduce(        A,          A ).
+
+% As {*,1} and {+,0} so we have {(,),true}.  Whatsitsname?  Monoid or something...
+%    {*,0}     {+,Inf}          {(,),fail}...
+
+combine(true, B, B) :- !.
+combine(A, true, A) :- !.
+combine(A,    B, (A, B)).
+
+/*
+
+Partial reduction of thun/3 in the thun/4 relation gives a new
+version of thun/4 that is tail-recursive.  You generate the new
+relation rules like so:
+
+    ?- thunder(C), process(C, R), maplist(portray_clause, R).
+
+I just cut-n-paste from the SWI terminal and rearrange it.
+
+*/
+
+should_unfold(thun(_, _, _)).
+should_unfold(func(_, _, _)).
+should_unfold(def(_, _)).
+
+thunder([  % Source code for thun/4.
+    (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, [Head|Body]), append(Body, E, Eo), thun(Head, 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))
+]).
+
+partial_reduce_thun :-
+    thunder(C),
+    process(C, R),
+    setup_call_cleanup(
+        open("gen-defs+funcs.pl", write, Out),
+        maplist(portray_clause(Out), R),
+        close(Out)
+    ).
+
+
+/*
+
+N.B.: in 'thun(symbol(Def)...' the last clause has changed from thun/3 to thun/4.
+The earlier version doesn't transform into correct code:
+
+    thun(symbol(B), D, A, A) :- def(B, C), append(C, D, []).
+    thun(symbol(A), C, F, G) :- def(A, B), append(B, C, [D|E]), thun(D, E, F, G).
+
+With the change to thun/4 it doesn't transform under reduction w/ thun/3.
+
+You can also unfold def/2 and func/3 (but you need to check for bugs!)
+
+Functions become clauses like these:
+
+    thun(symbol(rolldown),    [], [C, A, B|D], [A, B, C|D]).
+    thun(symbol(rolldown), [A|B], [E, C, D|F], G) :- thun(A, B, [C, D, E|F], G).
+
+    thun(symbol(dupd),    [], [A, B|C], [A, B, B|C]).
+    thun(symbol(dupd), [A|B], [C, D|E], F) :- thun(A, B, [C, D, D|E], F).
+
+    thun(symbol(over),    [], [B, A|C], [A, B, A|C]).
+    thun(symbol(over), [A|B], [D, C|E], F) :- thun(A, B, [C, D, C|E], F).
+
+Definitions become
+
+    thun(symbol(of), A, D, E) :-
+        append([symbol(swap), symbol(at)], A, [B|C]),
+        thun(B, C, D, E).
+
+    thun(symbol(pam), A, D, E) :-
+        append([list([symbol(i)]), symbol(map)], A, [B|C]),
+        thun(B, C, D, E).
+
+    thun(symbol(popd), A, D, E) :-
+        append([list([symbol(pop)]), symbol(dip)], A, [B|C]),
+        thun(B, C, D, E).
+
+These are tail-recursive and allow for better indexing so I would expect
+them to be more efficient than the originals.  Ii would be even nicer to
+get them looking like this:
+
+    thun(symbol(of), A, D, E) :- thun(symbol(swap), [symbol(at)|A], D, E).
+
+And then if 'swap' was a definition you could push it out even further,
+you could pre-expand definitions and functions (and maybe even some
+combinators!)
+
+*/
diff --git a/implementations/Prolog/source/thun_compile.pl b/implementations/Prolog/source/thun_compile.pl
new file mode 100644
index 0000000..fad1970
--- /dev/null
+++ b/implementations/Prolog/source/thun_compile.pl
@@ -0,0 +1,295 @@
+:- use_module(library(clpfd)).
+:- [thun].
+/*
+
+    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 .
+
+
+The enviroment or context is a predicate reggy/4:
+
+    reggy(FreePool, References, Values, Code)
+
+The FreePool is a list of atoms that each denote a free register; 
+References is a list of register atoms that keeps track of how many times
+a register is used (it is in lieu of reference counting);  Values is an
+assoc list mapping register atoms to their current values; and lastly
+Code is a list of machine code predicates emitted by the compiler.
+
+ */
+
+% just to hush the linter, which won't respect consult/1.
+% def(Name, _).
+% func(Name, _, _).
+% combo(Name, _, _, _, _).
+% joy_parse(_, _, _).
+
+
+encode_list(List, addr(list(List))) --> [].
+
+% Retrieve the next free register.
+get_reggy([], _, _) :- writeln('Out of Registers'), fail.
+get_reggy([Reg|FreePool], Reg, FreePool).
+
+% free one reference and de-allocate if it was the last.
+free_reg(Reg, Value, reggy(FreePool0, References0, V0, Code),
+                     reggy(FreePool,  References,  V,  Code)) :-
+    select(Reg, References0, References),
+    get_assoc(Reg, V0, Value),
+    (  member(Reg, References)  % If reg is still in use
+    -> FreePool=     FreePool0, V0=V % we can't free it yet
+    ;  FreePool=[Reg|FreePool0], % otherwise we put it back in the pool.
+       del_assoc(Reg, V0, _, V)
+    ).
+
+add_ref(Reg, reggy(FreePool,      References,  V, Code),
+             reggy(FreePool, [Reg|References], V, Code)).
+
+assoc_reg(Reg, Value, reggy(FreePool0,      References,  V0, Code),
+                      reggy(FreePool,  [Reg|References], V,  Code)) :-
+    get_reggy(FreePool0, Reg, FreePool),
+    put_assoc(Reg, V0, Value, V).
+
+fresh_env(reggy(  % Create a fresh new env/context with...
+    [r0, r1, r2, r3,  % Available registers
+     r4, r5, r6, r7,
+     r8, r9, rA, rB,
+     rC, rD, rE, rF],
+    [],               % References.
+    V,                % Register to value assoc list.
+    []                % List of (pseudo-)machine code.
+    )) :-
+        empty_assoc(V).
+
+
+emit([]) --> [].
+emit([A|Rest]) --> emit(A), emit(Rest).
+emit(A) --> { A \= [], A \= [_|_] }, emit_code(A).
+
+emit_code(C, reggy(FreePool, References, V, [C|Code]),
+             reggy(FreePool, References, V,    Code )).
+
+
+/* Compiling
+
+THread through the env/context as DCG dif-lists
+
+*/
+
+thun_compile(E, Si, So, Env) :-
+    fresh_env(Env0),
+    thun_compile(E, Si, So, Env0, Env).
+
+thun_compile([], S, S) --> [].
+thun_compile([Term|Rest], Si, So) --> thun_compile(Term, Rest, Si, So).
+
+thun_compile(int(I), E, Si, So) -->
+    emit(mov_imm(R, int(I))),
+    assoc_reg(R, int(I)),
+    thun_compile(E, [R|Si], So).
+
+thun_compile(bool(B), E, Si, So) -->
+    assoc_reg(R, bool(B)),
+    thun_compile(E, [R|Si], So).
+
+thun_compile(list(L), E, Si, So) -->
+    encode_list(L, Addr),
+    assoc_reg(R, Addr),
+    emit(load_imm(R, Addr)),
+    thun_compile(E, [R|Si], So).
+
+thun_compile(symbol(Name), E, Si, So) -->
+    {   def(Name, _)          } ->   def_compile(Name, E, Si, So) ;
+    {  func(Name, _, _)       } ->  func_compile(Name, E, Si, So) ;
+    { combo(Name, _, _, _, _) } -> combo_compile(Name, E, Si, So).
+
+
+% I'm going to assume that any defs that can be compiled to funcs already
+% have been.  Defs that can't be pre-compiled shove their body expression
+% onto the pending expression (continuation) to be compiled "inline".
+
+def_compile(Def, E, Si, So) -->
+    { def(Def, Body), append(Body, E, Eo) },
+    thun_compile(Eo, Si, So).
+
+
+% swap (et. al.) doesn't change register refs nor introspect values
+% so we can delegate its effect to the semantic relation.
+non_alloc(swap).
+non_alloc(rollup).
+non_alloc(rolldown).
+
+% Functions delegate to a per-function compilation relation.
+
+func_compile(+, E, [A, B|S], So) --> !,
+    free_reg(A, int(N)),
+    free_reg(B, int(M)),
+    assoc_reg(R, int(K)),
+    emit(add(R, A, B)),
+    { K #= N + M },
+    % Update value in the context?
+    thun_compile(E, [R|S], So).
+
+func_compile(dup, E, [A|S], So) --> !,
+    add_ref(A),
+    thun_compile(E, [A, A|S], So).
+
+func_compile(pop, E, [A|S], So) --> !,
+    free_reg(A, _),
+    thun_compile(E, S, So).
+
+func_compile(cons, E, [List, Item|S], So) --> !,
+    % Assume list is already stored in RAM
+    % and item ...
+    % allocate a cons cell
+    emit(alloc_cons(list(Item, List))),
+    % https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-33.html#%_sec_5.3
+    thun_compile(E, S, So).
+
+func_compile(Func, E, Si, So) --> { non_alloc(Func), !,
+    func(Func, Si, S) },
+    thun_compile(E, S, So).
+
+func_compile(_Func, E, Si, So) -->
+    % look up function, compile it...
+    {Si = S},
+    thun_compile(E, S, So).
+
+
+combo_compile(_Combo, E, Si, So) -->
+    % look up combinator, compile it...
+    {Si = S, E = Eo},
+    thun_compile(Eo, S, So).
+
+
+compiler(InputString, StackIn, StackOut, FreePool0, References0, Values0, MachineCode0, FreePool,  References,  Values,  MachineCode) :-
+    phrase(joy_parse(Expression), InputString), !,
+    thun_compile(Expression, StackIn, StackOut,
+        reggy(FreePool0, References0, Values0, MachineCode0),
+        reggy(FreePool,  References,  Values,  MachineCode )
+    ).
+
+    % phrase(thun_compile(Expression, StackIn, StackOut, _), MachineCode, []).
+
+
+
+compiler(InputString, StackIn, StackOut, FreePool,  References,  Values,  MachineCode) :-
+    [r0, r1, r2, r3,  % Available registers
+     r4, r5, r6, r7,
+     r8, r9, rA, rB,
+     rC, rD, rE, rF]=FreePool0,
+    empty_assoc(Values0),
+    compiler(InputString, StackIn, StackOut,
+        FreePool0, [], Values0, MachineCode,
+        FreePool,  References,  Values,  []).
+
+
+% compiler(`3 +`, [r0|StackIn], StackOut, [r1, r2, r3, r4, ], [r0], Values0, MachineCode0, FreePool,  References,  Values,  MachineCode).
+
+/* 
+
+compiler(`2`, StackIn, Stack1,           FreePool0, References0, Values0, MachineCode0),
+compiler(`3 +`,        Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool,  References,  Values,  []).
+
+?- compiler(`2`, StackIn, Stack1,           FreePool0, References0, Values0, MachineCode0),
+   compiler(`3 +`,        Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool,  References,  Values,  []).|    compiler(`3 +`,        Stack1, StackOut, FreePool0, References0, Values0, MachineCode1, FreePool,  References,  Values,  []).
+Stack1 = StackOut, StackOut = [r0|StackIn],
+FreePool0 = FreePool, FreePool = [r1, r2, r3, r4, r5, r6, r7, r8, r9|...],
+References0 = References, References = [r0],
+Values0 = t(r0, int(2), -, t, t),
+MachineCode0 = [mov_imm(r0, int(2))],
+MachineCode1 = [mov_imm(r1, int(3)), add(r0, r1, r0)],
+Values = t(r0, int(_19548), -, t, t) .
+
+ */
+
+
+% show_compiler(InputString, StackIn, StackOut) :-
+%     phrase(joy_parse(Expression), InputString), !,
+%     phrase(thun_compile(Expression, StackIn, StackOut, reggy(_, _, V)), MachineCode, []),
+%     maplist(portray_clause, MachineCode),
+%     assoc_to_list(V, VP),
+%     portray_clause(VP).
+
+
+
+/*
+
+So what happens when you compile just an integer literal?
+
+?- thun_compile([int(23)], Si, So, reggy(FreePool, References, Values, Code)).
+So = [r0|Si],
+FreePool = [r1, r2, r3, r4, r5, r6, r7, r8, r9|...],
+References = [r0],
+Values = t(r0, int(23), -, t, t),
+Code = [mov_imm(r0, int(23))].
+
+The int is put onto the next available register, which is returned on the stack.
+
+
+?- compiler(`2 3 +`, MachineCode, StackIn, StackOut).
+MachineCode = [mov_imm(r0, int(2)), mov_imm(r1, int(3)), add(r0, r1, r0)],
+StackOut = [r0|StackIn] ;
+false.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+?- phrase(grow, [symbol('&&')], Out), writeln(Out).
+
+
+[
+    list([
+        list([symbol(stack)]),
+        symbol(dip),
+        symbol(swap),
+        symbol(cons),
+        symbol(swaack),
+        list([symbol(i)]),
+        symbol(dip),
+        symbol(swaack),
+        symbol(first)
+        ]),
+    msymbol(cons),
+    list([
+        list([symbol(stack)]),
+        symbol(dip),
+        symbol(swap),
+        symbol(cons),
+        symbol(swaack),
+        list([symbol(i)]),
+        symbol(dip),
+        symbol(swaack),
+        symbol(first),
+        list([bool(false)])
+    ]),
+    symbol(dip),
+    symbol(branch)
+]
+
+
+ */
\ No newline at end of file
diff --git a/implementations/Prolog/test/test_thun.pl b/implementations/Prolog/test/test_thun.pl
new file mode 100644
index 0000000..432725a
--- /dev/null
+++ b/implementations/Prolog/test/test_thun.pl
@@ -0,0 +1,32 @@
+:- ["../source/thun.pl"].
+/* 
+
+Tests
+
+Woefully inadequate, but it's a start.
+
+Run test/0.
+
+    ?- tests.
+    YES! test_parser([],[[]])
+    YES! test_parser([32],[[]])
+    YES! test_parser([91,93],[[list([])]])
+    YES! test_parser([50,51],[[int(23)]])
+    YES! test_parser([50,91,51,93],[[int(2),list([int(3)])]])
+    true.
+
+*/
+
+tests :- forall(test_case(T), test(T)).
+
+test(Goal) :- (Goal -> write("YES! ") ; write("no!  ")), writeln(Goal).
+
+test_parser(Source, Exprs) :- findall(Expr, joy_parse(Expr, Source, []), Exprs).
+
+test_case(test_parser(``, [[]])).
+test_case(test_parser(` `, [[]])).
+test_case(test_parser(`[]`, [[list([])]])).
+test_case(test_parser(`23`, [[ int(23)]])).
+test_case(test_parser(`2[3]`, [[int(2), list([int(3)])]])).
+
+% and so on...