From cee3dbc453a409f4a1805a260e2b7e44e4a802c7 Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sat, 16 Nov 2019 17:15:25 -0700 Subject: [PATCH] quote values and goals in equations, eliminate dead code, correct retract/1 --- src/prolog/lib/builtins.pl | 7 +- src/prolog/machine/dynamic_database.rs | 40 +++-- src/prolog/machine/mod.rs | 207 +++---------------------- src/prolog/toplevel.pl | 36 +++-- src/tests.rs | 3 +- 5 files changed, 76 insertions(+), 217 deletions(-) diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 5c350a2f..8c018fcb 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -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) :- diff --git a/src/prolog/machine/dynamic_database.rs b/src/prolog/machine/dynamic_database.rs index 7ca996f8..17caf908 100644 --- a/src/prolog/machine/dynamic_database.rs +++ b/src/prolog/machine/dynamic_database.rs @@ -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), diff --git a/src/prolog/machine/mod.rs b/src/prolog/machine/mod.rs index f97afc20..051ad296 100644 --- a/src/prolog/machine/mod.rs +++ b/src/prolog/machine/mod.rs @@ -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 }; } } diff --git a/src/prolog/toplevel.pl b/src/prolog/toplevel.pl index d8e36a3d..b91313b6 100644 --- a/src/prolog/toplevel.pl +++ b/src/prolog/toplevel.pl @@ -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) ). diff --git a/src/tests.rs b/src/tests.rs index 6286acd4..f91b3f5f 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -289,6 +289,7 @@ fn test_queries_on_rules() { assert_prolog_success!(&mut wam, "p(X, Y).", [["X = x", "Y = _1"]]); + // p5, q5 submit(&mut wam, "p(X, Y) :- q(X, Y), r(X, Y)."); submit(&mut wam, "q(s, t)."); submit(&mut wam, "r(X, Y) :- r(a)."); @@ -580,7 +581,7 @@ fn test_queries_on_cuts() { submit( &mut wam, "memberchk(X, [X|_]) :- !. - memberchk(X, [_|Xs]) :- memberchk(X, Xs).", + memberchk(X, [_|Xs]) :- memberchk(X, Xs).", ); assert_prolog_success!(&mut wam, "memberchk(X, [a,b,c]).", [["X = a"]]); -- 2.54.0