18
19:- module(dcg_pair, [
20 (\<)//1
21 , (\>)//1
22 , (<\>)//2
23 , (\#)//2
24 , run_left//3
25 , run_right//3
26 , transduce/3
27
28 , op(900,fy,\<)
29 , op(900,fy,\>)
30 , op(900,xfx,<\>)
31 , op(900,xfy,\#)
32 ]).
50:- meta_predicate
51 run_left(//,?,?,?,?)
52 , run_right(//,?,?,?,?)
53 , transduce(//,?,?)
54 , \<(//,?,?)
55 , \>(//,?,?)
56 , <\>(//,//,?,?)
57 , \#(?,//,?,?)
. 59
60:- op(900,fy,\<). 61:- op(900,fy,\>). 62:- op(900,xfy,\#).
67\<(P,A1-B,A2-B) :- call_dcg(P,A1,A2).
73\>(P,A-B1,A-B2) :- call_dcg(P,B1,B2).
79<\>(A,B,L1-R1,L2-R2) :- call_dcg(A,L1,L2), call_dcg(B,R1,R2).
86run_left(P,S1,S2,T1,T2) :- call_dcg(P,S1-T1,S2-T2).
93run_right(P,S1,S2,T1,T2) :- call_dcg(P,T1-S1,T2-S2).
100\#(N, P, S1, S2) :- with_nth_arg(N,P,S1,S2).
106transduce(Trans, In, Out) :- arbno(Trans, In-Out, []-[]).
107
109arbno(P) --> []; call_dcg(P), arbno(P).
110
111
113
114with_nth_arg(K,P,T1,T2) :-
115 functor(T1,F,N),
116 functor(T2,F,N),
117 with_nth_arg(N,K,P,T1,T2).
118
119with_nth_arg(K,K,P,T1,T2) :-
120 arg(K,T1,C1), call_dcg(P,C1,C2),
121 arg(K,T2,C2), succ(N,K),
122 copy_args(N,T1,T2).
123
124with_nth_arg(N,K,P,T1,T2) :-
125 arg(N,T1,C),
126 arg(N,T2,C),
127 succ(M,N),
128 with_nth_arg(M,K,P,T1,T2).
129
130copy_args(0,_,_) :- !.
131copy_args(N,T1,T2) :-
132 succ(M,N), arg(N,T1,X), arg(N,T2,X),
133 copy_args(M,T1,T2)
Paired state DCG utilities