Skip to content

Commit

Permalink
expand module names in transitive goals (#2255)
Browse files Browse the repository at this point in the history
  • Loading branch information
@mthom
mthom committed Jan 2, 2024
1 parent 1dc546a commit ccf581d
Showing 1 changed file with 58 additions and 38 deletions.
96 changes: 58 additions & 38 deletions src/loader.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -299,7 +299,7 @@
( atom(Module) ->
prolog_load_context(module, Target),
module_expanded_head_variables(Head2, HeadVars),
catch(expand_goal(Body0, Target, Body1, HeadVars),
catch(expand_goal(Body0, Target, Body1, HeadVars, []),
error(type_error(callable, Pred), _),
( loader:print_goal_expansion_warning(Pred),
builtins:(Body1 = Body0)
Expand All @@ -309,7 +309,7 @@
)
; module_expanded_head_variables(Head1, HeadVars),
prolog_load_context(module, Target),
catch(expand_goal(Body0, Target, Body1, HeadVars),
catch(expand_goal(Body0, Target, Body1, HeadVars, []),
error(type_error(callable, Pred), _),
( loader:print_goal_expansion_warning(Pred),
builtins:(Body1 = Body0)
Expand Down Expand Up @@ -729,9 +729,9 @@
).


:- non_counted_backtracking expand_subgoal/5.
:- non_counted_backtracking expand_subgoal/6.

expand_subgoal(UnexpandedGoals, MS, M, ExpandedGoals, HeadVars) :-
expand_subgoal(UnexpandedGoals, MS, M, ExpandedGoals, HeadVars, TGs) :-
strip_subst_module(UnexpandedGoals, M, Module, UnexpandedGoals0),
nonvar(UnexpandedGoals0),
complete_partial_goal(MS, UnexpandedGoals0, _, SuppArgs, UnexpandedGoals1),
Expand All @@ -743,7 +743,7 @@
),
strip_subst_module(UnexpandedGoals3, Module, Module1, UnexpandedGoals4),
( inner_meta_specs(0, UnexpandedGoals4, _, MetaSpecs) ->
expand_module_names(UnexpandedGoals4, MetaSpecs, Module1, ExpandedGoals0, HeadVars)
expand_module_names(UnexpandedGoals4, MetaSpecs, Module1, ExpandedGoals0, HeadVars, TGs)
; ExpandedGoals0 = UnexpandedGoals4
),
'$compile_inline_or_expanded_goal'(ExpandedGoals0, SuppArgs, ExpandedGoals1, Module1, UnexpandedGoals0),
Expand Down Expand Up @@ -772,10 +772,10 @@

:- non_counted_backtracking eq_member/2.

eq_member(V, [L-_|Ls]) :-
eq_member(V-M, [L-M|Ls]) :-
V == L.
eq_member(V, [_|Ls]) :-
eq_member(V, Ls).
eq_member(V-M, [_|Ls]) :-
eq_member(V-M, Ls).

:- non_counted_backtracking qualified_spec/1.

Expand All @@ -785,11 +785,19 @@

:- non_counted_backtracking expand_meta_predicate_subgoals/5.

expand_meta_predicate_subgoals([SG | SGs], [MS | MSs], M, [ESG | ESGs], HeadVars) :-
expand_meta_predicate_subgoals([SG | SGs], [MS | MSs], M, [ESG | ESGs], HeadVars, TGs) :-
( var(SG) ->
( qualified_spec(MS) ->
( eq_member(SG, HeadVars) ->
( eq_member(SG-_, HeadVars) ->
ESG = SG
; eq_member(SG-TG, TGs),
% transitive goals come about from previous equalities:
% if SG was bound by (=)/2 to a potential goal TG earlier
% in the goal sequence, expand TG and substitute SG with it
% in this subgoal context. the binding to SG must not be
% changed.
expand_subgoal(TG, MS, M, ESG, HeadVars, TGs) ->
true
; expand_module_name(SG, MS, M, ESG)
)
; ESG = SG
Expand All @@ -798,53 +806,53 @@
expand_module_name(SG, MS, M, ESG)
; '$is_expanded_or_inlined'(SG) ->
ESG = SG
; expand_subgoal(SG, MS, M, ESG, HeadVars) ->
; expand_subgoal(SG, MS, M, ESG, HeadVars, TGs) ->
true
; integer(MS),
MS >= 0 ->
expand_module_name(SG, MS, M, ESG)
; SG = ESG
),
expand_meta_predicate_subgoals(SGs, MSs, M, ESGs, HeadVars).
expand_meta_predicate_subgoals(SGs, MSs, M, ESGs, HeadVars, TGs).

expand_meta_predicate_subgoals([], _, _, [], _).
expand_meta_predicate_subgoals([], _, _, [], _, _).

:- non_counted_backtracking expand_module_names/5.
:- non_counted_backtracking expand_module_names/6.

expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars) :-
expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars, TGs) :-
Goals =.. [GoalFunctor | SubGoals],
( GoalFunctor == (:),
SubGoals = [M, SubGoal] ->
expand_module_names(SubGoal, MetaSpecs, M, ExpandedSubGoal, HeadVars),
expand_module_names(SubGoal, MetaSpecs, M, ExpandedSubGoal, HeadVars, TGs),
expand_module_name(ExpandedSubGoal, 0, M, ExpandedGoals)
; expand_meta_predicate_subgoals(SubGoals, MetaSpecs, Module, ExpandedGoalList, HeadVars),
; expand_meta_predicate_subgoals(SubGoals, MetaSpecs, Module, ExpandedGoalList, HeadVars, TGs),
ExpandedGoals =.. [GoalFunctor | ExpandedGoalList]
).


:- non_counted_backtracking expand_goal/3.

expand_goal(UnexpandedGoals, Module, ExpandedGoals) :-
catch(loader:expand_goal(UnexpandedGoals, Module, ExpandedGoals, []),
catch(loader:expand_goal(UnexpandedGoals, Module, ExpandedGoals, [], []),
error(type_error(callable, _), _),
UnexpandedGoals = ExpandedGoals),
!.

:- non_counted_backtracking expand_goal/4.
:- non_counted_backtracking expand_goal/5.

expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars, TGs) :-
( var(UnexpandedGoals) ->
expand_module_names(call(UnexpandedGoals), [0], Module, ExpandedGoals, HeadVars)
expand_module_names(call(UnexpandedGoals), [0], Module, ExpandedGoals, HeadVars, TGs)
; goal_expansion(UnexpandedGoals, Module, UnexpandedGoals1),
( Module \== user ->
goal_expansion(UnexpandedGoals1, user, Goals)
; Goals = UnexpandedGoals1
),
( expand_goal_cases(Goals, Module, ExpandedGoals, HeadVars) ->
( expand_goal_cases(Goals, Module, ExpandedGoals, HeadVars, TGs) ->
true
; predicate_property(Module:Goals, meta_predicate(MetaSpecs0)),
MetaSpecs0 =.. [_ | MetaSpecs] ->
expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars)
expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars, TGs)
; thread_goals(Goals, ExpandedGoals, (','))
; Goals = ExpandedGoals
)
Expand Down Expand Up @@ -877,28 +885,40 @@
)
).

:- non_counted_backtracking expand_goal_cases/4.
:- non_counted_backtracking transitive_goal/3.

transitive_goal(G, TGs0, TGs1) :-
( G = (G1 = PotentialGoal),
callable(PotentialGoal),
subsumes_term(G1, PotentialGoal) ->
TGs1 = [G1-PotentialGoal|TGs0]
; TGs1 = TGs0
).

:- non_counted_backtracking expand_goal_cases/5.

expand_goal_cases((Goal0, Goals0), Module, ExpandedGoals, HeadVars) :-
( expand_goal(Goal0, Module, Goal1, HeadVars) ->
expand_goal(Goals0, Module, Goals1, HeadVars),
expand_goal_cases((Goal0, Goals0), Module, ExpandedGoals, HeadVars, TGs) :-
( expand_goal(Goal0, Module, Goal1, HeadVars, TGs) ->
transitive_goal(Goal0, TGs, TGs1),
expand_goal(Goals0, Module, Goals1, HeadVars, TGs1),
thread_goals(Goal1, ExpandedGoals, Goals1, (','))
; expand_goal(Goals0, Module, Goals1, HeadVars),
; expand_goal(Goals0, Module, Goals1, HeadVars, TGs),
ExpandedGoals = (Goal0, Goals1)
).
expand_goal_cases((Goals0 -> Goals1), Module, ExpandedGoals, HeadVars) :-
expand_goal(Goals0, Module, ExpandedGoals0, HeadVars),
expand_goal(Goals1, Module, ExpandedGoals1, HeadVars),
expand_goal_cases((Goals0 -> Goals1), Module, ExpandedGoals, HeadVars, TGs) :-
expand_goal(Goals0, Module, ExpandedGoals0, HeadVars, TGs),
transitive_goal(ExpandedGoals0, TGs, TGs1),
expand_goal(Goals1, Module, ExpandedGoals1, HeadVars, TGs1),
ExpandedGoals = (ExpandedGoals0 -> ExpandedGoals1).
expand_goal_cases((Goals0 ; Goals1), Module, ExpandedGoals, HeadVars) :-
expand_goal(Goals0, Module, ExpandedGoals0, HeadVars),
expand_goal(Goals1, Module, ExpandedGoals1, HeadVars),
expand_goal_cases((Goals0 ; Goals1), Module, ExpandedGoals, HeadVars, TGs) :-
expand_goal(Goals0, Module, ExpandedGoals0, HeadVars, TGs),
expand_goal(Goals1, Module, ExpandedGoals1, HeadVars, TGs),
ExpandedGoals = (ExpandedGoals0 ; ExpandedGoals1).
expand_goal_cases((\+ Goals0), Module, ExpandedGoals, HeadVars) :-
expand_goal(Goals0, Module, Goals1, HeadVars),
expand_goal_cases((\+ Goals0), Module, ExpandedGoals, HeadVars, TGs) :-
expand_goal(Goals0, Module, Goals1, HeadVars, TGs),
ExpandedGoals = (\+ Goals1).
expand_goal_cases((Module:Goals0), _, ExpandedGoals, HeadVars) :-
expand_goal(Goals0, Module, Goals1, HeadVars),
expand_goal_cases((Module:Goals0), _, ExpandedGoals, HeadVars, TGs) :-
expand_goal(Goals0, Module, Goals1, HeadVars, TGs),
ExpandedGoals = (Module:Goals1).

:- non_counted_backtracking thread_goals/3.
Expand Down

0 comments on commit ccf581d

Please sign in to comment.