From f7d24aff5dac10e57ee386a90d8a516db4b4841a Mon Sep 17 00:00:00 2001 From: notoria Date: Fri, 3 Jul 2020 16:52:13 +0200 Subject: [PATCH] Finished the port of thun.pl --- src/examples/joy/defs.txt | 73 +++++++++++++++++++ src/{prolog/examples => examples/joy}/thun.pl | 64 ++++++++++------ src/prolog/examples/defs.txt | 9 --- 3 files changed, 116 insertions(+), 30 deletions(-) create mode 100644 src/examples/joy/defs.txt rename src/{prolog/examples => examples/joy}/thun.pl (97%) delete mode 100644 src/prolog/examples/defs.txt diff --git a/src/examples/joy/defs.txt b/src/examples/joy/defs.txt new file mode 100644 index 00000000..bbdda91b --- /dev/null +++ b/src/examples/joy/defs.txt @@ -0,0 +1,73 @@ +-- 1 - +? dup bool +++ 1 + +anamorphism [pop []] swap [dip swons] genrec +app1 grba infrst +app2 [grba swap grba swap] dip [infrst] cons ii +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 +cleave fork popdd +clop cleave popdd +codireco cons dip rest cons +dinfrirst dip infrst +disenstacken ? [uncons ?] loop pop +down_to_zero [0 >] [dup --] while +drop [rest] times +dupd [dup] dip +dupdd [dup] dipd +dupdipd dup dipd +enstacken stack [clear] dip +flatten [] swap [concat] step +fork [i] app2 +fourth rest third +gcd true [tuck mod dup 0 >] loop pop +grabN [] swap [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 +neg 0 swap - +not [true] [false] branch +nullary [stack] dinfrirst +of swap at +pam [i] map +pm [+] [-] clop +popd [pop] dip +popdd [pop] dipd +popop pop pop +popopd [popop] dip +popopdd [popop] dipd +primrec [i] genrec +product 1 swap [*] step +quoted [unit] dip +range [0 <=] [1 - dup] anamorphism +range_to_zero unit [down_to_zero] infra +reverse [] swap shunt +rrest rest rest +run [] swap infra +second rest first +shift uncons [swons] dip +shunt [swons] step +size 0 swap [pop ++] step +split_at [drop] [take] clop +sqr dup * +step_zero 0 roll> step +sum 0 swap [+] step +swons swap cons +take [] rolldown [shift] times pop +ternary binary popd +third rest second +unary nullary popd +unit [] cons +unquoted [i] dip +unswons uncons swap +while swap [nullary] cons dup dipd concat loop +x dup i diff --git a/src/prolog/examples/thun.pl b/src/examples/joy/thun.pl similarity index 97% rename from src/prolog/examples/thun.pl rename to src/examples/joy/thun.pl index 1442b6e8..4c725a76 100644 --- a/src/prolog/examples/thun.pl +++ b/src/examples/joy/thun.pl @@ -43,17 +43,26 @@ Table of Contents */ +%:- use_module(library(debug)). +:- use_module(library(assoc), [assoc_to_list/2, del_assoc/4, empty_assoc/1, put_assoc/4]). +:- use_module(library(atts), [call_residue_vars/2]). +:- use_module(library(charsio), [char_type/2]). :- use_module(library(clpz)). :- use_module(library(dcgs)). - -:- use_module(library(lists), [append/3, list_to_set /2, maplist/2, member/2, select/3]). -:- use_module(library(assoc), [assoc_to_list/2, del_assoc/4, empty_assoc/1, put_assoc/4]). -:- use_module(library(format), [format/2, format_/2, portray_clause/1]). +:- use_module(library(format), [format/2, portray_clause/1]). +:- use_module(library(lists), [append/3, list_to_set/2, maplist/2, member/2, select/3]). :- use_module(library(pio), [phrase_from_file/2]). +:- dynamic(combo/5). :- dynamic(func/3). :- dynamic(def/2). +retractall(What) :- + ( \+ \+ retract(What) -> + retractall(What) + ; true + ). + /* An entry point. */ @@ -116,24 +125,30 @@ atoms, and list literals to Prolog lists. */ -joy_parse([J|Js]) --> {write("blanks")},blanks, joy_term(J), blanks, joy_parse(Js). +joy_parse([J|Js]) --> blanks, joy_term(J), blanks, joy_parse(Js). joy_parse([]) --> []. -joy_term(J) --> {write("list")},"[", !, joy_parse(X), "]". -% joy_term(X) --> {write("int")},N, { number_chars(N, I) }, !. -joy_term(true) --> "true", !. -joy_term(false) --> "false", !. -joy_term(X) --> {write("symbol")}, symbol(S). +joy_term(int(I)) --> integer(Ds), !, { number_chars(I, Ds) }. +joy_term(list(J)) --> "[", !, joy_parse(J), "]". +joy_term(bool(true)) --> "true", !. +joy_term(bool(false)) --> "false", !. +joy_term(symbol(S)) --> symbol(S). -symbol(C) --> chars(Chars), !, {write("got char"),C = Chars}. +symbol(A) --> chars(Cs), !, { atom_chars(A, Cs) }. -chars([Ch|Rest]) --> {write("X"),portray_clause(Ch)}, char(Ch), {write("Y"),portray_clause(Ch)}, chars(Rest). -chars([Ch]) --> {write("Z"),portray_clause(Ch)}, char(Ch). +blanks --> [C], { char_type(C, whitespace) }, (blanks | call(eos)), !. +blanks --> []. -char(Ch) --> [Ch], {format("Ch = |~w|~n", [Ch]), Ch \== '[', Ch \== ']', format("Ch is not or ~n", []), format("Ch is graphic~n", [])}. +integer([D|Ds]) --> digit(D), integer(Ds). +integer([D]) --> digit(D). + +digit(D) --> [D], { char_type(D, decimal_digit) }. + +chars([C|Cs]) --> char(C), chars(Cs). +chars([C]) --> char(C). + +char(C) --> [C], { C \== '[', C \== ']', char_type(C, ascii_graphic) }. -blanks --> [C], { format("is whitespace~n", []), C == ' ', format("is not whitespace~n", [])}, (blanks | call(eos)), !. -blanks --> []. /* Here is an example of Joy code: @@ -253,8 +268,7 @@ thun(symbol(Unknown), _, _, _) :- \+ def(Unknown, _), \+ func(Unknown, _, _), \+ combo(Unknown, _, _, _, _), - write("Unknown: "), - writeln(Unknown), + format("Unknown: ~q\n", [Unknown]), fail. /* @@ -268,6 +282,14 @@ thun(symbol(Unknown), _, _, _) :- */ +is_list(X) :- var(X), !, false. +is_list([]). +is_list([_|Ls]) :- is_list(Ls). + +flatten([]) --> [], !. +flatten([A|T]) --> { \+ is_list(A) }, [A], !, flatten(T). +flatten([A|T]) --> flatten(A), flatten(T). + func(words, S, [Words|S]) :- words(Words). func(swap, [A, B|S], [B, A|S]). @@ -276,7 +298,7 @@ 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(flatten, [list(A)|S], [list(B)|S]) :- phrase(flatten(B), A). func(swaack, [list(R)|S], [list(S)|R]). func(stack, S , [list(S)|S]). func(clear, _ , []). @@ -781,7 +803,7 @@ reggy(FreePool, References, ValueMap) encode_list(List, FP, FP, Addr) --> [], {addr(list(List))=Addr}. -get_reggy([], _, _) :- writeln('Out of Registers'), fail. +get_reggy([], _, _) :- format("Out of Registers\n", []), fail. get_reggy([Reg|FreePool], Reg, FreePool). get_reg(Reg, reggy(FreePool0, References, V), reggy(FreePool, [Reg|References], V)) --> [], @@ -866,7 +888,7 @@ func_compile(pop, E, [A|S], So, FP0, FP) --> !, free_reg(A, FP0, FP1), thun_compile(E, S, So, FP1, FP). -func_compile(cons, E, [List, Item|S], So, FP0, FP) --> !, +func_compile(cons, E, [_List, _Item|S], So, FP0, FP) --> !, % allocate a cons cell % https://mitpress.mit.edu/sites/default/files/sicp/full-text/book/book-Z-H-33.html#%_sec_5.3 thun_compile(E, S, So, FP0, FP). diff --git a/src/prolog/examples/defs.txt b/src/prolog/examples/defs.txt deleted file mode 100644 index 8d4e61b1..00000000 --- a/src/prolog/examples/defs.txt +++ /dev/null @@ -1,9 +0,0 @@ -[ [[abs] ii <=] - [ - [<>] [pop !-] || - ] && - ] - [[ !-] [[++]] [[--]] ifte dip] - [[pop !-] [--] [++] ifte ] - ifte - -- 2.54.0