1/* Part of dcgutils 2 Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL) 3 4 This program is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public License 6 as published by the Free Software Foundation; either version 2 7 of the License, or (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17*/ 18 19:- module(dcg_macros, [use_dcg_macros/0]).

DCG utilities implememnted by term expansion.

This module provides term expansions for the following predicates and DCG goals:

nop//0
out//1
get//1
set//1
set_with//1
trans//2
(>>)//2
run_left//3
run_right//3
(\<)//1
(\>)//1
(<\>)//1
(//)//2
seqmap//N
seqmap_with_sep//N
do_then_call//N

41:- op(900,fy,\<). 42:- op(900,fy,\>). 43:- op(900,fy,<\>). 44:- op(900,xfy,\#). 45 46:- use_module(library(apply_macros)). 47 48mk_call(C,XX,Call) :- var(C), !, mk_call(call(C),XX,Call). 49mk_call(M:C,XX,M:Call) :- !, mk_call(C,XX,Call). 50mk_call(C,XX,Call) :- C =.. CL, append(CL,XX,CL2), Call =.. CL2. 51 52 53/* 54 * Goal expansions 55 */ 56 57use_dcg_macros. 58user:goal_expansion(G,E) :- 59 prolog_load_context(module,Mod), 60 predicate_property(Mod:use_dcg_macros, imported_from(dcg_macros)), 61 dcg_macros:expansion(G,E). 62 63cons(A,B,[A|B]). 64 65expand_seqmap_with_prefix(Sep0, Callable0, SeqmapArgs, Goal) :- 66 ( Callable0 = M:Callable -> NextGoal = M:NextCall, QPred = M:Pred 67 ; Callable = Callable0, NextGoal = NextCall, QPred = Pred 68 ), 69 70 append(Lists, [St1,St2], SeqmapArgs), 71 72 Callable =.. [Pred|Args], 73 length(Args, Argc), 74 length(Argv, Argc), 75 length(Lists, N), 76 length(Vars, N), 77 MapArity is N + 4, 78 format(atom(AuxName), '__aux_seqmap/~d_~w_~w+~d', [MapArity, Sep0, QPred, Argc]), 79 build_term(AuxName, Lists, Args, St1, St2, Goal), 80 81 AuxArity is N+Argc+2, 82 prolog_load_context(module, Module), 83 ( current_predicate(Module:AuxName/AuxArity) 84 -> true 85 ; length(BaseLists,N), 86 maplist(=([]),BaseLists), 87 length(Anon, Argc), 88 build_term(AuxName, BaseLists, Anon, S0, S0, BaseClause), 89 90 length(Vars,N), 91 maplist(cons, Vars, Tails, NextArgs), 92 ( Sep0=_:Sep -> true; Sep=Sep0 ), 93 ( is_list(Sep) -> append(Sep,S2,S1), NextThing=NextGoal 94 ; build_term(call_dcg, [Sep0], [], S1, S2, NextSep), 95 NextThing = (NextSep,NextGoal) 96 ), 97 build_term(Pred, Argv, Vars, S2, S3, NextCall1), 98 build_term(AuxName, Tails, Argv, S3, S4, NextIterate), 99 build_term(AuxName, NextArgs, Argv, S1, S4, NextHead), 100 101 ( expansion(NextCall1,NextCall) -> true 102 ; NextCall1=NextCall), 103 104 NextClause = (NextHead :- NextThing, NextIterate), 105 106 ( predicate_property(Module:NextGoal, transparent) 107 -> compile_aux_clauses([ (:- module_transparent(Module:AuxName/AuxArity)), 108 BaseClause, 109 NextClause 110 ]) 111 ; compile_aux_clauses([BaseClause, NextClause]) 112 ) 113 ). 114 115expand_call_with_prefix(Sep0, Callable0, InArgs, (SepGoal,CallGoal)) :- 116 append(CallArgs, [S1,S3], InArgs), 117 118 ( Sep0=_:Sep -> true; Sep=Sep0 ), 119 ( is_list(Sep) -> append(Sep,S2,SS), SepGoal=(S1=SS) 120 ; build_term(call_dcg, [Sep0], [], S1, S2, SepGoal) 121 ), 122 123 ( var(Callable0) 124 -> build_term(call,[Callable0], CallArgs, S2, S3, CallGoal1) 125 ; ( Callable0 = M:Callable 126 -> CallGoal1 = M:NextCall 127 ; Callable = Callable0, 128 CallGoal1 = NextCall 129 ), 130 Callable =.. [Pred|Args], 131 build_term(Pred, Args, CallArgs, S2, S3, NextCall) 132 ), 133 ( expansion(CallGoal1,CallGoal) -> true 134 ; CallGoal1=CallGoal 135 ). 136 137:- public 138 seqmap_with_sep_first_call//3, 139 seqmap_with_sep_first_call//5. 140 seqmap_with_sep_first_call//7. 141 142seqmap_with_sep_first_call(P,[A1|AX],AX) --> call(P,A1). 143seqmap_with_sep_first_call(P,[A1|AX],[B1|BX],AX,BX) --> call(P,A1,B1). 144seqmap_with_sep_first_call(P,[A1|AX],[B1|BX],[C1|CX],AX,BX,CX) --> call(P,A1,B1,C1). 145 146expand_seqmap_with_sep(Sep, Pred, SeqmapArgs, (dcg_macros:FirstCall,SeqmapCall)) :- 147 prolog_load_context(module,Context), 148 (Sep=SMod:Sep1 -> true; SMod=Context, Sep1=Sep), 149 (Pred=CMod:Pred1 -> true; CMod=Context, Pred1=Pred), 150 append(Lists, [St1,St3], SeqmapArgs), 151 length(Lists, N), 152 length(Tails, N), 153 build_term(seqmap_with_sep_first_call, [CMod:Pred1|Lists], Tails, St1, St2, FirstCall), 154 append(Tails,[St2,St3],SeqmapWPArgs), 155 expand_seqmap_with_prefix(SMod:Sep1,CMod:Pred1,SeqmapWPArgs,SeqmapCall). 156 % build_term(seqmap_with_prefix, [SMod:Sep1,CMod:Pred1], Tails, St2, St3, SeqmapCall). 157 158build_term(H,L1,L2,S1,S2,Term) :- 159 append(L2,[S1,S2],L23), 160 append(L1,L23,L123), 161 Term =.. [H | L123]. 162 163 164expand_dcg(Term, Goal) :- 165 functor(Term, seqmap, N), N >= 4, 166 Term =.. [seqmap, Callable | Args], 167 callable(Callable), !, 168 expand_seqmap_with_prefix([],Callable, Args, Goal). 169 170expand_dcg(Term, Goal) :- 171 functor(Term, seqmap_with_sep, N), N >= 5, 172 Term =.. [seqmap_with_sep, Sep, Callable | Args], 173 nonvar(Sep), callable(Callable), !, 174 expand_seqmap_with_sep(Sep, Callable, Args, Goal). 175 176expand_dcg(Term, Goal) :- 177 functor(Term, do_then_call, N), N >= 2, 178 Term =.. [do_then_call, Prefix, Callable | Args], 179 nonvar(Prefix), !, 180 expand_call_with_prefix(Prefix, Callable, Args, Goal). 181 182expansion( GoalIn, GoalOut) :- 183 \+current_prolog_flag(xref, true), 184 expand_dcg(GoalIn, GoalOut). 185expansion( run_left(P,S1,S2,T1,T2), call_dcg(P,(S1-T1),(S2-T2))). 186expansion( run_right(P,S1,S2,T1,T2), call_dcg(P,(T1-S1),(T2-S2))). 187expansion( \<(P,S1,S2), (S1=(L1-R),S2=(L2-R),call_dcg(P,L1,L2)) ). 188expansion( \>(P,S1,S2), (S1=(L-R1),S2=(L-R2),call_dcg(P,R1,R2)) ). 189expansion( <\>(A,B,S1,S2), (S1=L1-R1, S2=L2-R2, call_dcg(A,L1,L2), call_dcg(B,R1,R2))). 190 191expansion( nop(S1,S2), (S1=S2) ). 192expansion( out(X,S1,S2), (S1=[X|S2]) ). 193expansion( get(S,S1,S2), (S=S1,S1=S2) ). 194expansion( set(S,_,S2), (S=S2) ). 195expansion( A >> B, (A,B) ). 196expansion( set_with(C,_,S2), Call) :- mk_call(C,[S2],Call). 197expansion( trans(A1,A2,S1,S2), (S1=A1,S2=A2) ). 198expansion( //(P1,P2,S1,S2), (call_dcg(P1,S1,S2),call_dcg(P2,S1,S2)))