sforman/Thun
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Bring in the Prolog impl.

Browse Source
This commit is contained in:
Simon Forman
2022-01-15 17:23:11 -08:00
parent 564417c985
commit 839b376d73
60 changed files with 19083 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
implementations/Prolog/source/agl.PNG
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 62 KiB

implementations/Prolog/source/b-joy.pl
+228
View File
@@ -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 = "[[]]".
*/
implementations/Prolog/source/bleah.code-workspace
+14
View File
@@ -0,0 +1,14 @@
{
"folders": [
{
"path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\Thun"
},
{
"path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\yrad-nettles"
},
{
"path": "C:\\Users\\sforman\\Desktop\\src\\PROLOG\\prolog-markdown"
}
],
"settings": {}
}
implementations/Prolog/source/canhazmd.pl
+45
View File
@@ -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(..., ...)|...])])].
*/
implementations/Prolog/source/client/elm.json
+24
View File
@@ -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": {}
}
}
implementations/Prolog/source/client/index.html
+6127
View File
File diff suppressed because it is too large Load Diff
implementations/Prolog/source/client/src/Main.elm
+116
View File
@@ -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
implementations/Prolog/source/defs.txt
+115
View File
@@ -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
implementations/Prolog/source/derp.pl
+130
View File
@@ -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.
implementations/Prolog/source/derp.py
+40
View File
@@ -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
implementations/Prolog/source/fuuu.pl
+527
View File
@@ -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`).
*/
implementations/Prolog/source/gen-defs+funcs.pl
+759
View File
@@ -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).
implementations/Prolog/source/gen-defs.pl
+320
View File
@@ -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).
implementations/Prolog/source/gen-funcs.pl
+462
View File
@@ -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).
implementations/Prolog/source/joy2dot.pl
+153
View File
@@ -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("}").
implementations/Prolog/source/joy2py.pl
+919
View File
@@ -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("").
implementations/Prolog/source/joy_defs.dot
+46
View File
@@ -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;
}
implementations/Prolog/source/joy_defs.png
BIN
View File
Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 172 KiB

implementations/Prolog/source/more-notes.txt
+114
View File
@@ -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
implementations/Prolog/source/nerdsniped.txt
+62
View File
@@ -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.
implementations/Prolog/source/notes.txt
+317
View File
@@ -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
implementations/Prolog/source/thun.pl
+2817
View File
File diff suppressed because it is too large Load Diff
implementations/Prolog/source/thun_compile.pl
+295
View File
@@ -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)
]
*/