This repo is not current. Development has moved from Hg to Git. For the latest code use the "Source Code" tab above to go to the "Thun" git repo or navigate to:
https://osdn.net/projects/joypy/scm/git/Thun
リビジョン | eac58af6f029534d58334f4ed0502d1edcea9373 (tree) |
---|---|
日時 | 2019-08-23 07:45:24 |
作者 | Simon Forman <sforman@hush...> |
コミッター | Simon Forman |
Using partial deduction to inline literals, functions, and combinators.
@@ -0,0 +1,156 @@ | ||
1 | +:- use_module(library(clpfd)). | |
2 | + | |
3 | +%-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- | |
4 | + | |
5 | +process(Program, ReducedProgram) :- | |
6 | + findall(PC1, (member(C1, Program), preduce(C1, PC1), portray_clause(PC1)), ReducedProgram). | |
7 | + | |
8 | +preduce( (A :- B), (Pa :- Pb) ) :- !, preduce(B, Pb), preduce(A, Pa). | |
9 | +preduce( true, true ) :- !. | |
10 | +preduce( (A, B), Residue ) :- !, preduce(A, Pa), preduce(B, Pb), combine(Pa, Pb, Residue). | |
11 | +preduce( A, B ) :- should_fold(A, B), !. | |
12 | +preduce( A, Residue ) :- should_unfold(A), !, clause(A, B), preduce(B, Residue). | |
13 | +preduce( A, A ). | |
14 | + | |
15 | +combine(true, B, B) :- !. | |
16 | +combine(A, true, A) :- !. | |
17 | +combine(A, B, (A, B)). | |
18 | + | |
19 | +test(Name, Program) :- program(Name, Clauses), process(Clauses, Program). | |
20 | + | |
21 | +%-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- | |
22 | + | |
23 | +program(tundra, [ | |
24 | + ( thun([], S, S) ), | |
25 | + ( thun( [Lit|E], Si, So) :- literal(Lit), thun(E, [Lit|Si], So) ), | |
26 | + ( thun( [Func|E], Si, So) :- func(Func, Si, S), thun(E, S, So) ), | |
27 | + ( thun([Combo|E], Si, So) :- combo(Combo, Si, S, E, Eo), thun(Eo, S, So) ) | |
28 | + ]). | |
29 | + | |
30 | +should_unfold(func(Func, Si, So)). | |
31 | +should_unfold(combo(A, B, C, D, E)). | |
32 | +should_unfold(literal(Lit)). | |
33 | +should_fold(sam, bill). | |
34 | + | |
35 | +%-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- | |
36 | + | |
37 | +literal(V) :- var(V). | |
38 | +literal(I) :- number(I). | |
39 | +literal([]). | |
40 | +literal([_|_]). | |
41 | +literal(true). | |
42 | +literal(false). | |
43 | + | |
44 | +func(cons, [A, B|S], [[B|A]|S]). | |
45 | +func(swap, [A, B|S], [B, A|S]). | |
46 | +func(dup, [A|S], [A, A|S]). | |
47 | +func(pop, [_|S], S ). | |
48 | +func(+, [A, B|S], [C|S]) :- C #= A + B. | |
49 | +func(-, [A, B|S], [C|S]) :- C #= B - A. | |
50 | +func(*, [A, B|S], [C|S]) :- C #= A * B. | |
51 | +func(/, [A, B|S], [C|S]) :- C #= B div A. | |
52 | + | |
53 | +func(nullary, [P|S], [X|S]) :- thun(P, S, [X|_]). % Combinator. | |
54 | +func(infra, [P, R|S], [Q|S]) :- thun(P, R, Q). % Combinator. | |
55 | + | |
56 | +func(concat, [A, B|S], [C|S]) :- append(B, A, C). | |
57 | +func(flatten, [A|S], [B|S]) :- flatten(A, B). | |
58 | +func(swaack, [R|S], [S|R]). | |
59 | +func(stack, S , [S|S]). | |
60 | +func(clear, _ , []). | |
61 | +func(first, [[X|_]|S], [X|S]). | |
62 | +func(rest, [[_|X]|S], [X|S]). | |
63 | +func(unit, [X|S], [[X]|S]). | |
64 | + | |
65 | +combo(i, [P|S], S, Ei, Eo) :- append(P, Ei, Eo). | |
66 | +combo(dip, [P, X|S], S, Ei, Eo) :- append(P, [X|Ei], Eo). | |
67 | +combo(dipd, [P, X, Y|S], S, Ei, Eo) :- append(P, [Y, X|Ei], Eo). | |
68 | + | |
69 | +%-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- | |
70 | + | |
71 | +% ?- test(tundra, _). | |
72 | +% thun([], A, A). | |
73 | +% thun([A|B], C, D) :- var(A), thun(B, [A|C], D). | |
74 | +% thun([A|B], C, D) :- number(A), thun(B, [A|C], D). | |
75 | +% thun([[]|A], B, C) :- thun(A, [[]|B], C). | |
76 | +% thun([[B|C]|A], D, E) :- thun(A, [[B|C]|D], E). | |
77 | +% thun([true|A], B, C) :- thun(A, [true|B], C). | |
78 | +% thun([false|A], B, C) :- thun(A, [false|B], C). | |
79 | +% thun([cons|A], [C, B|D], E) :- thun(A, [[B|C]|D], E). | |
80 | +% thun([swap|A], [C, B|D], E) :- thun(A, [B, C|D], E). | |
81 | +% thun([dup|A], [B|C], D) :- thun(A, [B, B|C], D). | |
82 | +% thun([pop|A], [_|B], C) :- thun(A, B, C). | |
83 | +% thun([+|E], [A, B|F], G) :- | |
84 | +% ( integer(C) | |
85 | +% -> ( integer(A), | |
86 | +% integer(B) | |
87 | +% -> C=:=A+B | |
88 | +% ; D=C, | |
89 | +% clpfd:clpfd_equal(D, A+B) | |
90 | +% ) | |
91 | +% ; integer(A), | |
92 | +% integer(B) | |
93 | +% -> ( var(C) | |
94 | +% -> C is A+B | |
95 | +% ; D is A+B, | |
96 | +% clpfd:clpfd_equal(C, D) | |
97 | +% ) | |
98 | +% ; clpfd:clpfd_equal(C, A+B) | |
99 | +% ), | |
100 | +% thun(E, [C|F], G). | |
101 | +% thun([-|E], [B, A|F], G) :- | |
102 | +% ( integer(C) | |
103 | +% -> ( integer(A), | |
104 | +% integer(B) | |
105 | +% -> C=:=A-B | |
106 | +% ; D=C, | |
107 | +% clpfd:clpfd_equal(D, A-B) | |
108 | +% ) | |
109 | +% ; integer(A), | |
110 | +% integer(B) | |
111 | +% -> ( var(C) | |
112 | +% -> C is A-B | |
113 | +% ; D is A-B, | |
114 | +% clpfd:clpfd_equal(C, D) | |
115 | +% ) | |
116 | +% ; clpfd:clpfd_equal(C, A-B) | |
117 | +% ), | |
118 | +% thun(E, [C|F], G). | |
119 | +% thun([*|E], [A, B|F], G) :- | |
120 | +% ( integer(C) | |
121 | +% -> ( integer(A), | |
122 | +% integer(B) | |
123 | +% -> C=:=A*B | |
124 | +% ; D=C, | |
125 | +% clpfd:clpfd_equal(D, A*B) | |
126 | +% ) | |
127 | +% ; integer(A), | |
128 | +% integer(B) | |
129 | +% -> ( var(C) | |
130 | +% -> C is A*B | |
131 | +% ; D is A*B, | |
132 | +% clpfd:clpfd_equal(C, D) | |
133 | +% ) | |
134 | +% ; clpfd:clpfd_equal(C, A*B) | |
135 | +% ), | |
136 | +% thun(E, [C|F], G). | |
137 | +% thun([/|C], [B, A|E], F) :- D#=A div B, thun(C, [D|E], F). | |
138 | +% thun([nullary|C], [A|B], E) :- thun(A, B, [D|_]), thun(C, [D|B], E). | |
139 | +% thun([infra|C], [A, B|E], F) :- thun(A, B, D), thun(C, [D|E], F). | |
140 | +% thun([concat|C], [B, A|E], F) :- append(A, B, D), thun(C, [D|E], F). | |
141 | +% thun([flatten|B], [A|D], E) :- flatten(A, C), thun(B, [C|D], E). | |
142 | +% thun([swaack|A], [C|B], D) :- thun(A, [B|C], D). | |
143 | +% thun([stack|A], B, C) :- thun(A, [B|B], C). | |
144 | +% thun([clear|A], _, B) :- thun(A, [], B). | |
145 | +% thun([first|A], [[B|_]|C], D) :- thun(A, [B|C], D). | |
146 | +% thun([rest|A], [[_|B]|C], D) :- thun(A, [B|C], D). | |
147 | +% thun([unit|A], [B|C], D) :- thun(A, [[B]|C], D). | |
148 | +% thun([i|B], [A|D], E) :- append(A, B, C), thun(C, D, E). | |
149 | +% thun([dip|C], [A, B|E], F) :- append(A, [B|C], D), thun(D, E, F). | |
150 | +% thun([dipd|D], [A, C, B|F], G) :- append(A, [B, C|D], E), thun(E, F, G). | |
151 | +% true. | |
152 | + | |
153 | + | |
154 | + | |
155 | + | |
156 | + |