changeset 8d4026862f43 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=8d4026862f43 user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 20:12:41 2019 -0700 description: Bring in funcs and combos. changeset 1cbd3947c64b in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=1cbd3947c64b user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 20:42:48 2019 -0700 description: map combo changeset 8b7fb8c0afe1 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=8b7fb8c0afe1 user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 20:57:11 2019 -0700 description: Move parser to own file. changeset f058187b94aa in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=f058187b94aa user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 21:45:59 2019 -0700 description: build defs.pl changeset 50eca9a018db in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=50eca9a018db user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 21:46:48 2019 -0700 description: build defs.pl changeset 541a67d69c9a in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=541a67d69c9a user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 22:03:44 2019 -0700 description: Build defs.pl from defs.txt. diffstat: thun/gnu-prolog/Makefile | 6 +- thun/gnu-prolog/defs.pl | 71 +++++++++++++++++++++ thun/gnu-prolog/defs.txt | 5 +- thun/gnu-prolog/meta-defs.pl | 42 ++++++++++++ thun/gnu-prolog/parser.pl | 72 +++++++++++++++++++++ thun/gnu-prolog/thun.pl | 141 ++++++++++++++++++++++++++++-------------- 6 files changed, 283 insertions(+), 54 deletions(-) diffs (truncated from 416 to 300 lines): diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/Makefile --- a/thun/gnu-prolog/Makefile Sat Aug 10 20:06:12 2019 -0700 +++ b/thun/gnu-prolog/Makefile Sat Aug 10 22:03:44 2019 -0700 @@ -1,6 +1,8 @@ GPLC_OPTIONS="--min-size" -thun: thun.pl - gplc $(GPLC_OPTIONS) -o thun thun.pl +thun: thun.pl parser.pl defs.pl + gplc $(GPLC_OPTIONS) -o thun thun.pl parser.pl defs.pl +defs.pl: meta-defs.pl parser.pl defs.txt + gprolog --consult-file meta-defs.pl --consult-file parser.pl --query-goal do diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/defs.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/defs.pl Sat Aug 10 22:03:44 2019 -0700 @@ -0,0 +1,71 @@ +def(--,[1,-]). +def(?,[dup,bool]). +def(++,[1,+]). +def(anamorphism,[[pop,[]],swap,[dip,swons],genrec]). +def(app1,[grba,infrst]). +def(app2,[[grba,swap,grba,swap],dip,[infrst],cons,ii]). +def(app3,[3,appN]). +def(appN,[[grabN],cons,dip,map,disenstacken]). +def(at,[drop,first]). +def(b,[[i],dip,i]). +def(binary,[unary,popd]). +def(ccons,[cons,cons]). +def(cleave,[fork,popdd]). +def(clop,[cleave,popdd]). +def(codireco,[cons,dip,rest,cons]). +def(dinfrirst,[dip,infrst]). +def(disenstacken,[?,[uncons,?],loop,pop]). +def(down_to_zero,[[0,>],[dup,--],while]). +def(drop,[[rest],times]). +def(dupd,[[dup],dip]). +def(dupdd,[[dup],dipd]). +def(dupdipd,[dup,dipd]). +def(enstacken,[stack,[clear],dip]). +def(flatten,[[],swap,[concat],step]). +def(fork,[[i],app2]). +def(fourth,[rest,third]). +def(gcd,[true,[tuck,mod,dup,0,>],loop,pop]). +def(grabN,[[],swap,[cons],times]). +def(grba,[[stack,popd],dip]). +def(hypot,[[sqr],ii,+,sqrt]). +def(ifte,[[nullary],dipd,swap,branch]). +def(ii,[[dip],dupdip,i]). +def(infra,[swons,swaack,[i],dip,swaack]). +def(infrst,[infra,first]). +def(make_generator,[[codireco],ccons]). +def(neg,[0,swap,-]). +def(nullary,[[stack],dinfrirst]). +def(of,[swap,at]). +def(pam,[[i],map]). +def(pm,[[+],[-],clop]). +def(popd,[[pop],dip]). +def(popdd,[[pop],dipd]). +def(popop,[pop,pop]). +def(popopd,[[popop],dip]). +def(popopdd,[[popop],dipd]). +def(primrec,[[i],genrec]). +def(product,[1,swap,[*],step]). +def(quoted,[[unit],dip]). +def(range,[[0,<=],[1,-,dup],anamorphism]). +def(range_to_zero,[unit,[down_to_zero],infra]). +def(reverse,[[],swap,shunt]). +def(rrest,[rest,rest]). +def(run,[[],swap,infra]). +def(second,[rest,first]). +def(shift,[uncons,[swons],dip]). +def(shunt,[[swons],step]). +def(size,[0,swap,[pop,++],step]). +def(split_at,[[drop],[take],clop]). +def(sqr,[dup,*]). +def(step_zero,[0,rollup,step]). +def(sum,[0,swap,[+],step]). +def(swons,[swap,cons]). +def(take,[[],rolldown,[shift],times,pop]). +def(ternary,[binary,popd]). +def(third,[rest,second]). +def(unary,[nullary,popd]). +def(unit,[[],cons]). +def(unquoted,[[i],dip]). +def(unswons,[uncons,swap]). +def(while,[swap,[nullary],cons,dup,dipd,concat,loop]). +def(x,[dup,i]). diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/defs.txt --- a/thun/gnu-prolog/defs.txt Sat Aug 10 20:06:12 2019 -0700 +++ b/thun/gnu-prolog/defs.txt Sat Aug 10 22:03:44 2019 -0700 @@ -7,7 +7,6 @@ app3 == 3 appN appN == [grabN] cons dip map disenstacken at == drop first -average == [sum 1.0 *] [size] cleave / b == [i] dip i binary == unary popd ccons == cons cons @@ -58,7 +57,7 @@ size == 0 swap [pop ++] step split_at == [drop] [take] clop sqr == dup * -step_zero == 0 roll> step +step_zero == 0 rollup step sum == 0 swap [+] step swons == swap cons take == [] rolldown [shift] times pop @@ -69,4 +68,4 @@ unquoted == [i] dip unswons == uncons swap while == swap [nullary] cons dup dipd concat loop -x == dup i \ No newline at end of file +x == dup i diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/meta-defs.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/meta-defs.pl Sat Aug 10 22:03:44 2019 -0700 @@ -0,0 +1,42 @@ +/* +Definitions +*/ + +do :- assert_defs(`defs.txt`), print_defs, halt. + +joy_def(def(Def, Body)) --> symbol(Def), blanks, "==", joy_parse(Body). + +joy_defs --> blanks, joy_def(Def), {assert_def(Def)}, blanks, joy_defs. +joy_defs --> []. + +assert_defs(DefsFile) :- + read_file_to_codes(DefsFile, Codes, []), + phrase(joy_defs, Codes). + +assert_def(def(Def, Body)) :- + retractall(def(Def, _)), + assertz(def(Def, Body)). + + + +read_file_to_codes(File, Codes, _) :- + open(File, read, Stream), + stream_to_codes(Stream, Codes), + close(Stream). + + +stream_to_codes(Stream, Codes) :- + get_code(Stream, Code), + stream_to_codes(Code, Stream, Codes). + +stream_to_codes(-1, _, []) :- !. +stream_to_codes(Ch, Stream, [Ch|Codes]) :- stream_to_codes(Stream, Codes). + +print_defs :- + findall(def(Name, Body), def(Name, Body), List), + open(`defs.pl`, write, Stream), + maplist(print_def(Stream), List), + close(Stream). + +print_def(Stream, Def) :- write(Stream, Def), write(Stream, `.`), nl(Stream). + diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/parser.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/parser.pl Sat Aug 10 22:03:44 2019 -0700 @@ -0,0 +1,72 @@ +/* + Copyright 2018, 2019 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/>. + + +Parser + +*/ + +:- set_prolog_flag(double_quotes, codes). + +joy_parse([T|J]) --> blanks, joy_term(T), blanks, joy_parse(J). +joy_parse([]) --> []. + +joy_term(N) --> num(N), !. +joy_term(J) --> "[", !, joy_parse(J), "]". +joy_term(C) --> symbol(C). + +symbol(C) --> chars(Chars), !, {Chars \= [61, 61], atom_codes(C, Chars)}. + + + +% Line is the next new-line delimited line from standard input stream as +% a list of character codes. + +line(Line) :- get_code(X), line(X, Line). + +line(10, []) :- !. % break on new-lines. +line(-1, [eof]) :- !. % break on EOF +line(X, [X|Line]) :- get_code(Y), !, line(Y, Line). + + +chars([Ch|Rest]) --> char(Ch), chars(Rest). +chars([Ch]) --> char(Ch). + +char(Ch) --> [Ch], { Ch \== 0'[, Ch \== 0'], Ch >= 33, Ch =< 126 }. + + +blanks --> blank, !, blanks. +blanks --> []. + +blank --> [32] | [13] | [10]. + + +% TODO: negative numbers, floats, scientific notation. + +num(N) --> digits(Codes), !, { num(N, Codes) }. + +num(_, []) :- fail, !. +num(N, [C|Codes]) :- number_codes(N, [C|Codes]). + + +digits([H|T]) --> digit(H), !, digits(T). +digits([]) --> []. + +digit(C) --> [C], { nonvar(C), C =< 57, C >= 48 }. + + diff -r a71525e87b9b -r 541a67d69c9a thun/gnu-prolog/thun.pl --- a/thun/gnu-prolog/thun.pl Sat Aug 10 20:06:12 2019 -0700 +++ b/thun/gnu-prolog/thun.pl Sat Aug 10 22:03:44 2019 -0700 @@ -17,8 +17,9 @@ along with Thun. If not see <http://www.gnu.org/licenses/>. */ -:- dynamic(func/3). -:- discontiguous(func/3). +% :- dynamic(func/3). +% :- discontiguous(func/3). + :- initialization(loop). @@ -84,6 +85,35 @@ func(swap, [A, B|S], [B, A|S]). func(dup, [A|S], [A, A|S]). func(pop, [_|S], S ). +func(sqrt, [A|S], [sqrt(A)|S]). + +func(concat, [A, B|S], [C|S]) :- append(B, A, C). +func(flatten, [A|S], [B|S]) :- flatten(A, B). +func(swaack, [R|S], [S|R]). +func(stack, S , [S|S]). +func(clear, _ , []). +func(first, [[X|_]|S], [X|S]). +func(rest, [[_|X]|S], [X|S]). +func(unit, [X|S], [[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, [[B|A], C|D], [A, [B|C]|D]). + +func(rollup, Si, So) :- func(rolldown, So, Si). +func(uncons, Si, So) :- func(cons, So, Si). + +func(bool, [ 0|S], [false|S]) :- !. +func(bool, [ 0.0|S], [false|S]) :- !. +func(bool, [ []|S], [false|S]) :- !. +func(bool, [ ""|S], [false|S]) :- !. +func(bool, [false|S], [false|S]) :- !. + +func(bool, [_|S], [true|S]). + /* @@ -95,26 +125,75 @@ combo(dipd, [P, X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo). combo(dupdip, [P, X|S], [X|S], Ei, Eo) :- append(P, [X|Ei], Eo). +combo(dupdip, [P, X|S], [X|S], Ei, Eo) :- append(P, [X|Ei], Eo). +combo(branch, [T, _, true|S], S, Ei, Eo) :- append(T, Ei, Eo). +combo(branch, [_, F, false|S], S, Ei, Eo) :- append(F, Ei, Eo). +combo(branch, [T, F, Expr|S], S, Ei, Eo) :- + \+ Expr = true, \+ Expr = false, + catch( % Try Expr and do one or the other,
Fork