34
35:- module(termpos, [op(1150, fx, (add_termpos))]). 36
37:- reexport(library(compound_expand)). 38:- use_module(library(apply)). 39:- use_module(library(lists)). 40:- use_module(library(transpose)). 41:- use_module(library(sequence_list)). 42:- use_module(library(list_sequence)). 43:- init_expansors. 44
45:- multifile '$add_termpos'/4. 46
47atp_expand_args(+, A, [ [], [A], [P], [], []]) --> [A, P]. 48atp_expand_args(-, A, [ [], [], [], [A], [P]]) --> [A, P]. 49atp_expand_args(?, A, [[A], [], [], [], []]) --> [A]. 50
51subterm_location_eq(Find, Term, Loc, Loc) :- Find==Term.
52subterm_location_eq(Find, Term, PPos, Loc) :-
53 nonvar(PPos),
54 PPos = parentheses_term_position(_, _, Pos),
55 !,
56 subterm_location_eq(Find, Term, Pos, Loc).
57subterm_location_eq(Find, Term, list_position(F, T, [EPos|LPos], TPos), Loc) :-
58 compound(Term),
59 Term = [E|L],
60 ( subterm_location_eq(Find, E, EPos, Loc)
61 ; subterm_location_eq(Find, L, list_position(F, T, LPos, TPos), Loc)
62 ).
63subterm_location_eq(Find, Term, term_position(_, _, _, _, PosL), Loc) :-
64 compound(Term),
65 arg(N, Term, Arg),
66 nth1(N, PosL, Pos),
67 subterm_location_eq(Find, Arg, Pos, Loc).
68subterm_location_eq(Find, Term, brace_term_position(_, _, Pos), Loc) :-
69 compound(Term),
70 Term = {Arg},
71 subterm_location_eq(Find, Arg, Pos, Loc).
72
73var_location(Term, Pos, Var, Loc) :-
74 ( subterm_location_eq(Var, Term, Pos, Loc)
75 ->true
76 ; true
77 ).
78
79collect_argpos(InL, InPosL, OutL, OutPosL, ArgPosLL) :-
80 maplist(transpose, [[InL, InPosL], [OutL, OutPosL]], ArgPosLLL),
81 append(ArgPosLLL, ArgPosLL).
82
83link_headpos(GArgPosLL, HArgPosLL) :-
84 foldl(link_argpos(HArgPosLL), GArgPosLL, NewArgPosLL, HArgPosLL),
85 b_setval('$argpos', NewArgPosLL).
86
87link_argpos(HArgPosLL, [Arg, Pos]) -->
88 ( { member([HArg, HPos], HArgPosLL),
89 HArg == Arg
90 }
91 ->{HPos = Pos}
92 ; [[Arg, Pos]]
93 ).
94
95normalize_pi(M, H1, C:H) :-
96 strip_module(M:H1, C, H).
97
98expand_pi(meta_predicate, M:H1, M:H) :-
99 ( termpos:'$add_termpos'(M, H1, H, [_, InL, InL, OutL, OutL])
100 ->true
101 ; H = H1
102 ).
103expand_pi(_, M:F1/A1, M:F/A) :-
104 functor(Head, F1, A1),
105 ( termpos:'$add_termpos'(M, Head, NewHead, _)
106 ->functor(NewHead, F, A)
107 ; F1/A1 = F/A
108 ).
109
110set_inpos(A, B) -->
111 ( {var(B)}
112 ->{A = B}
113 ; [ignore(A=B)]
114 ).
115
116term_expansion((:- add_termpos Spec),
117 termpos:'$add_termpos'(M, Head, NewHead, InOutArgPosLL)) :-
118 '$current_source_module'(M),
119 functor(Spec, F, A),
120 functor(Head, F, A),
121 Spec =.. [F|SArgL],
122 Head =.. [F|HArgL],
123 foldl(atp_expand_args, SArgL, HArgL, InOutArgPosLLL, NewArgL, []),
124 transpose(InOutArgPosLLL, InOutArgPosLLT),
125 maplist(append, InOutArgPosLLT, InOutArgPosLL),
126 NewHead =.. [F|NewArgL].
127term_expansion((Head :- Body), (NewHead :- Seq)) :-
128 nonvar(Head),
129 '$current_source_module'(M),
130 '$add_termpos'(M, Head, NewHead, LL),
131 LL = [IOL, InL, InPosL, OutL, OutPosL],
132 same_length(InPosL, InPos),
133 maplist(var_location(InL, list_position(_, _, InPos, _)), OutL, OutPosL),
134 collect_argpos(InL, InPos, OutL, OutPosL, APL),
135 b_setval('$termpos', [IOL, InL, InPos, OutL, OutPosL]),
136 b_setval('$argpos', APL),
137 expand_goal(Body, NewBody),
138 foldl(set_inpos, InPosL, InPos, List, [NewBody]),
139 list_sequence(List, Seq),
140 nb_delete('$termpos'),
141 nb_delete('$argpos').
142term_expansion((:- Decl1), (:- Decl2)) :-
143 Decl1 =.. [F, PIs1],
144 current_op(1150, fx, F), 145 Decl2 =.. [F, PIL2],
146 sequence_list(PIs1, PIL1, []),
147 '$current_source_module'(M),
148 maplist(normalize_pi(M), PIL1, PIL),
149 maplist(expand_pi(F), PIL, PIL2),
150 PIL \= PIL2.
151term_expansion(Head, (NewHead :- Seq)) :-
152 '$current_source_module'(M),
153 '$add_termpos'(M, Head, NewHead, [_, InL, InPosL, OutL, OutPosL]),
154 maplist(var_location(InL, list_position(_, _, InPos, _)), OutL, OutPosL),
155 foldl(set_inpos, InPosL, InPos, List, []),
156 list_sequence(List, Seq).
157
158goal_expansion(Goal, NewGoal) :-
159 '$current_source_module'(M),
160 '$add_termpos'(M, Goal, NewGoal, GLL),
161 GLL = [_, InL, InPosL, OutL, OutPosL],
162 nb_current('$termpos', [_, HInL, HInPosL, _, _]),
163 maplist(var_location(HInL, list_position(_, _, HInPosL, _)), InL, InPosL),
164 maplist(var_location(HInL, list_position(_, _, HInPosL, _)), OutL, OutPosL),
165 maplist(var_location(InL, list_position(_, _, InPosL, _)), OutL, OutPosL),
166 maplist(var_location(InL, list_position(_, _, InPosL, _)), HInL, HInPosL),
167 collect_argpos(InL, InPosL, OutL, OutPosL, GAPL),
168 nb_current('$argpos', HAPL),
169 link_headpos(GAPL, HAPL)