1:- module(turing,[turing/3,turing/4]).
5:-dynamic def/2. 6:- use_module(util(misc)). 7:- use_module(pac(basic)). 8
9run(turing(X,Y),Z):-!,turing(X,Y,Z).
10run(turing:history(X,Y),Z):-history(X,Y,Z).
16demo:- prompt(A,''), demo(A,_).
17
18demo(N):- prompt(A,''), demo(A,N).
19
20demo(_,N):- example(N,X), demo_one(N,X), fail.
21demo(A,_):- prompt(_,A).
22
23demo_one(N,X):- format("~w ~w~n",[N,X]),
24 atom_to_term(X,Y,V),
25 call(Y),
26 !,
27 ( V=[W, U=H] ->
28 writeln(W),nl,
29 format("~w=",[U]),
30 maplist(writeln,H)
31 ; nl, maplist(writeln,V)
32 ).
37def(add, [mark,right,find(@),put(1),find(@),put(space),left,put(@),
38 home,unmark]).
39
40def(q0, q(a,b,r,q1)).
41def(q1, halt).
42
43example(1,'turing(q0, [a,a,a], X,H)').
44example(2,'turing(while(a, [put(b),right]),[a,a,a,a,a],X,H)').
45example(3,'turing([set(x,a), while($x, [put(b),right])],[a,a,a,a,a],X,H)').
46example(4,X):- atom_concat('turing(until(space,if(1,[put(0),right],',
47 'if(0,[put(1),right],nop))),[1,1,0,0],X,H)', X).
48example(5,'turing(insert_region(a,b),[0,0,0,0,a,1,1,1,b,2,2,2],X,H)').
49example(6,'turing([get(x),right,get(y)],[]*[1,0],X,[]-F,H-[])').
50example(7,'turing([set(x,a),get(a),right,put($($x))],[]*[1],X,[]-F,H-[])').
51example(8,'turing(add,[@,1,1,@,1,1,1,@],X,H)').
52example(9,'turing(add,[@,@,@],X,H)').
53example(10,'turing(add,[@,1,@,@],X,H)').
54example(11,'turing(add,[@,@,1,@],X,H)').
55example(12,'turing(shift_right(a),[a,1,1,1]+[2,2,a],X,H)').
56example(13,'turing(shift_left(a),[a,1,1,1]+[2,2,a],X,H)').
57
60
61history(X,Y,H):- turing(X, Y,_ , H1),
62 insert("<br>\n", H1, H). 63
64turing(X,Y,Z) :- turing(X,Y,Z,_).
65
66turing(X,Y,Z,History) :- innerTape(Y,Y1),
67 turing(X,Y1,Z,[]-_,U-[]),
68 maplist(outerTape, [Y1|U], History).
69
70innerTape(X+Y,X1*Y):-!, reverse(X,X1).
71innerTape(X,[]*X):- listp(X),!.
72innerTape(X,X).
73
74outerTape(P*Q,(P2 + Q3)):-
75 reverse(Q,Q1),
76 drop_space(Q1,Q2),
77 reverse(Q2,Q3),
78 reverse(P,P1),
79 drop_space(P1,P2).
80
81drop_space([space|X],Y):-drop_space(X,Y).
82drop_space(X,X).
83
84turing(X,Y,FinalTape, A, H):-!, exec(X,Y,P*Q,A,H),!,
85 outerTape(P*Q,FinalTape).
86
87movehead(X,0,X,P-P).
88movehead(S*[],r,[space|S]*[],[[space|S]*[]|P]-P).
89movehead(S*[X|Y],r,[X|S]*Y,[[X|S]*Y|P]-P).
90movehead([]*X,l,[]*[space|X],[[]*[space|X]|P]-P).
91movehead([X|Y]*Z,l,Y*[X|Z], [Y*[X|Z]|P]-P).
92
93macro_def(q(A,B,r,Q), if(A,[put(B),right,Q])).
94macro_def(q(A,B,l,Q), if(A,[put(B),left,Q])).
95macro_def(q(A,B,0,Q), if(A,[put(B),Q])).
96macro_def(home,until(marked(_),left)).
97macro_def(find(A),find_right(A)).
98macro_def(find_right(A),until(A,right)).
99macro_def(find_left(A),until(A,left)).
100macro_def(if(A,T),if(A,T,nop)).
101macro_def(unless(A,D),if(A,nop,D)).
102macro_def(while(X,Y),if(X,[Y,while(X,Y)])).
103macro_def(until(X,Y),unless(X,[Y,until(X,Y)])).
104macro_def(insert_region(A,B),
105 [left, mark, right,
106 until(A, [get(x), mark, find(B), insert($x), home, unmark, right]),
107 home, unmark, right
108 ]).
109macro_def(shift(A),shift_right(A)).
110macro_def(shift_right(A),
111 [mark, find_right(A),
112 until(marked(_), [get(shift),right,put($shift),left,left]),
113 unmark,get(shift),right,put($shift),left
114 ]).
115macro_def(shift_left(A),
116 [mark, find_left(A),
117 until(marked(_), [get(shift),left,put($shift),right,right]),
118 unmark,get(shift),left,put($shift),right
119 ]).
120
121exec([],X,X,F-F,P-P).
122exec([C|R],X,Y,F,H):- exec(C,R,X,Y,F,H).
123exec(C,X,Y,F,H):- exec(C,[],X,Y,F,H).
124
125exec(halt,_,X,X,F-F,P-P).
126exec(if(A,T,E),R,X,Y,F-G,H):- evalref(A,A1,F), exec_if(A1,T,E,R,X,Y,F-G,H).
127exec([],R,X,Y,F,H):- exec(R,X,Y,F,H).
128exec([C|D],R,X,Y,F,H):- exec(C,[D|R],X,Y,F,H).
129exec(C,R,X,Y,F,H):- macro_def(C,D), exec(D,R,X,Y,F,H).
130exec(C,R,X,Y,F,H):- def(C,D),exec(D,R,X,Y,F,H).
131exec(C,R,X,Y,F1-F2,P-Q):- exec_basic(C,X,Z,F1-F3,P-P1),
132 exec(R,Z,Y,F3-F2,P1-Q).
133
134exec_basic(nop,X,X,F-F,P-P).
135exec_basic(left,X,Y,F-F,H):- movehead(X,l,Y,H).
136exec_basic(right,X,Y,F-F,H):- movehead(X,r,Y,H).
137exec_basic(mark,X,Y,F-F,H):- exec_mark(X,Y,H).
138exec_basic(unmark,X,Y,F-F,H):- exec_unmark(X,Y,H).
139exec_basic(get(X),Y,Z,F-G,H):- evalref(X,X1,F), exec_get(X1,Y,Z,F-G,H).
140exec_basic(put(X),Y,Z,F-G,H):- evalref(X,X1,F), exec_put(X1,Y,Z,F-G,H).
141exec_basic(insert(A),X,Y,F-G,H):- evalref(A,A1,F),
142 exec_insert(A1,X,Y,F-G,H).
143exec_basic(set(A,B),X,X,F-[A1=B1|G],P-P):- evalref(A,A1,F),
144 evalref(B,B1,F), delete(F,A=_,G).
145
146evalref($(X),Y,A):-evalref(X,Y1,A), member(Y1=Y,A).
147evalref(X,X,_).
148
149exec_if(A,T,E,R,X*[],Y,F,[X*[space]|P]-Q):-
150 exec_if(A,T,E,R,X*[space],Y,F,P-Q).
151exec_if(A,T,_,R,X*[A|Y],Z,F,H):- exec([T|R],X*[A|Y], Z,F,H).
152exec_if(_,_,E,R,X,Y,F,H):- exec([E|R],X,Y,F,H).
153
154exec_get(A, Y*[],Y*[space],F-[A=space|F1],[Y*[space]|P]-P):-
155 delete(F,A=_,F1).
156exec_get(A, Y*[X|Z],Y*[X|Z],F-[A=X|F1],[Y*[X|Z]|P]-P):- delete(F,A=_,F1).
157
158exec_put(A,Y*[],Y*[A],F-F,[Y*[A]|P]-P).
159exec_put(A,Y*[_|Z],Y*[A|Z],F-F,[Y*[A|Z]|P]-P).
160
161exec_insert(A,X*Y,X*[A|Y],F-F,[X*[A|Y]|P]-P).
162
163exec_mark(X*[A|Y],X*[marked(A)|Y],[X*[marked(A)|Y]|P]-P).
164exec_mark(X*[],X*[marked(space)],[X*[marked(space)]|P]-P).
165
166exec_unmark(X*[marked(A)|Y],X*[A|Y],[X*[A|Y]|P]-P)