From: Mark Thom Date: Sat, 27 Jan 2018 22:37:59 +0000 (-0700) Subject: add length, =.., more tests of builtins. X-Git-Tag: v0.8.110~600 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=4f645b4664ac7992c1730a9ef47c309c86b2e4d2;p=scryer-prolog.git add length, =.., more tests of builtins. --- diff --git a/README.md b/README.md index fc709ac8..56b71d28 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,7 @@ The following predicates are built-in to rusty-wam. * Comparison operators: `>`, `<`, `=<`, `>=`, `=:=`, `=\=`. * `(\+)/1` * `(=)/2` +* `(=..)/2` * `(->)/2` * `(;)/2` * `arg/3` @@ -89,6 +90,7 @@ The following predicates are built-in to rusty-wam. * `false/0` * `functor/3` * `integer/1` +* `length/2` * `throw/1` * `true/0` * `var/1` diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index ebbc5444..bc1d4804 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -820,7 +820,7 @@ pub enum ControlInstruction { FunctorExecute, JmpByCall(usize, usize), // arity, global_offset. JmpByExecute(usize, usize), - // GotoCall(usize, usize), // p, arity. + GotoCall(usize, usize), // p, arity. GotoExecute(usize, usize), // p, arity. IsCall(RegType, ArithmeticTerm), IsExecute(RegType, ArithmeticTerm), @@ -848,6 +848,7 @@ impl ControlInstruction { &ControlInstruction::FunctorExecute => true, &ControlInstruction::ThrowCall => true, &ControlInstruction::ThrowExecute => true, + &ControlInstruction::GotoCall(..) => true, &ControlInstruction::GotoExecute(..) => true, &ControlInstruction::Proceed => true, &ControlInstruction::IsCall(..) => true, diff --git a/src/prolog/builtins.rs b/src/prolog/builtins.rs index bb761027..33309da2 100644 --- a/src/prolog/builtins.rs +++ b/src/prolog/builtins.rs @@ -289,7 +289,154 @@ fn get_builtins(atom_tbl: TabledData) -> Code { dynamic_num_test!(cmp_ne!()), // =\=, 204. proceed!(), dynamic_num_test!(cmp_eq!()), // =:=, 206. - proceed!() + proceed!(), + try_me_else!(5), // =.., 208. + fact![get_var_in_fact!(temp_v!(3), 1), + get_list!(Level::Shallow, temp_v!(2)), + unify_value!(temp_v!(3)), + unify_constant!(Constant::EmptyList)], + is_atomic!(temp_v!(3)), + neck_cut!(), + proceed!(), + retry_me_else!(11), + allocate!(4), + get_level!(), + fact![get_var_in_fact!(perm_v!(3), 1), + get_list!(Level::Shallow, temp_v!(2)), + unify_variable!(temp_v!(2)), + unify_variable!(perm_v!(4))], + is_var!(perm_v!(4)), + query![put_value!(perm_v!(3), 1), + put_var!(perm_v!(2), 3)], + functor_call!(), + cut!(), + query![put_unsafe_value!(4, 1), + put_value!(perm_v!(3), 2), + put_constant!(Level::Shallow, integer!(1), temp_v!(3)), + put_unsafe_value!(2, 4)], + deallocate!(), + goto_execute!(236, 4), // goto get_args/4. + trust_me!(), + allocate!(5), + get_level!(), + fact![get_var_in_fact!(perm_v!(3), 1), + get_list!(Level::Shallow, temp_v!(2)), + unify_variable!(perm_v!(5)), + unify_variable!(perm_v!(4))], + query![put_value!(perm_v!(4), 1), + put_var!(perm_v!(2), 2)], + goto_call!(261, 2), // goto length/2. + query![put_value!(perm_v!(3), 1), + put_value!(perm_v!(5), 2), + put_value!(perm_v!(2), 3)], + functor_call!(), + cut!(), + query![put_unsafe_value!(4, 1), + put_value!(perm_v!(3), 2), + put_constant!(Level::Shallow, integer!(1), temp_v!(3)), + put_unsafe_value!(2, 4)], + deallocate!(), + goto_execute!(236, 4), // goto get_args/4, 236. + try_me_else!(5), // get_args/4, 236. + fact![get_var_in_fact!(temp_v!(5), 1), + get_constant!(integer!(0), temp_v!(4))], + neck_cut!(), + query![put_value!(temp_v!(5), 1), + put_constant!(Level::Shallow, Constant::EmptyList, temp_v!(2))], + goto_execute!(73, 2), // goto =/2. + trust_me!(), + switch_on_term!(3, 0, 1, 0), + indexed_try!(3), + trust!(7), + try_me_else!(5), + fact![get_list!(Level::Shallow, temp_v!(1)), + unify_variable!(temp_v!(5)), + unify_constant!(Constant::EmptyList), + get_var_in_fact!(temp_v!(6), 2), + get_var_in_fact!(temp_v!(1), 3), + get_value!(temp_v!(1), 4)], + neck_cut!(), + query![put_value!(temp_v!(6), 2), + put_value!(temp_v!(5), 3)], + arg_execute!(), + trust_me!(), + allocate!(5), + fact![get_list!(Level::Shallow, temp_v!(1)), + unify_variable!(temp_v!(5)), + unify_variable!(perm_v!(4)), + get_var_in_fact!(perm_v!(3), 2), + get_var_in_fact!(perm_v!(5), 3), + get_var_in_fact!(perm_v!(1), 4)], + query![put_value!(perm_v!(5), 1), + put_value!(perm_v!(3), 2), + put_value!(temp_v!(5), 3)], + arg_call!(), + add!(ArithmeticTerm::Reg(perm_v!(5)), + ArithmeticTerm::Number(rc_integer!(1)), + 1), + query![put_var!(perm_v!(2), 1)], + is_call!(perm_v!(2), ArithmeticTerm::Interm(1)), + query![put_unsafe_value!(4, 1), + put_value!(perm_v!(3), 2), + put_unsafe_value!(2, 3), + put_value!(perm_v!(1), 4)], + deallocate!(), + goto_execute!(236, 4), // goto get_args/4, 236. + try_me_else!(6), // length/2, 261. + fact![get_var_in_fact!(temp_v!(4), 1), + get_var_in_fact!(temp_v!(3), 2)], + is_var!(temp_v!(3)), + neck_cut!(), + query![put_value!(temp_v!(4), 1), + put_constant!(Level::Shallow, integer!(0), temp_v!(2))], + goto_execute!(281, 3), // goto length/3, 281. + retry_me_else!(10), + allocate!(1), + get_level!(), + fact![get_var_in_fact!(temp_v!(4), 1), + get_var_in_fact!(temp_v!(3), 2)], + is_integer!(temp_v!(3)), + query![put_value!(temp_v!(4), 1), + put_constant!(Level::Shallow, integer!(0), temp_v!(2))], + goto_call!(281, 3), // goto length/3, 281. + cut!(), + deallocate!(), + proceed!(), + trust_me!(), + fact![get_var_in_fact!(temp_v!(3), 1), + get_var_in_fact!(temp_v!(4), 2)], + query![put_structure!(atom_tbl, + Level::Shallow, + String::from("type_error"), + 2, + temp_v!(1), + None), + set_constant!(atom!("integer_expected", atom_tbl)), + set_value!(temp_v!(4))], + goto_execute!(59, 1), // goto throw/1, 59. + switch_on_term!(1,2,5,0), // length/3, 281. + try_me_else!(3), + fact![get_constant!(Constant::EmptyList, temp_v!(1)), + get_var_in_fact!(temp_v!(4), 2), + get_value!(temp_v!(4), 3)], + proceed!(), + trust_me!(), + allocate!(3), + fact![get_list!(Level::Shallow, temp_v!(1)), + unify_void!(1), + unify_variable!(perm_v!(1)), + get_var_in_fact!(temp_v!(4), 2), + get_var_in_fact!(perm_v!(3), 3)], + add!(ArithmeticTerm::Reg(temp_v!(4)), + ArithmeticTerm::Number(rc_integer!(1)), + 1), + query![put_var!(perm_v!(2), 1)], + is_call!(perm_v!(2), ArithmeticTerm::Interm(1)), + query![put_unsafe_value!(1, 1), + put_unsafe_value!(2, 2), + put_value!(perm_v!(3), 3)], + deallocate!(), + goto_execute!(281, 3) // goto length/3, 281. ] } @@ -338,6 +485,8 @@ pub fn build_code_dir(atom_tbl: TabledData) -> (Code, CodeDir, OpDir) op_dir.insert((tabled_rc!(";", atom_tbl), Fixity::In), (XFY, 1100)); op_dir.insert((tabled_rc!("->", atom_tbl), Fixity::In), (XFY, 1050)); + op_dir.insert((tabled_rc!("=..", atom_tbl), Fixity::In), (XFX, 700)); + // there are 63 registers in the VM, so call/N is defined for all 0 <= N <= 62 // (an extra register is needed for the predicate name) for arity in 0 .. 63 { @@ -362,7 +511,7 @@ pub fn build_code_dir(atom_tbl: TabledData) -> (Code, CodeDir, OpDir) code_dir.insert((tabled_rc!("arg", atom_tbl), 3), (PredicateKeyType::BuiltIn, 150)); code_dir.insert((tabled_rc!("integer", atom_tbl), 1), (PredicateKeyType::BuiltIn, 147)); code_dir.insert((tabled_rc!("display", atom_tbl), 1), (PredicateKeyType::BuiltIn, 192)); - + code_dir.insert((tabled_rc!("is", atom_tbl), 2), (PredicateKeyType::BuiltIn, 194)); code_dir.insert((tabled_rc!(">", atom_tbl), 2), (PredicateKeyType::BuiltIn, 196)); code_dir.insert((tabled_rc!("<", atom_tbl), 2), (PredicateKeyType::BuiltIn, 198)); @@ -370,6 +519,9 @@ pub fn build_code_dir(atom_tbl: TabledData) -> (Code, CodeDir, OpDir) code_dir.insert((tabled_rc!("<=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 202)); code_dir.insert((tabled_rc!("=\\=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 204)); code_dir.insert((tabled_rc!("=:=", atom_tbl), 2), (PredicateKeyType::BuiltIn, 206)); + code_dir.insert((tabled_rc!("=..", atom_tbl), 2), (PredicateKeyType::BuiltIn, 208)); + code_dir.insert((tabled_rc!("length", atom_tbl), 2), (PredicateKeyType::BuiltIn, 261)); + (builtin_code, code_dir, op_dir) } diff --git a/src/prolog/io.rs b/src/prolog/io.rs index 4576639e..4c84bfbe 100644 --- a/src/prolog/io.rs +++ b/src/prolog/io.rs @@ -131,6 +131,8 @@ impl fmt::Display for ControlInstruction { write!(f, "deallocate"), &ControlInstruction::Execute(ref name, arity) => write!(f, "execute {}/{}", name, arity), + &ControlInstruction::GotoCall(p, arity) => + write!(f, "goto_call {}/{}", p, arity), &ControlInstruction::GotoExecute(p, arity) => write!(f, "goto_execute {}/{}", p, arity), &ControlInstruction::IsCall(r, ref at) => @@ -469,6 +471,8 @@ pub fn compile<'a, 'b: 'a>(wam: &'a mut Machine, tl: &'b TopLevelPacket) -> Eval return EvalSession::from(e); }; + print_code(&code); + if !code.is_empty() { if let Some(name) = tl.name() { wam.add_user_code(name, tl.arity(), code) diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index ce3586de..8fadde4a 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -1677,7 +1677,13 @@ impl MachineState { let val = self.try_functor(); self.p = self.cp; val - }), + }), + &ControlInstruction::GotoCall(p, arity) => { + self.cp = self.p + 1; + self.num_of_args = arity; + self.b0 = self.b; + self.p = CodePtr::DirEntry(p); + }, &ControlInstruction::GotoExecute(p, arity) => { self.num_of_args = arity; self.b0 = self.b; diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 50ebd443..564996d8 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -96,6 +96,12 @@ macro_rules! get_value { ) } +macro_rules! set_value { + ($r:expr) => ( + QueryInstruction::SetValue($r) + ) +} + macro_rules! get_var_in_fact { ($r:expr, $arg:expr) => ( FactInstruction::GetVariable($r, $arg) @@ -216,6 +222,12 @@ macro_rules! install_new_block { ) } +macro_rules! goto_call { + ($line:expr, $arity:expr) => ( + Line::Control(ControlInstruction::GotoCall($line, $arity)) + ) +} + macro_rules! goto_execute { ($line:expr, $arity:expr) => ( Line::Control(ControlInstruction::GotoExecute($line, $arity)) @@ -346,6 +358,24 @@ macro_rules! functor_execute { ) } +macro_rules! arg_execute { + () => ( + Line::Control(ControlInstruction::ArgExecute) + ) +} + +macro_rules! arg_call { + () => ( + Line::Control(ControlInstruction::ArgCall) + ) +} + +macro_rules! unify_value { + ($r:expr) => ( + FactInstruction::UnifyValue($r) + ) +} + macro_rules! unify_variable { ($r:expr) => ( FactInstruction::UnifyVariable($r) @@ -465,3 +495,15 @@ macro_rules! jmp_call { Line::Control(ControlInstruction::JmpByCall($arity, $offset)) ) } + +macro_rules! get_list { + ($lvl:expr, $r:expr) => ( + FactInstruction::GetList($lvl, $r) + ) +} + +macro_rules! unify_constant { + ($c:expr) => ( + FactInstruction::UnifyConstant($c) + ) +} diff --git a/src/tests.rs b/src/tests.rs index afd5414b..0d53753a 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1253,4 +1253,39 @@ fn test_queries_on_builtins() assert_prolog_failure!(&mut wam, "?- X is 3 + 3.5, call(integer, X)."); assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ call(integer, X)."); assert_prolog_success!(&mut wam, "?- X is 3 + 3.5, \\+ integer(X)."); + + assert_prolog_success!(&mut wam, "?- Func =.. [atom].", [["Func = atom"]]); + assert_prolog_success!(&mut wam, "?- Func =.. [\"sdf\"].", [["Func = \"sdf\""]]); + assert_prolog_success!(&mut wam, "?- Func =.. [1].", [["Func = 1"]]); + assert_prolog_success!(&mut wam, "?- catch(Func =.. [1,2], instantiation_error, true)."); + assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. List.", [["List = [f, 1, 2, 3]"]]); + assert_prolog_success!(&mut wam, "?- f(1,2,3) =.. [f,1,2,3]."); + assert_prolog_failure!(&mut wam, "?- f(1,2,3) =.. [f,1]."); + assert_prolog_failure!(&mut wam, "?- f(1,2,3) =.. [g,1,2,3]."); + + assert_prolog_success_with_limit!(&mut wam, "?- length(Xs, N).", + [["N = 0", "Xs = []"], + ["N = 1", "Xs = [_3]"], + ["N = 2", "Xs = [_3, _6]"], + ["N = 3", "Xs = [_3, _6, _9]"], + ["N = 4", "Xs = [_3, _6, _9, _12]"], + ["N = 5", "Xs = [_3, _6, _9, _12, _15]"]], + 6); + + assert_prolog_success!(&mut wam, "?- length(Xs, 3).", [["Xs = [_2, _5, _8]"]]); + assert_prolog_success!(&mut wam, "?- length([a,b,c], N).", [["N = 3"]]); + assert_prolog_success!(&mut wam, "?- length([], N).", [["N = 0"]]); + assert_prolog_success!(&mut wam, "?- length(Xs, 0).", [["Xs = []"]]); + assert_prolog_success!(&mut wam, "?- length([a,b,[a,b,c]], 3)."); + assert_prolog_failure!(&mut wam, "?- length([a,b,[a,b,c]], 2)."); + assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(_, E), true).", + [["E = []"]]); + + assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).", + [["Z = 3", "Y = 2", "X = 1"]]); + assert_prolog_success!(&mut wam, "?- duplicate_term(f(X, [a], Z), f(X, Y, Z)).", + [["X = _3", "Y = [a]", "Z = _5"]]); + assert_prolog_failure!(&mut wam, "?- duplicate_term(g(X), f(X))."); + assert_prolog_success!(&mut wam, "?- duplicate_term(f(X), f(X)).", + [["X = _1"]]); }