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

Treat defs in thun/3 relation. 

Allow for "compilation" of new func/3 rules.

Add comment of crude grammar for Joy syntax.

Minor rearrangements.

show_joy_compile uses portray_clause/1.
This commit is contained in:
Simon Forman 2019-04-26 21:58:15 -07:00
parent 343812dac6
commit 58e46a9809
1 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
thun/thun.pl
View File

@ -1,4 +1,4 @@
% %
% Copyright © 2018 Simon Forman % Copyright © 2018 Simon Forman
% %
% This file is part of Thun % This file is part of Thun
@ -19,6 +19,7 @@
:- use_module(library(clpfd)). :- use_module(library(clpfd)).
:- use_module(library(dcg/basics)). :- use_module(library(dcg/basics)).
:- op(990, xfy, ≡). % for Joy definitions. :- op(990, xfy, ≡). % for Joy definitions.
:- dynamic func/3.
/* /*
An entry point. An entry point.
@ -30,14 +31,17 @@ joy(InputString, StackIn, StackOut) :-
/* /*
Parser Parser
joy :== number | '[' joy* ']' | chars
*/ */
joy_parse([T|S]) --> blanks, joy_term(T), blanks, joy_parse(S). joy_parse([T|J]) --> blanks, joy_term(T), blanks, joy_parse(J).
joy_parse([]) --> []. joy_parse([]) --> [].
joy_term(N) --> number(N), !. joy_term(N) --> number(N), !.
joy_term(S) --> "[", !, joy_parse(S), "]". joy_term(J) --> "[", !, joy_parse(J), "]".
joy_term(A) --> chars(Chars), !, {atom_string(A, Chars)}. joy_term(C) --> chars(Chars), !, {atom_string(C, Chars)}.
chars([Ch|Rest]) --> char(Ch), chars(Rest). chars([Ch|Rest]) --> char(Ch), chars(Rest).
chars([Ch]) --> char(Ch). chars([Ch]) --> char(Ch).
@ -51,6 +55,7 @@ thun(Expression, InputStack, OutputStack)
thun([], S, S). thun([], S, S).
thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So). thun( [Lit|E], Si, So) :- literal(Lit), !, thun(E, [Lit|Si], So).
thun( [Def|E], Si, So) :- Def ≡ Body, !, append(Body, E, Eo), thun(Eo, Si, So).
thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, 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). thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So).
@ -69,8 +74,12 @@ literal(false).
Functions Functions
*/ */
func(app1, [P, Xi|S], [Xo|S]) :- thun(P, [Xi|S], [Xo|_]). func(app1, [P, Xi|S], [Xo|S]) :- thun(P, [Xi|S], [Xo|_]). % Combinator.
func(app2, [P, Xi, Yi|S], [Xo, Yo|S]) :- thun(P, [Xi|S], [Xo|_]), thun(P, [Yi|S], [Yo|_]). func(app2, [P, Xi, Yi|S], [Xo, Yo|S]) :- thun(P, [Xi|S], [Xo|_]), % Combinator.
thun(P, [Yi|S], [Yo|_]).
func(nullary, [P|S], [X|S]) :- thun(P, S, [X|_]). % Combinator.
func(infra, [P, R|S], [Q|S]) :- thun(P, R, Q). % Combinator.
func(cons, [A, B|S], [[B|A]|S]). func(cons, [A, B|S], [[B|A]|S]).
func(swap, [A, B|S], [B, A|S]). func(swap, [A, B|S], [B, A|S]).
@ -81,9 +90,6 @@ func(-, [A, B|S], [C|S]) :- C #= B - A.
func(*, [A, B|S], [C|S]) :- C #= A * B. func(*, [A, B|S], [C|S]) :- C #= A * B.
func(/, [A, B|S], [C|S]) :- C #= B div A. func(/, [A, B|S], [C|S]) :- C #= B div A.
func(nullary, [P|S], [X|S]) :- thun(P, S, [X|_]). % Combinator.
func(infra, [P, R|S], [Q|S]) :- thun(P, R, Q). % Combinator.
func(concat, [A, B|S], [C|S]) :- append(B, A, C). func(concat, [A, B|S], [C|S]) :- append(B, A, C).
func(flatten, [A|S], [B|S]) :- flatten(A, B). func(flatten, [A|S], [B|S]) :- flatten(A, B).
func(swaack, [R|S], [S|R]). func(swaack, [R|S], [S|R]).
@ -108,12 +114,14 @@ func(>=, [A, B|S], [T|S]) :- B #>= A #<==> R, r_truth(R, T).
func(<=, [A, B|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T). func(<=, [A, B|S], [T|S]) :- B #=< A #<==> R, r_truth(R, T).
func(<>, [A, B|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T). func(<>, [A, B|S], [T|S]) :- B #\= A #<==> R, r_truth(R, T).
r_truth(0, false).
r_truth(1, true).
/* /*
Definitions Definitions
*/ */
func(Name, Si, So) :- Name ≡ Body, thun(Body, Si, So).
swons ≡ [swap, cons]. swons ≡ [swap, cons].
unswons ≡ [uncons, swap]. unswons ≡ [uncons, swap].
x ≡ [dup, i]. x ≡ [dup, i].
@ -148,8 +156,6 @@ cleave ≡ [fork, [popd], dip].
codireco ≡ [cons, dip, rest, cons]. codireco ≡ [cons, dip, rest, cons].
make_generator ≡ [[codireco], ccons]. make_generator ≡ [[codireco], ccons].
r_truth(0, false).
r_truth(1, true).
/* /*
Combinators Combinators
@ -181,7 +187,7 @@ Compiler
joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule). joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), asserta(Rule).
show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), write(Rule). show_joy_compile(Name, Expression) :- jcmpl(Name, Expression, Rule), portray_clause(Rule).
jcmpl(Name, Expression, Rule) :- jcmpl(Name, Expression, Rule) :-
call_residue_vars(thun(Expression, Si, So), Term), call_residue_vars(thun(Expression, Si, So), Term),