From a33bb8cdaaf36c7a0c3c38360ecd764442a483b1 Mon Sep 17 00:00:00 2001 From: Simon Forman Date: Fri, 17 Feb 2023 13:56:37 -0800 Subject: [PATCH] eval_joy_ast --- implementations/SWIProlog/Makefile | 6 + implementations/SWIProlog/bigints.joyast | 1 + implementations/SWIProlog/blanks.py | 33 ++++ implementations/SWIProlog/eval_joy_ast.prolog | 124 +++++++++++++ implementations/SWIProlog/joy_to_ast.prolog | 86 +++++++++ implementations/SWIProlog/parser.prolog | 171 ++++++++++++++++++ 6 files changed, 421 insertions(+) create mode 100644 implementations/SWIProlog/Makefile create mode 100644 implementations/SWIProlog/bigints.joyast create mode 100644 implementations/SWIProlog/blanks.py create mode 100644 implementations/SWIProlog/eval_joy_ast.prolog create mode 100644 implementations/SWIProlog/joy_to_ast.prolog create mode 100644 implementations/SWIProlog/parser.prolog diff --git a/implementations/SWIProlog/Makefile b/implementations/SWIProlog/Makefile new file mode 100644 index 0000000..1e3525c --- /dev/null +++ b/implementations/SWIProlog/Makefile @@ -0,0 +1,6 @@ +joy_to_ast: joy_to_ast.prolog + swipl --goal=main --stand_alone=true -o joy_to_ast -c joy_to_ast.prolog + +eval_joy_ast: eval_joy_ast.prolog + swipl --goal=main --stand_alone=true -o eval_joy_ast -c eval_joy_ast.prolog + diff --git a/implementations/SWIProlog/bigints.joyast b/implementations/SWIProlog/bigints.joyast new file mode 100644 index 0000000..84cc3e1 --- /dev/null +++ b/implementations/SWIProlog/bigints.joyast @@ -0,0 +1 @@ +[symbol(clear),list([symbol(base),int(2147483648)]),list([symbol('ditch-empty-list'),list([symbol(bool)]),list([symbol(popd)]),list([symbol(pop)]),symbol(ifte)]),list([symbol('bool-to-int'),list([int(0)]),list([int(1)]),symbol(branch)]),list([symbol('uncons-two'),list([symbol(uncons)]),symbol(ii),symbol(swapd)]),list([symbol(sandwich),symbol(swap),list([symbol(cons)]),symbol(dip),symbol(swoncat)]),list([symbol('build-list'),list([symbol(i),symbol(cons)]),symbol(genrec)]),list([symbol(digitalize),list([int(0),symbol(<=)]),list([symbol(pop),list([])]),list([symbol(base),symbol(divmod),symbol(swap)]),symbol('build-list')]),list([symbol('to-bigint'),list([symbol('!-')]),list([symbol(abs),symbol(digitalize)]),symbol(cleave),symbol(cons)]),list([symbol('from-bigint'),symbol('sign-int'),symbol('neg-if-necessary')]),list([symbol('sign-int'),list([symbol(first)]),list([symbol(prep),symbol('from-bigint\'')]),symbol(cleave)]),list([symbol('neg-if-necessary'),symbol(swap),list([symbol(neg)]),list([]),symbol(branch)]),list([symbol(prep),symbol(rest),int(1),int(0),symbol(rolldown)]),list([symbol('from-bigint\''),list([symbol('next-digit')]),symbol(step),symbol(popd)]),list([symbol('next-digit'),list([symbol('increase-power')]),list([symbol('accumulate-digit')]),symbol(clop),symbol(popdd)]),list([symbol('increase-power'),symbol(popop),symbol(base),symbol(*)]),list([symbol('accumulate-digit'),symbol(rolldown),symbol(*),symbol(+)]),list([symbol('neg-bigint'),list([symbol(not)]),symbol(infra)]),list([symbol('add-with-carry'),symbol('_add-with-carry0'),symbol('_add-with-carry1')]),list([symbol('_add-with-carry0'),list([symbol('bool-to-int')]),symbol(dipd),symbol(+),symbol(+)]),list([symbol('_add-with-carry1'),symbol(base),list([symbol(mod)]),list([symbol(>=)]),symbol(clop)]),list([symbol('add-carry-to-digits'),list([symbol(pop),symbol(not)]),list([symbol(popd)]),list([symbol('_actd_R0')]),symbol('build-list')]),list([symbol('_actd_R0'),list([symbol(bool)]),list([symbol('_actd_R0.then')]),list([symbol('_actd_R0.else')]),symbol(ifte)]),list([symbol('_actd_R0.else'),symbol(popd),int(1),symbol(false),symbol(rolldown)]),list([symbol('_actd_R0.then'),int(0),symbol(swap),symbol(uncons),list([symbol('add-with-carry')]),symbol(dip)]),list([symbol('add-digits'),symbol('initial-carry'),symbol('add-digits\'')]),list([symbol('initial-carry'),symbol(false),symbol(rollup)]),list([symbol('same-sign'),list([symbol(first)]),symbol(ii),symbol('_\\/_'),symbol(not)]),list([symbol('extract-sign'),list([symbol(uncons)]),symbol(dip),symbol(rest)]),list([symbol('add-like-bigints'),symbol('extract-sign'),symbol('add-digits'),symbol(cons)]),list([symbol('add-bigints'),list([symbol('same-sign')]),list([symbol('add-like-bigints')]),list([symbol('neg-bigint'),symbol('sub-like-bigints')]),symbol(ifte)]),list([symbol('build-two-list-combiner'),symbol('_btlc0'),symbol('_btlc1'),list([symbol('build-list')]),symbol(ccons),symbol(cons)]),list([symbol('_btlc0.0'),list([list([symbol('ditch-empty-list')]),symbol(swoncat)]),symbol(dip)]),list([symbol('_btlc0.1'),list([symbol(pop)]),symbol(swoncat)]),list([symbol('_btlc0.3'),list([symbol('_btlc0.0'),symbol('_btlc0.1')]),symbol(dip)]),list([symbol('_btlc0.4'),list([symbol('uncons-two')]),list([symbol(dipd)]),symbol(sandwich)]),list([symbol('_btlc0'),symbol('_btlc0.3'),symbol('_btlc0.4')]),list([symbol('_btlc1'),list([list([symbol(ifte)]),symbol(ccons),list([symbol('P\'')]),symbol(swons),list([symbol('P')]),symbol(swap)]),symbol(dip)]),list([symbol('P'),list([symbol(bool)]),symbol(ii),symbol(/\),symbol(not)]),list([symbol('P\''),list([symbol(bool)]),symbol(ii),symbol(\/)]),list([symbol(carry),list([]),list([int(1),symbol(swons)]),symbol(branch)]),list([symbol('compare-pairs'),list([symbol(bool),symbol(not)]),list([symbol(pop),symbol(false)]),list([symbol('_comp-pairs0')]),list([symbol('_comp-pairs1')]),symbol(genrec)]),list([symbol('_comp-pairs0'),list([symbol(first),list([symbol(>=)]),symbol(infrst)]),list([symbol(pop),symbol(true)])]),list([symbol('_comp-pairs1'),list([symbol(rest)]),symbol(swoncat),symbol(ifte)]),list([symbol('check-gt'),list([symbol('gt-bigint')]),list([symbol(swap),list([symbol(not)]),symbol(dipd)]),list([]),symbol(ifte)]),list([symbol('gt-bigint'),symbol('<<{}'),list([symbol('_gtb_P')]),list([symbol('_gtb_BASE')]),list([symbol('_gtb_R1')]),symbol(tailrec)]),list([symbol('_gtb_R1'),symbol('uncons-two'),list([symbol(unit),symbol(cons),symbol(swons)]),symbol(dipd)]),list([symbol('_gtb_P'),list([symbol(bool)]),symbol(ii),symbol(/\),symbol(not)]),list([symbol('_gtb_BASE'),list([symbol(bool)]),list([symbol(popop),symbol(pop),symbol(true)]),list([symbol('_gtb_BASE\'')]),symbol(ifte)]),list([symbol('_gtb_BASE\''),list([symbol(pop),symbol(bool)]),list([symbol(popop),symbol(pop),symbol(false)]),list([symbol(popop),symbol('compare-pairs')]),symbol(ifte)]),list([symbol('sub-carry-from-digits'),list([symbol(pop),symbol(not)]),list([symbol(popd)]),list([symbol('_scfd_R0')]),list([symbol(i),symbol('cons-but-not-leading-zeroes')]),symbol(genrec)]),list([symbol('_scfd_R0'),symbol(uncons),int(0),symbol(swap),list([symbol('sub-with-carry')]),symbol(dip)]),list([symbol('cons-but-not-leading-zeroes'),list([symbol('P\'')]),list([symbol(cons)]),list([symbol(popd)]),symbol(ifte)]),list([symbol('sub-with-carry'),symbol('_sub-with-carry0'),symbol('_sub-with-carry1')]),list([symbol('_sub-with-carry0'),symbol(rolldown),symbol('bool-to-int'),list([symbol(-)]),symbol(ii)]),list([symbol('_sub-with-carry1'),list([symbol(base),symbol(+),symbol(base),symbol(mod)]),list([int(0),symbol(<)]),symbol(cleave)]),list([symbol('sub-like-bigints'),symbol('extract-sign'),symbol('check-gt'),symbol('sub-digits'),symbol(cons)]),list([symbol('sub-digits'),symbol('initial-carry'),symbol('sub-digits\'')]),list([symbol('sub-bigints'),list([symbol('same-sign')]),list([symbol('sub-like-bigints')]),list([symbol('neg-bigint'),symbol('add-like-bigints')]),symbol(ifte)]),symbol(enstacken),list([symbol(inscribe)]),symbol(step),list([symbol('add-carry-to-digits')]),list([symbol(swap),symbol(carry)]),list([symbol('add-with-carry')]),symbol('build-two-list-combiner'),list([symbol('add-digits\'')]),symbol(swoncat),symbol(inscribe),list([symbol('sub-carry-from-digits')]),list([symbol(swap),symbol(pop)]),list([symbol('sub-with-carry')]),symbol('build-two-list-combiner'),list([symbol('sub-digits\'')]),symbol(swoncat),symbol(inscribe),int(1000000000000000000000000000000000000000),symbol('to-bigint'),int(1),symbol('to-bigint'),symbol('sub-bigints'),symbol('from-bigint')]. diff --git a/implementations/SWIProlog/blanks.py b/implementations/SWIProlog/blanks.py new file mode 100644 index 0000000..5c8de76 --- /dev/null +++ b/implementations/SWIProlog/blanks.py @@ -0,0 +1,33 @@ + + +# https://www.lesinskis.com/python-unicode-whitespace.html +UNICODE_WHITESPACE_CHARACTERS = [ + "\u0009", # character tabulation + "\u000a", # line feed + "\u000b", # line tabulation + "\u000c", # form feed + "\u000d", # carriage return + "\u0020", # space + "\u0085", # next line + "\u00a0", # no-break space + "\u1680", # ogham space mark + "\u2000", # en quad + "\u2001", # em quad + "\u2002", # en space + "\u2003", # em space + "\u2004", # three-per-em space + "\u2005", # four-per-em space + "\u2006", # six-per-em space + "\u2007", # figure space + "\u2008", # punctuation space + "\u2009", # thin space + "\u200A", # hair space + "\u2028", # line separator + "\u2029", # paragraph separator + "\u202f", # narrow no-break space + "\u205f", # medium mathematical space + "\u3000", # ideographic space +] + +for ch in UNICODE_WHITESPACE_CHARACTERS: + print(f'blank --> {list(ch.encode("utf_8"))}.') diff --git a/implementations/SWIProlog/eval_joy_ast.prolog b/implementations/SWIProlog/eval_joy_ast.prolog new file mode 100644 index 0000000..e6f7392 --- /dev/null +++ b/implementations/SWIProlog/eval_joy_ast.prolog @@ -0,0 +1,124 @@ +:- use_module(library(clpfd)). + +:- dynamic(def/2). + + +thun([], S, S). +thun([Term|E], Si, So) :- thun(Term, E, Si, So). + +thun(A, [], S, [A|S]) :- var(A), !. +thun(A, [T|E], S, So) :- var(A), !, thun(T, E, [A|S], So). + +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), [], B, C) :- func(A, B, C). +thun(symbol(A), [C|D], B, F) :- func(A, B, E), thun(C, D, E, F). + +thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). + +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). + +% Some error handling. + +thun(symbol(Unknown), _, _, _) :- + \+ def(Unknown, _), + \+ func(Unknown, _, _), + \+ combo(Unknown, _, _, _, _), + write('Unknown: '), + write(Unknown), + fail. + + +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(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(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( + , [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( add , [int(A), int(B)|S], [int(A + B)|S]). +func( sub , [int(A), int(B)|S], [int(B - A)|S]). +func( mul , [int(A), int(B)|S], [int(A * B)|S]). +func( div , [int(A), int(B)|S], [int(B div A)|S]). +func( mod, [int(A), int(B)|S], [int(B mod A)|S]). + + +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(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). + + +joy_def(Codes) :- + text_to_expression(Codes, [symbol(Name)|Body]), + assert_def(Name, Body). + +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. + +%:- initialization(joy_def("enstacken stack [clear] dip")). + +%name_list(E, L) :- +% term_variables(E, Vars), + +foo(Var, Name=Var) :- gensym('A', Name). + + +barzs([], []). +barzs([Var|Bs], [(Name=Var)|Ls]) :- + gensym('A', Name), + barzs(Bs, Ls). + +main :- + read_term(Expression, []), + thun(Expression, Si, So), + term_variables((Si, So), L), + barzs(L, LL), + %write_canonical(LL), writeln(""), + write_term(Si, [quoted(true),fullstop(true),variable_names(LL)]), + write_term(So, [quoted(true),fullstop(true),variable_names(LL)]), + writeln(""). + + + + + \ No newline at end of file diff --git a/implementations/SWIProlog/joy_to_ast.prolog b/implementations/SWIProlog/joy_to_ast.prolog new file mode 100644 index 0000000..6e1a146 --- /dev/null +++ b/implementations/SWIProlog/joy_to_ast.prolog @@ -0,0 +1,86 @@ + +stdin_to_codes(Codes) :- + % Pass in and discard atom 'code' to prime stdin_to_codes/2. + stdin_to_codes(code, [code|Codes]). + +stdin_to_codes(-1, []) :- !. +stdin_to_codes(Code, [Code|Codes]) :- + get_code(NextCode), + stdin_to_codes(NextCode, Codes). + +% +%joy(InputString, StackIn, StackOut) :- +% text_to_expression(InputString, Expression), +% !, +% thun(Expression, StackIn, StackOut). +% + +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) --> blank, !, 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(Token) --> [tok(Codes)], {joy_token(Token, Codes)}. + +joy_token(int(I), Codes) :- catch(number_codes(I, Codes), _Err, fail), !. +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) --> \+ blank, [Ch], { Ch \== 0'[, Ch \== 0'] }. + + +blank --> [9]. +blank --> [10]. +blank --> [11]. +blank --> [12]. +blank --> [13]. +blank --> [32]. +blank --> [194, 133]. +blank --> [194, 160]. +blank --> [225, 154, 128]. +blank --> [226, 128, 128]. +blank --> [226, 128, 129]. +blank --> [226, 128, 130]. +blank --> [226, 128, 131]. +blank --> [226, 128, 132]. +blank --> [226, 128, 133]. +blank --> [226, 128, 134]. +blank --> [226, 128, 135]. +blank --> [226, 128, 136]. +blank --> [226, 128, 137]. +blank --> [226, 128, 138]. +blank --> [226, 128, 168]. +blank --> [226, 128, 169]. +blank --> [226, 128, 175]. +blank --> [226, 129, 159]. +blank --> [227, 128, 128]. + + +main :- + stdin_to_codes(Codes), + text_to_expression(Codes, Expr), + write_canonical(Expr), + writeln(".") + . \ No newline at end of file diff --git a/implementations/SWIProlog/parser.prolog b/implementations/SWIProlog/parser.prolog new file mode 100644 index 0000000..8aec286 --- /dev/null +++ b/implementations/SWIProlog/parser.prolog @@ -0,0 +1,171 @@ + +:- dynamic(def/2). + +% For number_codes/2 we want to just fail if the codes do not represent an integer. +% gprolog.html#number-atom%2F2 +% > Number is a variable, Atom (or Chars or Codes) cannot be parsed as a number and the value of the syntax_error Prolog flag is error (section 8.22.1) +:- set_prolog_flag(syntax_error, fail). + + +joy(InputString, StackIn, StackOut) :- + text_to_expression(InputString, Expression), + !, + thun(Expression, StackIn, StackOut). + + +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) --> blank, !, 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(Token) --> [tok(Codes)], {joy_token(Token, Codes)}. + +joy_token(int(I), Codes) :- number_codes(I, Codes), !. +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) --> \+ blank, [Ch], { Ch \== 0'[, Ch \== 0'] }. + + +blank --> [9]. +blank --> [10]. +blank --> [11]. +blank --> [12]. +blank --> [13]. +blank --> [32]. +blank --> [194, 133]. +blank --> [194, 160]. +blank --> [225, 154, 128]. +blank --> [226, 128, 128]. +blank --> [226, 128, 129]. +blank --> [226, 128, 130]. +blank --> [226, 128, 131]. +blank --> [226, 128, 132]. +blank --> [226, 128, 133]. +blank --> [226, 128, 134]. +blank --> [226, 128, 135]. +blank --> [226, 128, 136]. +blank --> [226, 128, 137]. +blank --> [226, 128, 138]. +blank --> [226, 128, 168]. +blank --> [226, 128, 169]. +blank --> [226, 128, 175]. +blank --> [226, 129, 159]. +blank --> [227, 128, 128]. + + +thun([], S, S). +thun([Term|E], Si, So) :- thun(Term, E, Si, So). + +thun(A, [], S, [A|S]) :- var(A), !. +thun(A, [T|E], S, So) :- var(A), !, thun(T, E, [A|S], So). + +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), [], B, C) :- func(A, B, C). +thun(symbol(A), [C|D], B, F) :- func(A, B, E), thun(C, D, E, F). + +thun(symbol(Combo), E, Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). + +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). + +% Some error handling. + +thun(symbol(Unknown), _, _, _) :- + \+ def(Unknown, _), + \+ func(Unknown, _, _), + \+ combo(Unknown, _, _, _, _), + write('Unknown: '), + write(Unknown), + fail. + + +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(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(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( + , [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( add , [int(A), int(B)|S], [int(A + B)|S]). +func( sub , [int(A), int(B)|S], [int(B - A)|S]). +func( mul , [int(A), int(B)|S], [int(A * B)|S]). +func( div , [int(A), int(B)|S], [int(B div A)|S]). +func( mod, [int(A), int(B)|S], [int(B mod A)|S]). + + +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(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). + + +joy_def(Codes) :- + text_to_expression(Codes, [symbol(Name)|Body]), + assert_def(Name, Body). + +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. + +:- initialization(joy_def("enstacken stack [clear] dip")).