The whole thing is kind of a mess.
This commit is contained in:
Simon Forman
@@ -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.
|
||||
@@ -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
|
||||
|
||||
___ _ _ _ _ _
|
||||
| __| _ _ _ __| |_(_)___ _ _ __ _| (_) |_ _ _
|
||||
| _| || | ' \/ _| _| / _ \ ' \/ _` | | | _| || |
|
||||
|_| \_,_|_||_\__|\__|_\___/_||_\__,_|_|_|\__|\_, |
|
||||
__ _ _ _ __| | | _ \_ _ _ _ _ __ ___ ___ |__/
|
||||
/ _` | ' \/ _` | | _/ || | '_| '_ \/ _ (_-</ -_)
|
||||
\__,_|_||_\__,_| |_| \_,_|_| | .__/\___/__/\___|
|
||||
|_|
|
||||
Functionality and Purpose
|
||||
|
||||
It all started about a quarter of a century ago when I first went to
|
||||
Seattle and found the book in their main branch library: "System Design
|
||||
from Provably-Correct Constructs". It presents a version of Dr. Margaret
|
||||
Hamilton's "Higher Order Software". Thun is an attempt at making a
|
||||
system like that.
|
||||
|
||||
There are two aspects to this project. One is the language Joy and tools
|
||||
to work with it, the other is a kind of user interface that presents Joy
|
||||
in a way that (hopefully) is much better than current UIs. Both of these
|
||||
come together to create what I hope is a fundamentally better computer
|
||||
system.
|
||||
|
||||
At the moment, this repo just contains the Prolog version of Joy. I'll
|
||||
bring over the GUI code from the original project or create some new
|
||||
version, possibly web-based.
|
||||
|
||||
Joy
|
||||
|
||||
Joy is a notation for programming created by Manfred von Thun that's easy
|
||||
to use and understand and has many other nice properties. This Prolog
|
||||
code implements an interpreter and other tools for a dialect of Joy that
|
||||
attempts to stay very close to the spirit of Joy but does not precisely
|
||||
match the behaviour of the original version(s) written in C. The main
|
||||
difference between Thun and the originals, other than being written in
|
||||
Prolog, is that it works by the "Continuation-Passing Style".
|
||||
|
||||
The best source (no pun intended) for learning about Joy is the
|
||||
information made available at the website of La Trobe University (see
|
||||
below for the URL) which contains source code for the original C
|
||||
interpreter, Joy language source code for various functions, and a great
|
||||
deal of fascinating material mostly written by Von Thun on Joy and its
|
||||
deeper facets as well as how to program in it and several interesting
|
||||
aspects. It's quite a treasure trove.
|
||||
|
||||
Wikipedia entry for Joy:
|
||||
https://en.wikipedia.org/wiki/Joy_%28programming_language%29
|
||||
|
||||
Homepage at La Trobe University:
|
||||
http://www.latrobe.edu.au/humanities/research/research-projects/past-projects/joy-programming-language
|
||||
|
||||
Joy is stack-based, concatenative, and purely functional. Currently only
|
||||
four kinds of fundamental values are recognized: integers, Boolean values
|
||||
'true' and 'false', symbols (representing the names of functors), and
|
||||
sequences (enclosed in square brackets.)
|
||||
|
||||
23 dup [21 18 /] [1 [2 [3]]] true false
|
||||
|
||||
A Joy expression is just a sequence of items. Sequences are also called
|
||||
lists, and sequences intended as programs are called "quoted programs".
|
||||
Evaluation proceeds by iterating through the terms in the expression,
|
||||
putting all literals onto the main stack and evaluating functions as they
|
||||
are encountered. Functions receive the current stack and return the next
|
||||
stack.
|
||||
|
||||
Functions called "combinators" accept quoted programs on the stack and
|
||||
run them in various ways. These combinators factor specific patterns
|
||||
that provide the effect of control-flow in other languages (such as ifte
|
||||
which is like if..then..else..) Combinators receive the current
|
||||
expession in addition to the stack and return the next expression. They
|
||||
work by changing the pending expression the interpreter is about to
|
||||
execute.
|
||||
|
||||
___ _ _ _ _ _
|
||||
|_ _|_ _ __| |_ __ _| | |__ _| |_(_)___ _ _
|
||||
| || ' \(_-< _/ _` | | / _` | _| / _ \ ' \
|
||||
|___|_||_/__/\__\__,_|_|_\__,_|\__|_\___/_||_|
|
||||
|
||||
Installation
|
||||
|
||||
Download or clone the repository, no special installation is required,
|
||||
although you will need a recent version of SWI Prolog. No configuration
|
||||
is required.
|
||||
|
||||
___ _
|
||||
| _ \_ _ _ _ _ _ (_)_ _ __ _
|
||||
| / || | ' \| ' \| | ' \/ _` |
|
||||
|_|_\\_,_|_||_|_||_|_|_||_\__, |
|
||||
|___/
|
||||
Running
|
||||
|
||||
I just change into the source directory and load the thun.pl into SWI
|
||||
Prolog.
|
||||
|
||||
PS C:\Users\sforman\Desktop\src\PROLOG\Thun> 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.
|
||||
@@ -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.
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 46 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 72 KiB |
@@ -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+ -1,
|
||||
A+1#=_67378,
|
||||
C in 1..sup,
|
||||
C+1#=_67426,
|
||||
_67426 in 1..sup,
|
||||
_67378 in 1..sup ;
|
||||
|
||||
|
||||
B = true,
|
||||
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+ -1,
|
||||
C in 2..sup,
|
||||
C+1#=_68008,
|
||||
_68008 in 1..sup,
|
||||
_67912 in inf..0 ;
|
||||
|
||||
|
||||
B = true,
|
||||
A in inf.. -1,
|
||||
_67724+A#=0,
|
||||
A+1#=_67744,
|
||||
_67724 in 1..sup,
|
||||
_67724#>=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+ -1,
|
||||
C in 1..sup,
|
||||
C+1#=_7782,
|
||||
_7782 in 1..sup ;
|
||||
|
||||
|
||||
B = true,
|
||||
_7518#=abs(A),
|
||||
_7518 in 0..sup,
|
||||
_7518#>=C,
|
||||
C in 0..sup,
|
||||
C+1#=_7608,
|
||||
_7608 in 1..sup ;
|
||||
|
||||
|
||||
B = false,
|
||||
A in 0..sup,
|
||||
A#=<C+ -1,
|
||||
A+1#=_8742,
|
||||
C in 1..sup,
|
||||
C+1#=_8790,
|
||||
_8790 in 1..sup,
|
||||
_8742 in 1..sup ;
|
||||
|
||||
|
||||
B = true,
|
||||
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+ -1,
|
||||
C in 2..sup,
|
||||
C+1#=_9372,
|
||||
_9372 in 1..sup,
|
||||
_9276 in inf..0 ;
|
||||
|
||||
|
||||
B = true,
|
||||
A in inf.. -1,
|
||||
_9088+A#=0,
|
||||
A+1#=_9108,
|
||||
_9088 in 1..sup,
|
||||
_9088#>=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.
|
||||
@@ -0,0 +1,4 @@
|
||||
Talk about minimal basis, Kirby (sp?) has found a basis involving a
|
||||
combinator he calls 'cake'...
|
||||
|
||||
Branch, Loop, Sequence, Parallel.
|
||||
@@ -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.)
|
||||
@@ -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
|
||||
>=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.
|
||||
|
||||
------------------
|
||||
@@ -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).)
|
||||
|
||||
@@ -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 ']'.
|
||||
@@ -0,0 +1,2 @@
|
||||
disenstacken is in the defs.txt
|
||||
it needs to be updated to reflect the unstack<->disenstacken switch.
|
||||
@@ -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
|
||||
@@ -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 .
|
||||
|
||||
@@ -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...
|
||||
@@ -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";
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
|
After Width: | Height: | Size: 162 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 62 KiB |
@@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
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 = "[[]]".
|
||||
|
||||
|
||||
*/
|
||||
@@ -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 <hr> 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(..., ...)|...])])].
|
||||
|
||||
*/
|
||||
@@ -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": {}
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
@@ -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
|
||||
@@ -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]).
|
||||
/** <module> 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.
|
||||
@@ -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
|
||||
@@ -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`).
|
||||
|
||||
|
||||
*/
|
||||
@@ -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#<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#>=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#\=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).
|
||||
@@ -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).
|
||||
@@ -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#<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#>=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#\=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).
|
||||
@@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
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("}").
|
||||
|
||||
@@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
(Big fonts are from Figlet "ANSI Shadow" http://www.patorjk.com/software/taag/#p=display&f=ANSI%20Shadow&t=formatter and "Small".)
|
||||
|
||||
Thun is an implementation of a dialect of the Joy executable notation.
|
||||
|
||||
Table of Contents
|
||||
Parser & Grammar
|
||||
Semantics
|
||||
Functions
|
||||
Combinators
|
||||
Definitions
|
||||
Compiler
|
||||
to Prolog
|
||||
to Machine Code
|
||||
Meta-Programming
|
||||
Expand/Contract Definitions
|
||||
Formatter
|
||||
Partial Reducer
|
||||
|
||||
*/
|
||||
|
||||
:- use_module(library(clpfd)).
|
||||
:- use_module(library(dcg/basics)).
|
||||
:- use_module(library(gensym)).
|
||||
:- dynamic func/3.
|
||||
:- dynamic def/2.
|
||||
|
||||
|
||||
/*
|
||||
An entry point.
|
||||
*/
|
||||
|
||||
joy(InputString, StackIn, StackOut) :-
|
||||
text_to_expression(InputString, Expression),
|
||||
!,
|
||||
thun(Expression, StackIn, StackOut).
|
||||
|
||||
/*
|
||||
|
||||
██████╗ █████╗ ██████╗ ███████╗███████╗██████╗ ██╗
|
||||
██╔══██╗██╔══██╗██╔══██╗██╔════╝██╔════╝██╔══██╗ ██║
|
||||
██████╔╝███████║██████╔╝███████╗█████╗ ██████╔╝ ████████╗
|
||||
██╔═══╝ ██╔══██║██╔══██╗╚════██║██╔══╝ ██╔══██╗ ██╔═██╔═╝
|
||||
██║ ██║ ██║██║ ██║███████║███████╗██║ ██║ ██████║
|
||||
╚═╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚══════╝╚══════╝╚═╝ ╚═╝ ╚═════╝
|
||||
|
||||
██████╗ ██████╗ █████╗ ███╗ ███╗███╗ ███╗ █████╗ ██████╗
|
||||
██╔════╝ ██╔══██╗██╔══██╗████╗ ████║████╗ ████║██╔══██╗██╔══██╗
|
||||
██║ ███╗██████╔╝███████║██╔████╔██║██╔████╔██║███████║██████╔╝
|
||||
██║ ██║██╔══██╗██╔══██║██║╚██╔╝██║██║╚██╔╝██║██╔══██║██╔══██╗
|
||||
╚██████╔╝██║ ██║██║ ██║██║ ╚═╝ ██║██║ ╚═╝ ██║██║ ██║██║ ██║
|
||||
╚═════╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═╝
|
||||
|
||||
The grammar of Joy is very simple. A Joy expression is zero or more Joy
|
||||
terms (separated by blanks, see below) and terms can be
|
||||
integers, Booleans, quoted Joy expressions, or symbols (names of
|
||||
functions.)
|
||||
|
||||
joy ::= term*
|
||||
|
||||
term ::= integer | bool | '[' joy ']' | symbol
|
||||
|
||||
integer ::= [ '-' | '+' ] ('0'...'9')+
|
||||
bool ::= 'true' | 'false'
|
||||
symbol ::= char+
|
||||
|
||||
char ::= <Any non-space other than '[' and ']'.>
|
||||
|
||||
There are a few wrinkles in the handling of blank space between terms
|
||||
because we want to be able to omit it around brackets:
|
||||
|
||||
Valid expressions:
|
||||
|
||||
1 2 3
|
||||
1[2]3
|
||||
1 [ 2 ] 3
|
||||
true
|
||||
truedat (a symbol prefixed with the name of a boolean)
|
||||
|
||||
Invalid:
|
||||
|
||||
12three (symbols can't start with numbers, and this shouldn't parse
|
||||
as [12 three].)
|
||||
|
||||
Symbols can be made of any non-blank characters except '['and ']' which
|
||||
are fully reserved for list literals (aka "quotes"). 'true' and 'false'
|
||||
would be valid symbols but they are reserved for Boolean literals.
|
||||
|
||||
Integers are converted to Prolog integers, symbols and bools to Prolog
|
||||
atoms, and list literals to Prolog lists.
|
||||
|
||||
For now strings are neglected in favor of lists of numbers. (But there's
|
||||
no support for parsing string notation and converting to lists of ints.)
|
||||
|
||||
First lex the stream of codes into tokens separated by square brackets
|
||||
or whitespace. We keep the brackets and throw away the blanks.
|
||||
*/
|
||||
|
||||
joy_lex([tok(Token)|Ls]) --> chars(Token), !, joy_lex(Ls).
|
||||
joy_lex([ lbracket|Ls]) --> "[", !, joy_lex(Ls).
|
||||
joy_lex([ rbracket|Ls]) --> "]", !, joy_lex(Ls).
|
||||
|
||||
joy_lex(Ls) --> [Space], {code_type(Space, space)}, !, joy_lex(Ls).
|
||||
|
||||
joy_lex([]) --> [].
|
||||
|
||||
% Then parse the tokens converting them to Prolog values and building up
|
||||
% the list structures (if any.)
|
||||
|
||||
joy_parse([J|Js]) --> joy_term(J), !, joy_parse(Js).
|
||||
joy_parse([]) --> [].
|
||||
|
||||
joy_term(list(J)) --> [lbracket], !, joy_parse(J), [rbracket].
|
||||
joy_term(Atomic) --> [tok(Codes)], {joy_token(Atomic, Codes)}.
|
||||
|
||||
joy_token(int(I), Codes) :- number(I, Codes, []), !. % See dcg/basics.
|
||||
joy_token(bool(true), `true`) :- !.
|
||||
joy_token(bool(false), `false`) :- !.
|
||||
joy_token(symbol(S), Codes) :- atom_codes(S, Codes).
|
||||
|
||||
|
||||
text_to_expression(Text, Expression) :-
|
||||
phrase(joy_lex(Tokens), Text), !,
|
||||
phrase(joy_parse(Expression), Tokens).
|
||||
|
||||
% Apologies for all the (green, I hope) cuts. The strength of the Joy
|
||||
% syntax is that it's uninteresting.
|
||||
|
||||
chars([Ch|Rest]) --> char(Ch), chars(Rest).
|
||||
chars([Ch]) --> char(Ch).
|
||||
|
||||
char(Ch) --> [Ch], {Ch \== 0'[, Ch \== 0'], code_type(Ch, graph)}.
|
||||
|
||||
|
||||
/* Here is an example of Joy code:
|
||||
|
||||
[ [[abs] ii <=]
|
||||
[
|
||||
[<>] [pop !-] ||
|
||||
] &&
|
||||
]
|
||||
[[ !-] [[++]] [[--]] ifte dip]
|
||||
[[pop !-] [--] [++] ifte ]
|
||||
ifte
|
||||
|
||||
It probably seems unreadable but with a little familiarity it becomes
|
||||
just as legible as any other notation. This function accepts two
|
||||
integers on the stack and increments or decrements one of them such that
|
||||
the new pair of numbers is the next coordinate pair in a square spiral
|
||||
(like that used to construct an Ulam Spiral). It is adapted from the
|
||||
code in the answer here:
|
||||
|
||||
https://stackoverflow.com/questions/398299/looping-in-a-spiral/31864777#31864777
|
||||
|
||||
It can be used with the x combinator to make a kind of generator for
|
||||
spiral square coordinates.
|
||||
|
||||
|
||||
|
||||
███████╗███████╗███╗ ███╗ █████╗ ███╗ ██╗████████╗██╗ ██████╗███████╗
|
||||
██╔════╝██╔════╝████╗ ████║██╔══██╗████╗ ██║╚══██╔══╝██║██╔════╝██╔════╝
|
||||
███████╗█████╗ ██╔████╔██║███████║██╔██╗ ██║ ██║ ██║██║ ███████╗
|
||||
╚════██║██╔══╝ ██║╚██╔╝██║██╔══██║██║╚██╗██║ ██║ ██║██║ ╚════██║
|
||||
███████║███████╗██║ ╚═╝ ██║██║ ██║██║ ╚████║ ██║ ██║╚██████╗███████║
|
||||
╚══════╝╚══════╝╚═╝ ╚═╝╚═╝ ╚═╝╚═╝ ╚═══╝ ╚═╝ ╚═╝ ╚═════╝╚══════╝
|
||||
|
||||
The fundamental Joy relation involves an expression and two stacks. One
|
||||
stack serves as input and the other as output.
|
||||
|
||||
thun(Expression, InputStack, OutputStack)
|
||||
|
||||
The null expression (denoted by an empty Prolog list) is effectively an
|
||||
identity function and serves as the end-of-processing marker. As a
|
||||
matter of efficiency (of Prolog) the thun/3 predicate picks off the first
|
||||
term of the expression (if any) and passes it to thun/4 which can then
|
||||
take advantage of Prolog indexing on the first term of a predicate. */
|
||||
|
||||
thun([], S, S).
|
||||
thun([Term|E], Si, So) :- thun(Term, E, Si, So).
|
||||
|
||||
/* The thun/4 predicate was originally written in terms of the thun/3
|
||||
predicate, which was very elegant, but prevented (I assume but have not
|
||||
checked) tail-call recursion. In order to alleviate this, partial
|
||||
reduction is used to generate the actual thun/4 rules, see below.
|
||||
|
||||
Original thun/4 code:
|
||||
|
||||
thun(int(I), E, Si, So) :- thun(E, [ int(I)|Si], So).
|
||||
thun(bool(B), E, Si, So) :- thun(E, [bool(B)|Si], So).
|
||||
thun(list(L), E, Si, So) :- thun(E, [list(L)|Si], So).
|
||||
thun(symbol(Def), E, Si, So) :- def(Def, Body), append(Body, E, Eo), thun(Eo, Si, So).
|
||||
thun(symbol(Func), E, Si, So) :- func(Func, Si, S), thun(E, S, So).
|
||||
thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
|
||||
|
||||
Integers, Boolean values, and lists are put onto the stack, symbols are
|
||||
dispatched to one of three kinds of processing: functions, combinators
|
||||
and definitions (see "defs.txt".) */
|
||||
|
||||
thun(A, [], S, [A|S]) :- var(A), !.
|
||||
thun(A, [T|E], S, So) :- var(A), !, thun(T, E, [A|S], So).
|
||||
|
||||
% Literals turn out okay.
|
||||
|
||||
thun(int(A), [], B, [int(A)|B]).
|
||||
thun(int(C), [A|B], D, E) :- thun(A, B, [int(C)|D], E).
|
||||
|
||||
thun(bool(A), [], B, [bool(A)|B]).
|
||||
thun(bool(C), [A|B], D, E) :- thun(A, B, [bool(C)|D], E).
|
||||
|
||||
thun(list(A), [], B, [list(A)|B]).
|
||||
thun(list(C), [A|B], D, E) :- thun(A, B, [list(C)|D], E).
|
||||
|
||||
% Partial reduction works for func/3 cases.
|
||||
|
||||
thun(symbol(A), [], B, C) :- func(A, B, C).
|
||||
thun(symbol(A), [C|D], B, F) :- func(A, B, E), thun(C, D, E, F).
|
||||
|
||||
% Combinators look ok too.
|
||||
|
||||
% thun(symbol(A), D, B, C) :- combo(A, B, C, D, []).
|
||||
% thun(symbol(A), C, B, G) :- combo(A, B, F, C, [D|E]), thun(D, E, F, G).
|
||||
|
||||
% However, in this case, I think the original version will be more
|
||||
% efficient.
|
||||
|
||||
thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
|
||||
|
||||
% In the reduced rules Prolog will redo all the work of the combo/5
|
||||
% predicate on backtracking through the second rule. It will try
|
||||
% combo/5, which usually won't end in Eo=[] so the first rule fails, then
|
||||
% it will try combo/5 again in the second rule. In the original form
|
||||
% after combo/5 has completed Prolog has computed Eo and can index on it
|
||||
% for thun/3.
|
||||
%
|
||||
% Neither functions nor definitions can affect the expression so this
|
||||
% consideration doesn't apply to those rules. The unification of the
|
||||
% head clauses will distinguish the cases for them.
|
||||
|
||||
% Definitions don't work though (See "Partial Reducer" section below.)
|
||||
% I hand-wrote the def/3 cases here.
|
||||
|
||||
thun(symbol(D), [], Si, So) :- def(D, [DH| E]), thun(DH, E, Si, So).
|
||||
thun(symbol(D), [H|E0], Si, So) :- def(D, [DH|DE]),
|
||||
append(DE, [H|E0], E), /* ................. */ thun(DH, E, Si, So).
|
||||
|
||||
% Partial reduction has been the subject of a great deal of research and
|
||||
% I'm sure there's a way to make definitions work, but it's beyond the
|
||||
% scope of the project at the moment. It works well enough as-is that I'm
|
||||
% happy to manually write out two rules by hand.
|
||||
|
||||
% Some error handling.
|
||||
|
||||
thun(symbol(Unknown), _, _, _) :-
|
||||
\+ def(Unknown, _),
|
||||
\+ func(Unknown, _, _),
|
||||
\+ combo(Unknown, _, _, _, _),
|
||||
write("Unknown: "),
|
||||
writeln(Unknown),
|
||||
fail.
|
||||
|
||||
/*
|
||||
|
||||
███████╗██╗ ██╗███╗ ██╗ ██████╗████████╗██╗ ██████╗ ███╗ ██╗███████╗
|
||||
██╔════╝██║ ██║████╗ ██║██╔════╝╚══██╔══╝██║██╔═══██╗████╗ ██║██╔════╝
|
||||
█████╗ ██║ ██║██╔██╗ ██║██║ ██║ ██║██║ ██║██╔██╗ ██║███████╗
|
||||
██╔══╝ ██║ ██║██║╚██╗██║██║ ██║ ██║██║ ██║██║╚██╗██║╚════██║
|
||||
██║ ╚██████╔╝██║ ╚████║╚██████╗ ██║ ██║╚██████╔╝██║ ╚████║███████║
|
||||
╚═╝ ╚═════╝ ╚═╝ ╚═══╝ ╚═════╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚══════╝
|
||||
|
||||
*/
|
||||
|
||||
func(words, S, [Words|S]) :- words(Words).
|
||||
|
||||
func(swap, [A, B|S], [B, A|S]).
|
||||
func(dup, [A|S], [A, A|S]).
|
||||
func(pop, [_|S], S ).
|
||||
|
||||
func(cons, [list(A), B |S], [list([B|A])|S]).
|
||||
func(concat, [list(A), list(B)|S], [list(C)|S]) :- append(B, A, C).
|
||||
func(flatten, [list(A)|S], [list(B)|S]) :- flatten(A, B).
|
||||
func(swaack, [list(R)|S], [list(S)|R]).
|
||||
func(stack, S , [list(S)|S]).
|
||||
func(clear, _ , []).
|
||||
func(first, [list([X|_])|S], [ X |S]).
|
||||
func(rest, [list([_|X])|S], [list(X)|S]).
|
||||
func(unit, [X|S], [list([X])|S]).
|
||||
|
||||
func(rolldown, [A, B, C|S], [B, C, A|S]).
|
||||
func(dupd, [A, B|S], [A, B, B|S]).
|
||||
func(over, [A, B|S], [B, A, B|S]).
|
||||
func(tuck, [A, B|S], [A, B, A|S]).
|
||||
func(dupdd, [A, B, C|D], [A, B, C, C|D]).
|
||||
|
||||
% func(stackd, [A|B], [A, list(B)|B]). % Doesn't compile.
|
||||
|
||||
func(shift, [list([B|A]), list(C)|D], [list(A), list([B|C])|D]).
|
||||
|
||||
func(rollup, Si, So) :- func(rolldown, So, Si).
|
||||
func(uncons, Si, So) :- func(cons, So, Si).
|
||||
|
||||
func(bool, [ int(0)|S], [bool(false)|S]).
|
||||
func(bool, [ list([])|S], [bool(false)|S]).
|
||||
func(bool, [bool(false)|S], [bool(false)|S]).
|
||||
|
||||
func(bool, [ int(N)|S], [bool(true)|S]) :- N #\= 0.
|
||||
func(bool, [list([_|_])|S], [bool(true)|S]).
|
||||
func(bool, [ bool(true)|S], [bool(true)|S]).
|
||||
% func(bool, [A|S], [bool(true)|S]) :- \+ func(bool, [A], [bool(false)]).
|
||||
|
||||
func('empty?', [ list([])|S], [ bool(true)|S]).
|
||||
func('empty?', [ list([_|_])|S], [bool(false)|S]).
|
||||
|
||||
func('list?', [ list(_)|S], [ bool(true)|S]).
|
||||
func('list?', [ bool(_)|S], [bool(false)|S]).
|
||||
func('list?', [ int(_)|S], [bool(false)|S]).
|
||||
func('list?', [symbol(_)|S], [bool(false)|S]).
|
||||
|
||||
func('one-or-more?', [list([_|_])|S], [ bool(true)|S]).
|
||||
func('one-or-more?', [ list([])|S], [bool(false)|S]).
|
||||
|
||||
func(and, [bool(true), bool(true)|S], [ bool(true)|S]).
|
||||
func(and, [bool(true), bool(false)|S], [bool(false)|S]).
|
||||
func(and, [bool(false), bool(true)|S], [bool(false)|S]).
|
||||
func(and, [bool(false), bool(false)|S], [bool(false)|S]).
|
||||
|
||||
func(or, [bool(true), bool(true)|S], [ bool(true)|S]).
|
||||
func(or, [bool(true), bool(false)|S], [ bool(true)|S]).
|
||||
func(or, [bool(false), bool(true)|S], [ bool(true)|S]).
|
||||
func(or, [bool(false), bool(false)|S], [bool(false)|S]).
|
||||
|
||||
func( + , [int(A), int(B)|S], [int(A + B)|S]).
|
||||
func( - , [int(A), int(B)|S], [int(B - A)|S]).
|
||||
func( * , [int(A), int(B)|S], [int(A * B)|S]).
|
||||
func( / , [int(A), int(B)|S], [int(B div A)|S]).
|
||||
func('%', [int(A), int(B)|S], [int(B mod A)|S]).
|
||||
% func( + , [int(A), int(B)|S], [int(C)|S]) :- C #= A + B.
|
||||
% func( - , [int(A), int(B)|S], [int(C)|S]) :- C #= B - A.
|
||||
% func( * , [int(A), int(B)|S], [int(C)|S]) :- C #= A * B.
|
||||
% func( / , [int(A), int(B)|S], [int(C)|S]) :- C #= B div A.
|
||||
% func('%', [int(A), int(B)|S], [int(C)|S]) :- C #= B mod A.
|
||||
|
||||
func('/%', [int(A), int(B)|S], [int(B div A), int(B mod A)|S]).
|
||||
func( pm , [int(A), int(B)|S], [int(A + B), int(B - A)|S]).
|
||||
% func('/%', [int(A), int(B)|S], [int(C), int(D)|S]) :- C #= B div A, D #= B mod A.
|
||||
% func( pm , [int(A), int(B)|S], [int(C), int(D)|S]) :- C #= A + B, D #= B - A.
|
||||
|
||||
func(>, [int(A), int(B)|S], [ bool(B > A)|S]).
|
||||
func(<, [int(A), int(B)|S], [ bool(B < A)|S]).
|
||||
func(=, [int(A), int(B)|S], [ bool(eq(B, A))|S]).
|
||||
func(>=, [int(A), int(B)|S], [ bool(B >= A)|S]).
|
||||
func(<=, [int(A), int(B)|S], [ bool(B =< A)|S]).
|
||||
func(<>, [int(A), int(B)|S], [bool(neq(B, A))|S]).
|
||||
% func(>, [int(A), int(B)|S], [T|S]) :- B #> A #<==> R, r_truth(R, T).
|
||||
% func(<, [int(A), int(B)|S], [T|S]) :- B #< A #<==> R, r_truth(R, T).
|
||||
% func(=, [int(A), int(B)|S], [T|S]) :- B #= A #<==> R, r_truth(R, T).
|
||||
% func(>=, [int(A), int(B)|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T).
|
||||
% func(<=, [int(A), int(B)|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T).
|
||||
% func(<>, [int(A), int(B)|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T).
|
||||
|
||||
func(sqr) --> func(dup), func(mul). % Pretty neat.
|
||||
|
||||
r_truth(0, bool(false)).
|
||||
r_truth(1, bool(true)).
|
||||
|
||||
|
||||
/*
|
||||
|
||||
██████╗ ██████╗ ███╗ ███╗██████╗ ██╗███╗ ██╗ █████╗ ████████╗ ██████╗ ██████╗ ███████╗
|
||||
██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║████╗ ██║██╔══██╗╚══██╔══╝██╔═══██╗██╔══██╗██╔════╝
|
||||
██║ ██║ ██║██╔████╔██║██████╔╝██║██╔██╗ ██║███████║ ██║ ██║ ██║██████╔╝███████╗
|
||||
██║ ██║ ██║██║╚██╔╝██║██╔══██╗██║██║╚██╗██║██╔══██║ ██║ ██║ ██║██╔══██╗╚════██║
|
||||
╚██████╗╚██████╔╝██║ ╚═╝ ██║██████╔╝██║██║ ╚████║██║ ██║ ██║ ╚██████╔╝██║ ██║███████║
|
||||
╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚═════╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═╝╚══════╝
|
||||
|
||||
*/
|
||||
|
||||
combo(i, [list(P)|S], S, Ei, Eo) :- append(P, Ei, Eo).
|
||||
combo(dip, [list(P), X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo).
|
||||
combo(dipd, [list(P), X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo).
|
||||
|
||||
combo(dupdip, [list(P), X|S], [X|S], Ei, Eo) :- append(P, [X|Ei], Eo).
|
||||
|
||||
combo(branch, [list(T), list(_), bool(true)|S], S, Ei, Eo) :- append(T, Ei, Eo).
|
||||
combo(branch, [list(_), list(F), bool(false)|S], S, Ei, Eo) :- append(F, Ei, Eo).
|
||||
|
||||
combo(loop, [list(_), bool(false)|S], S, E, E ).
|
||||
combo(loop, [list(B), bool(true)|S], S, Ei, Eo) :- append(B, [list(B), symbol(loop)|Ei], Eo).
|
||||
|
||||
combo(step, [list(_), list([])|S], S, E, E ).
|
||||
combo(step, [list(P), list([X|Z])|S], [X|S], Ei, Eo) :- append(P, [list(Z), list(P), symbol(step)|Ei], Eo).
|
||||
|
||||
combo(times, [list(_), int(0)|S], S, E, E ).
|
||||
combo(times, [list(P), int(1)|S], S, Ei, Eo) :- append(P, Ei, Eo).
|
||||
combo(times, [list(P), int(N)|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [int(M), list(P), symbol(times)|Ei], Eo).
|
||||
combo(times, [list(_), int(N)|S], S, _, _ ) :- N #< 0, fail.
|
||||
|
||||
combo(genrec, [R1, R0, Then, If|S],
|
||||
[ Else, Then, If|S], E, [symbol(ifte)|E]) :-
|
||||
append(R0, [list([If, Then, R0, R1, symbol(genrec)])|R1], Else).
|
||||
|
||||
/*
|
||||
This is a crude but servicable implementation of the map combinator.
|
||||
|
||||
Obviously it would be nice to take advantage of the implied parallelism.
|
||||
Instead the quoted program, stack, and terms in the input list are
|
||||
transformed to simple Joy expressions that run the quoted program on
|
||||
prepared copies of the stack that each have one of the input terms on
|
||||
top. These expressions are collected in a list and the whole thing is
|
||||
evaluated (with infra) on an empty list, which becomes the output list.
|
||||
|
||||
The chief advantage of doing it this way (as opposed to using Prolog's
|
||||
map) is that the whole state remains in the pending expression, so
|
||||
there's nothing stashed in Prolog's call stack. This preserves the nice
|
||||
property that you can interrupt the Joy evaluation and save or transmit
|
||||
the stack+expression knowing that you have all the state.
|
||||
*/
|
||||
|
||||
combo(map, [list(_), list([])|S], [list([])|S], E, E ) :- !.
|
||||
combo(map, [list(P), list(List)|S], [list(Mapped), list([])|S], E, [symbol(infra)|E]) :-
|
||||
prepare_mapping(list(P), S, List, Mapped).
|
||||
|
||||
% Set up a program for each term in ListIn
|
||||
%
|
||||
% [term S] [P] infrst
|
||||
%
|
||||
% prepare_mapping(P, S, ListIn, ListOut).
|
||||
|
||||
prepare_mapping(Pl, S, In, Out) :- prepare_mapping(Pl, S, In, [], Out).
|
||||
|
||||
prepare_mapping( _, _, [], Out, Out) :- !.
|
||||
prepare_mapping( Pl, S, [T|In], Acc, Out) :-
|
||||
prepare_mapping(Pl, S, In, [list([T|S]), Pl, symbol(infrst)|Acc], Out).
|
||||
|
||||
|
||||
/*
|
||||
|
||||
██████╗ ███████╗███████╗██╗███╗ ██╗██╗████████╗██╗ ██████╗ ███╗ ██╗███████╗
|
||||
██╔══██╗██╔════╝██╔════╝██║████╗ ██║██║╚══██╔══╝██║██╔═══██╗████╗ ██║██╔════╝
|
||||
██║ ██║█████╗ █████╗ ██║██╔██╗ ██║██║ ██║ ██║██║ ██║██╔██╗ ██║███████╗
|
||||
██║ ██║██╔══╝ ██╔══╝ ██║██║╚██╗██║██║ ██║ ██║██║ ██║██║╚██╗██║╚════██║
|
||||
██████╔╝███████╗██║ ██║██║ ╚████║██║ ██║ ██║╚██████╔╝██║ ╚████║███████║
|
||||
╚═════╝ ╚══════╝╚═╝ ╚═╝╚═╝ ╚═══╝╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚══════╝
|
||||
|
||||
*/
|
||||
|
||||
joy_def(Codes) :-
|
||||
text_to_expression(Codes, [symbol(Name)|Body]),
|
||||
% writeln(Name),
|
||||
assert_def(Name, Body).
|
||||
|
||||
assert_defs(DefsFile) :-
|
||||
read_file_to_codes(DefsFile, Codes, []),
|
||||
lines(Codes, Lines),
|
||||
maplist(joy_def, Lines).
|
||||
|
||||
assert_def(Symbol, Body) :-
|
||||
( % Don't let this "shadow" functions or combinators.
|
||||
\+ func(Symbol, _, _),
|
||||
\+ combo(Symbol, _, _, _, _)
|
||||
) -> ( % Replace any existing defs of this name.
|
||||
retractall(def(Symbol, _)),
|
||||
assertz(def(Symbol, Body))
|
||||
) ; true.
|
||||
|
||||
% Split on newline chars a list of codes into a list of lists of codes
|
||||
% one per line. Helper function.
|
||||
lines([], []) :- !.
|
||||
lines(Codes, [Line|Lines]) :- append(Line, [0'\n|Rest], Codes), !, lines(Rest, Lines).
|
||||
lines(Codes, [Codes]).
|
||||
|
||||
:- assert_defs("defs.txt").
|
||||
|
||||
|
||||
% A meta function that finds the names of all available functions.
|
||||
|
||||
words(Words) :-
|
||||
findall(Name, clause(func(Name, _, _), _), Funcs),
|
||||
findall(Name, clause(combo(Name, _, _, _, _), _), Combos, Funcs),
|
||||
findall(Name, clause(def(Name, _), _), Words0, Combos),
|
||||
list_to_set(Words0, Words1),
|
||||
sort(Words1, Words).
|
||||
|
||||
|
||||
/*
|
||||
|
||||
██████╗ ██████╗ ███╗ ███╗██████╗ ██╗██╗ ███████╗██████╗
|
||||
██╔════╝██╔═══██╗████╗ ████║██╔══██╗██║██║ ██╔════╝██╔══██╗
|
||||
██║ ██║ ██║██╔████╔██║██████╔╝██║██║ █████╗ ██████╔╝
|
||||
██║ ██║ ██║██║╚██╔╝██║██╔═══╝ ██║██║ ██╔══╝ ██╔══██╗
|
||||
╚██████╗╚██████╔╝██║ ╚═╝ ██║██║ ██║███████╗███████╗██║ ██║
|
||||
╚═════╝ ╚═════╝ ╚═╝ ╚═╝╚═╝ ╚═╝╚══════╝╚══════╝╚═╝ ╚═╝
|
||||
_ ___ _ _
|
||||
| |_ ___ | _ \_ _| |_| |_ ___ _ _
|
||||
| _/ _ \ | _/ || | _| ' \/ _ \ ' \
|
||||
\__\___/ |_| \_, |\__|_||_\___/_||_|
|
||||
|__/
|
||||
|
||||
|
||||
We have a tabulator predicate.
|
||||
|
||||
*/
|
||||
|
||||
tabs(N) --> { N #> 0, M #= N - 1 },
|
||||
tab, tabs(M).
|
||||
|
||||
tabs(0) --> [].
|
||||
|
||||
nl --> "\n".
|
||||
|
||||
tab --> " ".
|
||||
|
||||
|
||||
/*
|
||||
|
||||
Convert Prolog terms to Python source.
|
||||
|
||||
*/
|
||||
|
||||
% stack_to_python(F) --> { writeln(F), fail }.
|
||||
|
||||
stack_to_python(S) --> {atom(S), !, atom_codes(S, C)}, C.
|
||||
stack_to_python([]) --> "stack", !.
|
||||
stack_to_python([Term|Tail]) -->
|
||||
"(", term_to_python(Term), ", ", stack_to_python(Tail), ")".
|
||||
|
||||
|
||||
% Unify unbound terms with fresh Python identifiers.
|
||||
pyvar(Prefix, Term, Codes) :-
|
||||
( var(Term) -> gensym(Prefix, Term) ; atom(Term) ),
|
||||
atom_codes(Term, Codes).
|
||||
|
||||
term_to_python(Term) -->
|
||||
{ pyvar(v, Term, Var) }, !, Var.
|
||||
|
||||
term_to_python(bool(Term)) --> term_to_python(Term).
|
||||
|
||||
term_to_python(int(Term)) -->
|
||||
{ ( integer(Term) ->
|
||||
number_codes(Term, Int)
|
||||
;
|
||||
pyvar(i, Term, Int)
|
||||
)
|
||||
},
|
||||
Int.
|
||||
|
||||
term_to_python(list(Term)) --> list_to_python(Term).
|
||||
|
||||
term_to_python(Term) --> Term.
|
||||
|
||||
|
||||
list_to_python(Term) -->
|
||||
{ pyvar(s, Term, Var) }, !, Var.
|
||||
|
||||
list_to_python([]) --> "()", !.
|
||||
|
||||
list_to_python([Term|Tail]) -->
|
||||
"(", term_to_python(Term), ", ", list_to_python(Tail), ")".
|
||||
|
||||
|
||||
|
||||
/*
|
||||
|
||||
Generate Python code.
|
||||
|
||||
*/
|
||||
|
||||
|
||||
code_gen([Head|Tail]) --> Head, code_gen(Tail).
|
||||
code_gen([]) --> [].
|
||||
|
||||
cg, Term --> [Term], cg.
|
||||
cg --> [].
|
||||
|
||||
compile_fn(Name) --> gronk_fn(Name), cg, !.
|
||||
|
||||
|
||||
|
||||
|
||||
/*
|
||||
|
||||
|
||||
██████╗ ██████╗ ██████╗ ███╗ ██╗██╗ ██╗
|
||||
██╔════╝ ██╔══██╗██╔═══██╗████╗ ██║██║ ██╔╝
|
||||
██║ ███╗██████╔╝██║ ██║██╔██╗ ██║█████╔╝
|
||||
██║ ██║██╔══██╗██║ ██║██║╚██╗██║██╔═██╗
|
||||
╚██████╔╝██║ ██║╚██████╔╝██║ ╚████║██║ ██╗
|
||||
╚═════╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝╚═╝ ╚═╝
|
||||
|
||||
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("").
|
||||
@@ -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;
|
||||
}
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 172 KiB |
@@ -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
|
||||
@@ -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.
|
||||
@@ -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
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
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)
|
||||
]
|
||||
|
||||
|
||||
*/
|
||||
@@ -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...
|
||||
Reference in New Issue
Block a user