diff --git a/thun/gnu-prolog/Makefile b/thun/gnu-prolog/Makefile index 657b958..a14a6c4 100644 --- a/thun/gnu-prolog/Makefile +++ b/thun/gnu-prolog/Makefile @@ -3,6 +3,4 @@ thun: thun.pl gplc -o thun thun.pl -foo: foo.pl - gplc -o foo foo.pl diff --git a/thun/gnu-prolog/foo.pl b/thun/gnu-prolog/foo.pl deleted file mode 100644 index 3ef45af..0000000 --- a/thun/gnu-prolog/foo.pl +++ /dev/null @@ -1,107 +0,0 @@ -:- dynamic(func/3). -:- discontiguous(func/3). - -/* - 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 . - -*/ -/* -Interpreter -thun(Expression, InputStack, OutputStack) -*/ - -thun([], S, S). -thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So). -thun( [Def|E], Si, So) :- def(Def, Body), !, append(Body, E, Eo), thun(Eo, Si, So). -thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, So). -thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). - -% Some error handling. - -thun([Unknown|E], Si, So) :- - damned_thing(Unknown), - write("wtf? "), - write(Unknown), nl, - So = [[Unknown|E]|Si]. - -damned_thing(It) :- - \+ literal(It), - \+ def(It, _), - \+ func(It, _, _), - \+ combo(It, _, _, _, _). - - -/* -Literals -*/ - -literal(V) :- var(V). -literal(I) :- number(I). -literal([]). -literal([_|_]). -literal(true). -literal(false). - -% Symbolic math expressions are literals. -literal(_+_). -literal(_-_). -literal(_*_). -literal(_/_). -literal(_ mod _). - -% Symbolic comparisons are literals. -literal(_>_). -literal(_<_). -literal(_>=_). -literal(_=<_). -literal(_=:=_). -literal(_=\=_). - - -/* -Functions -*/ - -func(cons, [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 ). - - -/* -Combinators -*/ - -combo(i, [P|S], S, Ei, Eo) :- append(P, Ei, Eo). -combo(dip, [P, X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo). -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). - - - -/* -Definitions -*/ - -def(x, [dup, i]). - - - - - diff --git a/thun/gnu-prolog/swi-thun.pl b/thun/gnu-prolog/swi-thun.pl new file mode 100644 index 0000000..e2dd117 --- /dev/null +++ b/thun/gnu-prolog/swi-thun.pl @@ -0,0 +1,350 @@ +:- dynamic(func/3). +:- discontiguous(func/3). + +/* + 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 . + +*/ +:- dynamic(def/2). + + +/* + +To handle comparision operators the possibility of exceptions due to +insufficiently instantiated arguments must be handled. First try to make +the comparison and set the result to a Boolean atom. If an exception +happens just leave the comparison expression as the result and some other +function or combinator will deal with it. Example: + + func(>, [A, B|S], [C|S]) :- catch( + (B > A -> C=true ; C=false), + _, + C=(B>A) % in case of error. + ). + +To save on conceptual overhead I've defined a term_expansion/2 that sets +up the func/3 for each op. +*/ + +term_expansion(comparison_operator(X), (func(X, [A, B|S], [C|S]) :- + F =.. [X, B, A], catch((F -> C=true ; C=false), _, C=F))). + +% I don't use Prolog-compatible op symbols in all cases. +term_expansion(comparison_operator(X, Y), (func(X, [A, B|S], [C|S]) :- + F =.. [Y, B, A], catch((F -> C=true ; C=false), _, C=F))). + +% Likewise for math operators, try to evaluate, otherwise use the +% symbolic form. + +term_expansion(math_operator(X), (func(X, [A, B|S], [C|S]) :- + F =.. [X, B, A], catch(C is F, _, C=F))). + +term_expansion(math_operator(X, Y), (func(X, [A, B|S], [C|S]) :- + F =.. [Y, B, A], catch(C is F, _, C=F))). + + +/* +An entry point. +*/ + +joy(InputString, StackIn, StackOut) :- + phrase(joy_parse(Expression), InputString), !, + thun(Expression, StackIn, StackOut). + +/* +Parser + + joy :== number | '[' joy* ']' | atom + +*/ + +joy_parse([T|J]) --> blanks, joy_term(T), blanks, joy_parse(J). +joy_parse([]) --> []. + +joy_term(N) --> number(N), !. +joy_term(J) --> "[", !, joy_parse(J), "]". +joy_term(C) --> symbol(C). + +symbol(C) --> chars(Chars), !, {Chars \= [61, 61], 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)}. + + +/* +Interpreter +thun(Expression, InputStack, OutputStack) +*/ + +thun([], S, S). +thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So). +thun( [Def|E], Si, So) :- def(Def, Body), !, append(Body, E, Eo), thun(Eo, Si, So). +thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, So). +thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). + +% Some error handling. + +thun([Unknown|E], Si, So) :- + damned_thing(Unknown), + write("wtf? "), + writeln(Unknown), + So = [[Unknown|E]|Si]. + +damned_thing(It) :- + \+ literal(It), + \+ def(It, _), + \+ func(It, _, _), + \+ combo(It, _, _, _, _). + + +/* +Literals +*/ + +literal(V) :- var(V). +literal(I) :- number(I). +literal([]). +literal([_|_]). +literal(true). +literal(false). + +% Symbolic math expressions are literals. +literal(_+_). +literal(_-_). +literal(_*_). +literal(_/_). +literal(_ mod _). + +% Symbolic comparisons are literals. +literal(_>_). +literal(_<_). +literal(_>=_). +literal(_=<_). +literal(_=:=_). +literal(_=\=_). + + +/* +Functions +*/ + +func(cons, [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 ). + +% Symbolic math. Compute the answer, or derivative, or whatever, later. +math_operator(+). +math_operator(-). +math_operator(*). +math_operator(/). +math_operator(mod). + +% Attempt to calculate the value of a symbolic math expression. +func(calc, [A|S], [B|S]) :- B is A. + +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]). + +comparison_operator(>). +comparison_operator(<). +comparison_operator(>=). +comparison_operator(<=, =<). +comparison_operator(=, =:=). +comparison_operator(<>, =\=). + + +/* +Definitions +*/ + +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)). + +:- assert_defs("defs.txt"). + + +/* +Combinators +*/ + +combo(i, [P|S], S, Ei, Eo) :- append(P, Ei, Eo). +combo(dip, [P, X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo). +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(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, + (Expr -> append(T, Ei, Eo) ; append(F, Ei, Eo)), + _, % If Expr don't grok, try both branches. + (append(T, Ei, Eo) ; append(F, Ei, Eo)) + ). + +combo(loop, [_, false|S], S, E, E ). +combo(loop, [B, true|S], S, Ei, Eo) :- append(B, [B, loop|Ei], Eo). +combo(loop, [B, Expr|S], S, Ei, Eo) :- + \+ Expr = true, \+ Expr = false, + catch( % Try Expr and do one or the other, + (Expr -> append(B, [B, loop|Ei], Eo) ; Ei=Eo), + _, % If Expr don't grok, try both branches. + (Ei=Eo ; append(B, [B, loop|Ei], Eo)) + ). + +combo(step, [_, []|S], S, E, E ). +combo(step, [P, [X]|S], [X|S], Ei, Eo) :- !, append(P, Ei, Eo). +combo(step, [P, [X|Z]|S], [X|S], Ei, Eo) :- append(P, [Z, P, step|Ei], Eo). + +combo(times, [_, 0|S], S, E, E ). +combo(times, [P, 1|S], S, Ei, Eo) :- append(P, Ei, Eo). +combo(times, [P, N|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [M, P, times|Ei], Eo). +combo(times, [_, N|S], S, _, _ ) :- N #< 0, fail. + +combo(genrec, [R1, R0, Then, If|S], + [ Else, Then, If|S], E, [ifte|E]) :- + Quoted = [If, Then, R0, R1, genrec], + append(R0, [Quoted|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, [_, []|S], [[]|S], E, E ) :- !. +combo(map, [P, List|S], [Mapped, []|S], E, [infra|E]) :- + prepare_mapping(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(P, S, In, Out) :- prepare_mapping(P, S, In, [], Out). + +prepare_mapping( _, _, [], Out, Out) :- !. +prepare_mapping( P, S, [T|In], Acc, Out) :- + prepare_mapping(P, S, In, [[T|S], P, infrst|Acc], Out). + + +/* +Compiler +*/ + +joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule). + +show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), portray_clause(Rule). + +jcmpl(Name, Expression, Rule) :- + call_residue_vars(thun(Expression, Si, So), Term), + copy_term(Term, Term, Gs), + Head =.. [func, Name, Si, So], + rule(Head, Gs, Rule). + +rule(Head, [], Head ). +rule(Head, [A|B], Head :- maplist(call, [A|B])). + +sjc(Name, InputString) :- phrase(joy_parse(E), InputString), show_joy_compile(Name, E). + + +% Simple DCGs to expand/contract definitions. + +expando, Body --> [Def], {def(Def, Body)}. +contracto, [Def] --> {def(Def, Body)}, Body. + +% Apply expando/contracto more than once, and descend into sub-lists. +% The K term is one of expando or contracto, and the J term is used +% on sub-lists, i.e. expando/grow and contracto/shrink. +% BTW, "rebo" is a meaningless name, don't break your brain +% trying to figure it out. + +rebo(K, J) --> K , rebo(K, J). +rebo(K, J), [E] --> [[H|T]], !, {call(J, [H|T], E)}, rebo(K, J). +rebo(K, J), [A] --> [ A ], !, rebo(K, J). +rebo(_, _) --> []. + +to_fixed_point(DCG, Ei, Eo) :- + phrase(DCG, Ei, E), % Apply DCG... + (Ei=E -> Eo=E ; to_fixed_point(DCG, E, Eo)). % ...until a fixed-point is reached. + +grow --> to_fixed_point(rebo(expando, grow )). +shrink --> to_fixed_point(rebo(contracto, shrink)). + + +% format_n(N) --> {number(N), !, number_codes(N, Codes)}, Codes. +% format_n(N) --> signed_digits(Codes), !, {number_codes(N, Codes)}. + +% signed_digits([45|Codes]) --> [45], !, digits(Codes). +% signed_digits( Codes ) --> digits(Codes). + +% digits([Ch|Chars]) --> [Ch], {code_type(Ch, digit)}, digits(Chars). +% digits([]), [Ch] --> [Ch], {code_type(Ch, space) ; Ch=0'] }. +% digits([], [], _). % Match if followed by space, ], or nothing. diff --git a/thun/gnu-prolog/thun.pl b/thun/gnu-prolog/thun.pl index e2dd117..3ef45af 100644 --- a/thun/gnu-prolog/thun.pl +++ b/thun/gnu-prolog/thun.pl @@ -1,8 +1,8 @@ -:- dynamic(func/3). +:- dynamic(func/3). :- discontiguous(func/3). /* - Copyright © 2018, 2019 Simon Forman + Copyright 2018, 2019 Simon Forman This file is part of Thun @@ -20,74 +20,6 @@ along with Thun. If not see . */ -:- dynamic(def/2). - - -/* - -To handle comparision operators the possibility of exceptions due to -insufficiently instantiated arguments must be handled. First try to make -the comparison and set the result to a Boolean atom. If an exception -happens just leave the comparison expression as the result and some other -function or combinator will deal with it. Example: - - func(>, [A, B|S], [C|S]) :- catch( - (B > A -> C=true ; C=false), - _, - C=(B>A) % in case of error. - ). - -To save on conceptual overhead I've defined a term_expansion/2 that sets -up the func/3 for each op. -*/ - -term_expansion(comparison_operator(X), (func(X, [A, B|S], [C|S]) :- - F =.. [X, B, A], catch((F -> C=true ; C=false), _, C=F))). - -% I don't use Prolog-compatible op symbols in all cases. -term_expansion(comparison_operator(X, Y), (func(X, [A, B|S], [C|S]) :- - F =.. [Y, B, A], catch((F -> C=true ; C=false), _, C=F))). - -% Likewise for math operators, try to evaluate, otherwise use the -% symbolic form. - -term_expansion(math_operator(X), (func(X, [A, B|S], [C|S]) :- - F =.. [X, B, A], catch(C is F, _, C=F))). - -term_expansion(math_operator(X, Y), (func(X, [A, B|S], [C|S]) :- - F =.. [Y, B, A], catch(C is F, _, C=F))). - - -/* -An entry point. -*/ - -joy(InputString, StackIn, StackOut) :- - phrase(joy_parse(Expression), InputString), !, - thun(Expression, StackIn, StackOut). - -/* -Parser - - joy :== number | '[' joy* ']' | atom - -*/ - -joy_parse([T|J]) --> blanks, joy_term(T), blanks, joy_parse(J). -joy_parse([]) --> []. - -joy_term(N) --> number(N), !. -joy_term(J) --> "[", !, joy_parse(J), "]". -joy_term(C) --> symbol(C). - -symbol(C) --> chars(Chars), !, {Chars \= [61, 61], 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)}. - - /* Interpreter thun(Expression, InputStack, OutputStack) @@ -104,7 +36,7 @@ thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So). thun([Unknown|E], Si, So) :- damned_thing(Unknown), write("wtf? "), - writeln(Unknown), + write(Unknown), nl, So = [[Unknown|E]|Si]. damned_thing(It) :- @@ -150,72 +82,6 @@ func(swap, [A, B|S], [B, A|S]). func(dup, [A|S], [A, A|S]). func(pop, [_|S], S ). -% Symbolic math. Compute the answer, or derivative, or whatever, later. -math_operator(+). -math_operator(-). -math_operator(*). -math_operator(/). -math_operator(mod). - -% Attempt to calculate the value of a symbolic math expression. -func(calc, [A|S], [B|S]) :- B is A. - -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]). - -comparison_operator(>). -comparison_operator(<). -comparison_operator(>=). -comparison_operator(<=, =<). -comparison_operator(=, =:=). -comparison_operator(<>, =\=). - - -/* -Definitions -*/ - -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)). - -:- assert_defs("defs.txt"). - /* Combinators @@ -227,124 +93,15 @@ 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(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, - (Expr -> append(T, Ei, Eo) ; append(F, Ei, Eo)), - _, % If Expr don't grok, try both branches. - (append(T, Ei, Eo) ; append(F, Ei, Eo)) - ). - -combo(loop, [_, false|S], S, E, E ). -combo(loop, [B, true|S], S, Ei, Eo) :- append(B, [B, loop|Ei], Eo). -combo(loop, [B, Expr|S], S, Ei, Eo) :- - \+ Expr = true, \+ Expr = false, - catch( % Try Expr and do one or the other, - (Expr -> append(B, [B, loop|Ei], Eo) ; Ei=Eo), - _, % If Expr don't grok, try both branches. - (Ei=Eo ; append(B, [B, loop|Ei], Eo)) - ). - -combo(step, [_, []|S], S, E, E ). -combo(step, [P, [X]|S], [X|S], Ei, Eo) :- !, append(P, Ei, Eo). -combo(step, [P, [X|Z]|S], [X|S], Ei, Eo) :- append(P, [Z, P, step|Ei], Eo). - -combo(times, [_, 0|S], S, E, E ). -combo(times, [P, 1|S], S, Ei, Eo) :- append(P, Ei, Eo). -combo(times, [P, N|S], S, Ei, Eo) :- N #>= 2, M #= N - 1, append(P, [M, P, times|Ei], Eo). -combo(times, [_, N|S], S, _, _ ) :- N #< 0, fail. - -combo(genrec, [R1, R0, Then, If|S], - [ Else, Then, If|S], E, [ifte|E]) :- - Quoted = [If, Then, R0, R1, genrec], - append(R0, [Quoted|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, [_, []|S], [[]|S], E, E ) :- !. -combo(map, [P, List|S], [Mapped, []|S], E, [infra|E]) :- - prepare_mapping(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(P, S, In, Out) :- prepare_mapping(P, S, In, [], Out). - -prepare_mapping( _, _, [], Out, Out) :- !. -prepare_mapping( P, S, [T|In], Acc, Out) :- - prepare_mapping(P, S, In, [[T|S], P, infrst|Acc], Out). /* -Compiler +Definitions */ -joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule). - -show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), portray_clause(Rule). - -jcmpl(Name, Expression, Rule) :- - call_residue_vars(thun(Expression, Si, So), Term), - copy_term(Term, Term, Gs), - Head =.. [func, Name, Si, So], - rule(Head, Gs, Rule). - -rule(Head, [], Head ). -rule(Head, [A|B], Head :- maplist(call, [A|B])). - -sjc(Name, InputString) :- phrase(joy_parse(E), InputString), show_joy_compile(Name, E). +def(x, [dup, i]). -% Simple DCGs to expand/contract definitions. - -expando, Body --> [Def], {def(Def, Body)}. -contracto, [Def] --> {def(Def, Body)}, Body. - -% Apply expando/contracto more than once, and descend into sub-lists. -% The K term is one of expando or contracto, and the J term is used -% on sub-lists, i.e. expando/grow and contracto/shrink. -% BTW, "rebo" is a meaningless name, don't break your brain -% trying to figure it out. - -rebo(K, J) --> K , rebo(K, J). -rebo(K, J), [E] --> [[H|T]], !, {call(J, [H|T], E)}, rebo(K, J). -rebo(K, J), [A] --> [ A ], !, rebo(K, J). -rebo(_, _) --> []. - -to_fixed_point(DCG, Ei, Eo) :- - phrase(DCG, Ei, E), % Apply DCG... - (Ei=E -> Eo=E ; to_fixed_point(DCG, E, Eo)). % ...until a fixed-point is reached. - -grow --> to_fixed_point(rebo(expando, grow )). -shrink --> to_fixed_point(rebo(contracto, shrink)). -% format_n(N) --> {number(N), !, number_codes(N, Codes)}, Codes. -% format_n(N) --> signed_digits(Codes), !, {number_codes(N, Codes)}. -% signed_digits([45|Codes]) --> [45], !, digits(Codes). -% signed_digits( Codes ) --> digits(Codes). - -% digits([Ch|Chars]) --> [Ch], {code_type(Ch, digit)}, digits(Chars). -% digits([]), [Ch] --> [Ch], {code_type(Ch, space) ; Ch=0'] }. -% digits([], [], _). % Match if followed by space, ], or nothing.