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

quote values and goals in equations, eliminate dead code, correct retract/1

Browse Source
This commit is contained in:
Mark Thom
2019-11-16 17:15:25 -07:00
parent ed985c3cfe
commit cee3dbc453
5 changed files with 76 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/prolog/lib/builtins.pl
View File

@@ -150,7 +150,8 @@ comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
','(!, Atom, B) :- Atom == !, '$set_cp'(B).
','(!, G, B) :- '$set_cp'(B), G.
','(G, CF, B) :- compound(CF),
'$call_with_default_policy'(CF = ','(G1, G2)), !, G,
'$call_with_default_policy'(CF = ','(G1, G2)),
!, G,
'$call_with_default_policy'(comma_errors(G1, G2, B)).
','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B).
','(G1, G2, _) :- G1, G2.
@@ -567,7 +568,7 @@ first_match_index([Clause0 | Clauses], Clause1, N0, N) :-
; N0 = N, Clause0 = Clause1
).
retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :-
retract_clauses([Clause | Clauses0], Head, Body, Name, Arity) :-
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses1),
first_match_index(Clauses1, (Head :- Body), 0, N),
@@ -575,7 +576,7 @@ retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :-
; true
),
'$retract_clause'(Name, Arity, N, Clauses1).
retract_clauses([_|Clauses0], Head, Body, Name, Arity) :-
retract_clauses([_ | Clauses0], Head, Body, Name, Arity) :-
retract_clauses(Clauses0, Head, Body, Name, Arity).
call_retract(Head, Body, Name, Arity) :-

40
src/prolog/machine/dynamic_database.rs
View File

@@ -30,7 +30,7 @@ impl Machine {
match module.as_str() {
"user" => compile_user_module(self, src, true, user_src),
_ => compile_into_module(self, module, src, name)
_ => compile_into_module(self, module, src, name)
}
}
None => compile_user_module(self, src, true, user_src),
@@ -76,16 +76,27 @@ impl Machine {
output.result()
}
fn make_undefined(&mut self, name: ClauseName, arity: usize) {
if let Some(idx) = self.indices.code_dir.get(&(name, arity)) {
set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
}
}
fn make_undefined_in_module(&mut self, module_name: ClauseName, name: ClauseName, arity: usize) {
if let Some(idx) = self.indices.code_dir.get(&(name, arity)) {
if idx.module_name() == module_name {
set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
}
}
}
fn abolish_dynamic_clause(&mut self, name: RegType, arity: RegType) {
let (name, arity) = self.get_predicate_key(name, arity);
if let Some(idx) = self.indices.code_dir.get(&(name.clone(), arity)) {
set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
}
self.make_undefined(name.clone(), arity);
self.indices.remove_code_index((name.clone(), arity));
self.indices
.remove_clause_subsection(name.owning_module(), name, arity);
self.indices.remove_clause_subsection(name.owning_module(), name, arity);
}
fn abolish_dynamic_clause_in_module(&mut self, name: RegType, arity: RegType, module: RegType) {
@@ -106,15 +117,10 @@ impl Machine {
_ => unreachable!(),
};
if let Some(idx) = self.indices.code_dir.get(&(name.clone(), arity)) {
if idx.module_name() == module_name {
set_code_index!(idx, IndexPtr::DynamicUndefined, clause_name!("user"));
}
}
self.make_undefined_in_module(module_name.clone(), name.clone(), arity);
self.indices.remove_code_index((name.clone(), arity));
self.indices
.remove_clause_subsection(module_name, name, arity);
self.indices.remove_clause_subsection(module_name, name, arity);
}
fn handle_eval_result_from_dynamic_compile(
@@ -210,6 +216,10 @@ impl Machine {
let mut addrs = VecDeque::from(addrs);
addrs.remove(index);
if addrs.is_empty() {
self.make_undefined(name.clone(), arity);
}
self.print_new_dynamic_clause(addrs, name.clone(), arity)
}
Err(err) => return self.machine_st.throw_exception(err),
@@ -239,6 +249,10 @@ impl Machine {
let mut addrs = VecDeque::from(addrs);
addrs.remove(index);
if addrs.is_empty() {
self.make_undefined(name.clone(), arity);
}
self.print_new_dynamic_clause(addrs, name.clone(), arity)
}
Err(err) => return self.machine_st.throw_exception(err),

207
src/prolog/machine/mod.rs
View File

@@ -240,14 +240,14 @@ impl Machine {
pub fn run_init_code(&mut self, code: Code) -> bool {
let old_machine_st = self.sink_to_snapshot();
self.machine_st.reset();
self.machine_st.reset();
self.code_repo.cached_query = code;
self.run_query();
let result = self.machine_st.fail;
self.absorb_snapshot(old_machine_st);
!result
}
@@ -307,7 +307,7 @@ impl Machine {
if wam.compile_top_level().is_err() {
panic!("Loading '$toplevel' module failed");
}
wam.compile_scryerrc();
wam
@@ -466,10 +466,10 @@ impl Machine {
if !module.is_impromptu_module {
self.indices.use_module(&mut self.code_repo, self.machine_st.flags, &module)?;
}
Ok(self.indices.insert_module(module))
});
self.code_repo.cached_query = cached_query;
if let Err(e) = result {
@@ -537,64 +537,6 @@ impl Machine {
self.throw_session_error(e, (clause_name!("repl"), 0));
}
}
/*
REPLCodePtr::SubmitQueryAndPrintResults => {
let term = self.machine_st[temp_v!(1)].clone();
let stub = MachineError::functor_stub(clause_name!("repl"), 0);
let s = match self.machine_st.try_from_list(temp_v!(2), stub) {
Ok(addrs) => {
let mut var_dict = HeapVarDict::new();
for addr in addrs {
match addr {
Addr::Str(s) => {
let var_atom = match self.machine_st.heap[s + 1].as_addr(s + 1)
{
Addr::Con(Constant::Atom(var_atom, _)) => {
Rc::new(var_atom.to_string())
}
_ => unreachable!(),
};
let var_addr = self.machine_st.heap[s + 2].as_addr(s + 2);
var_dict.insert(var_atom, var_addr);
}
_ => unreachable!(),
};
}
self.machine_st.heap_locs = var_dict;
let term_output = self.machine_st.print_query(term, &self.indices.op_dir);
term_output.result()
}
Err(err_stub) => {
self.machine_st.throw_exception(err_stub);
return;
}
};
let stream = parsing_stream(s.as_bytes());
let snapshot = self.sink_to_snapshot();
let policies = mem::replace(&mut self.policies, MachinePolicies::new());
self.machine_st.reset();
self.machine_st.heap = mem::replace(
&mut self.inner_heap,
Heap::with_capacity(0),
);
let result = match stream_to_toplevel(stream, self) {
Ok(packet) => compile_term(self, packet),
Err(e) => EvalSession::from(e),
};
self.handle_eval_session(result, snapshot);
self.indices.reset_global_variable_offsets();
self.policies = policies;
}
*/
REPLCodePtr::UseModule =>
self.use_module(ModuleSource::Library),
REPLCodePtr::UseModuleFromFile =>
@@ -610,7 +552,7 @@ impl Machine {
fn sink_to_snapshot(&mut self) -> MachineState {
let mut snapshot = MachineState::with_capacity(0);
snapshot.hb = self.machine_st.hb;
snapshot.e = self.machine_st.e;
snapshot.b = self.machine_st.b;
@@ -618,6 +560,12 @@ impl Machine {
snapshot.s = self.machine_st.s;
snapshot.tr = self.machine_st.tr;
snapshot.pstr_tr = self.machine_st.pstr_tr;
snapshot.p = self.machine_st.p.clone();
snapshot.cp = self.machine_st.cp;
snapshot.attr_var_init = mem::replace(
&mut self.machine_st.attr_var_init,
AttrVarInitializer::new(0, 0)
);
snapshot.num_of_args = self.machine_st.num_of_args;
snapshot.fail = self.machine_st.fail;
@@ -631,12 +579,13 @@ impl Machine {
snapshot.block = self.machine_st.block;
snapshot.ball = self.machine_st.ball.take();
snapshot.heap_locs = mem::replace(&mut self.machine_st.heap_locs, IndexMap::new());
snapshot.lifted_heap = mem::replace(&mut self.machine_st.lifted_heap, vec![]);
snapshot
}
fn absorb_snapshot(&mut self, mut snapshot: MachineState) {
fn absorb_snapshot(&mut self, mut snapshot: MachineState) {
self.machine_st.hb = snapshot.hb;
self.machine_st.e = snapshot.e;
self.machine_st.b = snapshot.b;
@@ -644,6 +593,9 @@ impl Machine {
self.machine_st.s = snapshot.s;
self.machine_st.tr = snapshot.tr;
self.machine_st.pstr_tr = snapshot.pstr_tr;
self.machine_st.p = snapshot.p;
self.machine_st.cp = snapshot.cp;
self.machine_st.attr_var_init = snapshot.attr_var_init;
self.machine_st.num_of_args = snapshot.num_of_args;
self.machine_st.fail = snapshot.fail;
@@ -661,131 +613,10 @@ impl Machine {
self.machine_st.block = snapshot.block;
self.machine_st.ball = snapshot.ball.take();
self.machine_st.heap_locs = mem::replace(&mut snapshot.heap_locs, IndexMap::new());
self.machine_st.lifted_heap = mem::replace(&mut snapshot.lifted_heap, vec![]);
}
/*
fn handle_eval_session(&mut self, result: EvalSession, snapshot: MachineState) {
match result {
EvalSession::InitialQuerySuccess(alloc_locs) => loop {
let bindings = {
let output = PrinterOutputter::new();
self.toplevel_heap_view(output).result()
};
let attr_goals = self.attribute_goals();
if !(self.machine_st.b > 0) {
if bindings.is_empty() {
let space = if requires_space(&attr_goals, ".") {
" "
} else {
""
};
if !attr_goals.is_empty() {
println!("{}{}.", attr_goals, space);
} else {
println!("true.");
}
self.absorb_snapshot(snapshot);
return;
}
} else if bindings.is_empty() && attr_goals.is_empty() {
print!("true");
stdout().flush().unwrap();
}
if !attr_goals.is_empty() {
if bindings.is_empty() {
print!("{}", attr_goals);
} else {
print!("{}, {}", bindings, attr_goals);
}
} else if !bindings.is_empty() {
print!("{}", bindings);
}
if self.machine_st.b > 0 {
let keypress = {
let mut raw_stdout = stdout().into_raw_mode().unwrap();
raw_stdout.flush().unwrap();
next_keypress()
};
let result = match keypress {
ContinueResult::ContinueQuery => {
print!(" ;\n");
self.continue_query(&alloc_locs)
}
ContinueResult::Conclude => {
print!(" ...\n");
self.absorb_snapshot(snapshot);
return;
}
};
match result {
EvalSession::QueryFailure => {
if self.machine_st.ball.stub.len() > 0 {
self.propagate_exception_to_toplevel(snapshot);
return;
} else {
print!("false.\n");
self.absorb_snapshot(snapshot);
return;
}
}
EvalSession::Error(err) => {
self.absorb_snapshot(snapshot);
self.throw_session_error(err, (clause_name!("repl"), 0));
return;
}
_ => {}
}
} else {
if bindings.is_empty() && attr_goals.is_empty() {
print!("true.\n");
} else {
let space = if !attr_goals.is_empty() {
if requires_space(&attr_goals, ".") {
" "
} else {
""
}
} else {
if requires_space(&bindings, ".") {
" "
} else {
""
}
};
print!("{}.\n", space);
}
break;
}
},
EvalSession::Error(err) => {
self.absorb_snapshot(snapshot);
self.throw_session_error(err, (clause_name!("repl"), 0));
return;
}
EvalSession::QueryFailure =>
if self.machine_st.ball.stub.len() > 0 {
return self.propagate_exception_to_toplevel(snapshot);
} else {
println!("false.");
},
_ => println!("true.")
}
self.absorb_snapshot(snapshot);
}
*/
pub(super) fn run_query(&mut self) {
self.machine_st.cp = LocalCodePtr::TopLevel(0, self.code_repo.size_of_cached_query());
let end_ptr = CodePtr::Local(self.machine_st.cp);
@@ -816,7 +647,7 @@ impl Machine {
self.code_repo.cached_query = cached_query;
}
_ =>
break
break
};
}
}

36
src/prolog/toplevel.pl
View File

@@ -3,11 +3,6 @@
:- use_module(library(lists)).
:- use_module(library(si)).
% internal operators defined for spacing purposes.
:- op(1200, xf, ('.')).
:- op(700, xfx, (' = ')).
:- op(1000, xfy, (', ')).
'$repl'(ListOfModules) :-
maplist('$use_list_of_modules', ListOfModules),
false.
@@ -49,6 +44,22 @@
; write('false.'), nl
).
'$write_goal'(G, VarList) :-
( G = (Var = Value) ->
write(Var),
write(' = '),
write_term(Value, [quoted(true), variable_names(VarList)])
; write_term(G, [quoted(true), variable_names(VarList)])
).
'$write_eq'((G1, G2), VarList) :-
!,
'$write_goal'(G1, VarList),
write(', '),
'$write_eq'(G2, VarList).
'$write_eq'(G, VarList) :-
'$write_goal'(G, VarList).
'$write_eqs_and_read_input'(B, VarList) :-
sort(VarList, SortedVarList),
'$get_b_value'(B0),
@@ -56,18 +67,19 @@
( B0 == B ->
( Goals == [] ->
write('true.'), nl
; thread_goals(Goals, ThreadedGoals, (', ')),
write_term((ThreadedGoals)., [quoted(false), variable_names(VarList)]),
; thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, VarList),
write(' .'),
nl
)
; repeat,
thread_goals(Goals, ThreadedGoals, (', ')),
write_term(ThreadedGoals, [quoted(false), variable_names(VarList)]),
thread_goals(Goals, ThreadedGoals, (',')),
'$write_eq'(ThreadedGoals, VarList),
'$raw_input_read_char'(C),
( C == (';'), !,
write_term(' ;', [quoted(false)]), nl, false
write(' ;'), nl, false
; C == ('.'), !,
write_term(' ...', [quoted(false)]), nl
write(' ...'), nl
)
).
@@ -86,7 +98,7 @@
'$fetch_attribute_goals'(Goals).
'$gather_goals'([Var = Value | Pairs], VarList, Goals) :-
( nonvar(Value) ->
Goals = [Var ' = ' Value | Goals0],
Goals = [Var = Value | Goals0],
'$gather_goals'(Pairs, VarList, Goals0)
; '$gather_goals'(Pairs, VarList, Goals)
).