rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use setup_cal_n_init_goal_info in dynamic_module_resolution

Browse Source
This commit is contained in:
Mark Thom
2022-06-15 22:32:05 -06:00
parent 987bbdecf5
commit cd1150c11d
2 changed files with 40 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/loader.pl
View File

@@ -690,6 +690,26 @@ expand_goal(UnexpandedGoals, Module, ExpandedGoals) :-
'$call'(UnexpandedGoals = ExpandedGoals)),
!.
:- non_counted_backtracking expand_goal/4.
expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
( var(UnexpandedGoals) ->
expand_module_names(call(UnexpandedGoals), [0], Module, ExpandedGoals, HeadVars)
; goal_expansion(UnexpandedGoals, Module, UnexpandedGoals1),
( Module \== user ->
goal_expansion(UnexpandedGoals1, user, Goals)
; Goals = UnexpandedGoals1
),
( expand_goal_cases(Goals, Module, ExpandedGoals, HeadVars) ->
true
; predicate_property(Module:Goals, meta_predicate(MetaSpecs0)),
MetaSpecs0 =.. [_ | MetaSpecs] ->
expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars)
; thread_goals(Goals, ExpandedGoals, (','))
; Goals = ExpandedGoals
)
).
:- non_counted_backtracking expand_goal_cases/4.
expand_goal_cases((Goal0, Goals0), Module, ExpandedGoals, HeadVars) :-
@@ -714,24 +734,19 @@ expand_goal_cases((Module:Goals0), _, ExpandedGoals, HeadVars) :-
expand_goal(Goals0, Module, Goals1, HeadVars),
ExpandedGoals = (Module:Goals1).
:- non_counted_backtracking expand_goal/4.
expand_goal(UnexpandedGoals, Module, ExpandedGoals, HeadVars) :-
( var(UnexpandedGoals) ->
expand_module_names(call(UnexpandedGoals), [0], Module, ExpandedGoals, HeadVars)
; goal_expansion(UnexpandedGoals, Module, UnexpandedGoals1),
( Module \== user ->
goal_expansion(UnexpandedGoals1, user, Goals)
; Goals = UnexpandedGoals1
),
( expand_goal_cases(Goals, Module, ExpandedGoals, HeadVars) ->
true
; predicate_property(Module:Goals, meta_predicate(MetaSpecs0)),
MetaSpecs0 =.. [_ | MetaSpecs] ->
expand_module_names(Goals, MetaSpecs, Module, ExpandedGoals, HeadVars)
; thread_goals(Goals, ExpandedGoals, (','))
; Goals = ExpandedGoals
:- non_counted_backtracking thread_goals/3.
thread_goals(Goals0, Goals1, Functor) :-
( var(Goals0) ->
Goals0 = Goals1
; Goals0 = [G | Gs] ->
( Gs = [] ->
Goals1 = G
; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
).
:- non_counted_backtracking thread_goals/4.
@@ -748,20 +763,6 @@ thread_goals(Goals0, Goals1, Hole, Functor) :-
; Goals1 =.. [Functor, Goals0, Hole]
).
:- non_counted_backtracking thread_goals/3.
thread_goals(Goals0, Goals1, Functor) :-
( var(Goals0) ->
Goals0 = Goals1
; Goals0 = [G | Gs] ->
( Gs = [] ->
Goals1 = G
; Goals1 =.. [Functor, G, Goals2],
thread_goals(Gs, Goals2, Functor)
)
; Goals1 = Goals0
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% call/{1-64} with dynamic goal expansion.

43
src/machine/system_calls.rs
View File

@@ -3014,46 +3014,21 @@ impl Machine {
self.machine_st.registers[1 + narity]
)));
let addr = self.machine_st.store(self.machine_st.deref(
let goal = self.machine_st.store(self.machine_st.deref(
self.machine_st.registers[2 + narity]
));
read_heap_cell!(addr,
(HeapCellValueTag::Str, a) => {
let (name, arity) = cell_as_atom_cell!(self.machine_st.heap[a])
.get_name_and_arity();
let (name, arity, s) = self.machine_st.setup_call_n_init_goal_info(goal, narity)?;
for i in (arity + 1..arity + narity + 1).rev() {
self.machine_st.registers[i] = self.machine_st.registers[i - arity];
}
for i in (arity + 1..arity + narity + 1).rev() {
self.machine_st.registers[i] = self.machine_st.registers[i - arity];
}
for i in 1..arity + 1 {
self.machine_st.registers[i] = self.machine_st.heap[s + i];
}
for i in 1..arity + 1 {
self.machine_st.registers[i] = self.machine_st.heap[a + i];
}
Ok((module_name, (name, arity + narity)))
}
(HeapCellValueTag::Atom, (name, _arity)) => {
Ok((module_name, (name, narity)))
}
(HeapCellValueTag::Char, c) => {
let key = (self.machine_st.atom_tbl.build_with(&c.to_string()), narity);
Ok((module_name, key))
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::StackVar | HeapCellValueTag::Var) => {
let stub = functor_stub(atom!("call"), 1);
let err = self.machine_st.instantiation_error();
Err(self.machine_st.error_form(err, stub))
}
_ => {
let stub = functor_stub(atom!("call"), narity);
let err = self.machine_st.type_error(ValidType::Callable, addr);
Err(self.machine_st.error_form(err, stub))
}
)
Ok((module_name, (name, arity + narity)))
}
#[inline(always)]