From: Mark Thom Date: Sun, 13 May 2018 20:10:48 +0000 (-0600) Subject: parse the list functor X-Git-Tag: v0.8.110~465^2~5 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=175a5db5d7946cc017d3122647f4117b50e22627;p=scryer-prolog.git parse the list functor --- diff --git a/src/prolog/ast.rs b/src/prolog/ast.rs index f17c97cd..4eb14547 100644 --- a/src/prolog/ast.rs +++ b/src/prolog/ast.rs @@ -22,6 +22,8 @@ pub type Var = String; pub type Specifier = u32; +pub const MAX_ARITY: usize = 63; + pub const XFX: u32 = 0x0001; pub const XFY: u32 = 0x0002; pub const YFX: u32 = 0x0004; diff --git a/src/prolog/lib/builtins.pl b/src/prolog/lib/builtins.pl index 006fed1e..c55ba5d6 100644 --- a/src/prolog/lib/builtins.pl +++ b/src/prolog/lib/builtins.pl @@ -3,8 +3,8 @@ :- module(builtins, [(=)/2, (+)/2, (*)/2, (-)/2, (/)/2, (/\)/2, (\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, - (-)/1, (>=)/2, (=<)/2, (->)/2, (;)/2, (==)/2, (\==)/2, arg/3, - catch/3, throw/1, true/0, false/0, length/2]). + (-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (==)/2, (\==)/2, + (=..)/2, arg/3, catch/3, throw/1, true/0, false/0, length/2]). % arithmetic operators. :- op(700, xfx, is). @@ -33,6 +33,7 @@ % unify. :- op(700, xfx, =). +:- op(700, xfx, =..). % conditional operators. :- op(1050, xfy, ->). @@ -105,14 +106,12 @@ length(Xs, N) :- '$skip_max_list'(M, -1, Xs, Xs0), ( Xs0 == [] -> N = M ; var(Xs0) -> '$length_addendum'(Xs0, N, M)). - % ; throw(error(type_error(list, Xs), length/2))). length(Xs, N) :- integer(N), N >= 0, !, '$skip_max_list'(M, N, Xs, Xs0), ( Xs0 == [] -> N = M ; var(Xs0) -> R is N-M, '$length_rundown'(Xs0, R)). - % ; throw(error(type_error(list, Xs), length/2))). length(_, N) :- integer(N), !, throw(error(domain_error(not_less_than_zero, N), length/2)). @@ -128,3 +127,27 @@ length(_, N) :- '$length_rundown'([_|Xs], N) :- N1 is N-1, '$length_rundown'(Xs, N1). + +Term =.. List :- + atomic(Term), !, + List = [Term]. +Term =.. List :- + compound(Term), !, + ( functor(Term, Name, NArgs) -> + List = [Name|Args], '$get_args'(Args, Term, 1, NArgs) + ; Term = [_|_] -> + List = ['.'|Term] ). +Term =.. List :- + var(Term), !, + ( List = [ATerm], atomic(ATerm) -> + Term = ATerm + ; List = [Name|Args] -> + functor(Term, Name, Args)). + +'$get_args'(Args, _, _, 0) :- + !, Args = []. +'$get_args'([Arg], Func, N, N) :- + !, '$get_arg'(N, Func, Arg). +'$get_args'([Arg|Args], Func, I0, N) :- + '$get_arg'(I0, Func, Arg), I1 is I0 + 1, + '$get_args'(Args, Func, I1, N). diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index a220cf9b..c232bb4d 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -10,8 +10,8 @@ pub(super) type MachineStub = Vec; // from 7.12.2 b) of 13211-1:1995 #[derive(Clone, Copy)] pub enum ValidType { -// Atom, -// Atomic, + Atom, + Atomic, // Byte, Callable, // Character, @@ -30,8 +30,8 @@ pub enum ValidType { impl ValidType { pub fn as_str(self) -> &'static str { match self { -// ValidType::Atom => "atom", -// ValidType::Atomic => "atomic", + ValidType::Atom => "atom", + ValidType::Atomic => "atomic", // ValidType::Byte => "byte", ValidType::Callable => "callable", // ValidType::Character => "character", @@ -49,6 +49,19 @@ impl ValidType { } } +#[derive(Clone, Copy)] +pub enum DomainError { + NotLessThanZero +} + +impl DomainError { + pub fn as_str(self) -> &'static str { + match self { + DomainError::NotLessThanZero => "not_less_than_zero" + } + } +} + // from 7.12.2 f) of 13211-1:1995 #[derive(Clone, Copy)] pub enum RepFlag { @@ -198,6 +211,10 @@ impl MachineState { error } + pub(super) fn domain_error(&self, error: DomainError, culprit: Addr) -> MachineError { + functor!("domain_error", 2, [heap_atom!(error.as_str()), HeapCellValue::Addr(culprit)]) + } + pub(super) fn instantiation_error(&self) -> MachineError { functor!("instantiation_error") } diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 71374ae9..cf133ed9 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -43,7 +43,7 @@ impl MachineState { mode: MachineMode::Write, and_stack: AndStack::new(), or_stack: OrStack::new(), - registers: vec![Addr::HeapCell(0); 64], + registers: vec![Addr::HeapCell(0); MAX_ARITY + 1], // self.registers[0] is never used. trail: Vec::new(), tr: 0, hb: 0, @@ -105,7 +105,7 @@ impl MachineState { }, None => {} } - } + } } pub(super) @@ -168,6 +168,21 @@ impl MachineState { self.bind(Ref::StackCell(fr, sc), d2), (_, Addr::StackCell(fr, sc)) => self.bind(Ref::StackCell(fr, sc), d1), + (Addr::Lis(a1), Addr::Str(a2)) | (Addr::Str(a2), Addr::Lis(a1)) => { + if let &HeapCellValue::NamedStr(n2, ref f2, _) = &self.heap[a2] { + if f2.as_str() == "." && n2 == 2 { + pdl.push(Addr::HeapCell(a1)); + pdl.push(Addr::HeapCell(a2 + 1)); + + pdl.push(Addr::HeapCell(a1 + 1)); + pdl.push(Addr::HeapCell(a2 + 2)); + + continue; + } + } + + self.fail = true; + }, (Addr::Lis(a1), Addr::Lis(a2)) => { pdl.push(Addr::HeapCell(a1)); pdl.push(Addr::HeapCell(a2)); @@ -175,11 +190,10 @@ impl MachineState { pdl.push(Addr::HeapCell(a1 + 1)); pdl.push(Addr::HeapCell(a2 + 1)); }, - (Addr::Con(c1), Addr::Con(c2)) => { + (Addr::Con(c1), Addr::Con(c2)) => if c1 != c2 { self.fail = true; - } - }, + }, (Addr::Str(a1), Addr::Str(a2)) => { let r1 = &self.heap[a1]; let r2 = &self.heap[a2]; @@ -1415,69 +1429,91 @@ impl MachineState { } } + fn try_functor_unify_components(&mut self, name: Addr, arity: Addr) { + let a2 = self[temp_v!(2)].clone(); + let a3 = self[temp_v!(3)].clone(); + + self.unify(a2, name); + + if !self.fail { + self.unify(a3, arity); + } + } + + fn try_functor_compound_case(&mut self, name: ClauseName, arity: usize) { + let name = Addr::Con(Constant::Atom(name)); + let arity = Addr::Con(integer!(arity)); + + self.try_functor_unify_components(name, arity); + } + pub(super) fn try_functor(&mut self) -> Result<(), MachineError> { let stub = self.functor_stub(clause_name!("functor"), 3); let a1 = self.store(self.deref(self[temp_v!(1)].clone())); match a1.clone() { + Addr::Con(_) => + self.try_functor_unify_components(a1, Addr::Con(integer!(0))), Addr::Str(o) => match self.heap[o].clone() { - HeapCellValue::NamedStr(arity, name, _) => { - let name = Addr::Con(Constant::Atom(name)); // A2 - let arity = Addr::Con(Constant::Number(rc_integer!(arity))); - - let a2 = self[temp_v!(2)].clone(); - self.unify(a2, name); - - if !self.fail { - let a3 = self[temp_v!(3)].clone(); - self.unify(a3, arity); - } - }, + HeapCellValue::NamedStr(arity, name, _) => + self.try_functor_compound_case(name, arity), _ => self.fail = true }, + Addr::Lis(_) => + self.try_functor_compound_case(clause_name!("."), 2), Addr::HeapCell(_) | Addr::StackCell(_, _) => { let name = self.store(self.deref(self[temp_v!(2)].clone())); let arity = self.store(self.deref(self[temp_v!(3)].clone())); - if let Addr::Con(Constant::Atom(name)) = name { - if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity { - let f_a = Addr::Str(self.heap.h); - let arity = match arity.to_usize() { - Some(arity) => arity, - None => { - self.fail = true; - return Ok(()); - } - }; - - if arity > 0 { - self.heap.push(HeapCellValue::NamedStr(arity, name, None)); - } else { - let c = Constant::Atom(name.clone()); - self.heap.push(HeapCellValue::Addr(Addr::Con(c))); - } + if name.is_ref() || arity.is_ref() { // 8.5.1.3 a) & 8.5.1.3 b) + return Err(self.error_form(self.instantiation_error(), stub)); + } - for _ in 0 .. arity { - let h = self.heap.h; - self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h))); + if let Addr::Con(Constant::Number(Number::Integer(arity))) = arity { + let arity = match arity.to_isize() { + Some(arity) => arity, + None => { + self.fail = true; + return Ok(()); } + }; - self.unify(a1, f_a); - } else { - return Err(self.error_form(self.instantiation_error(), stub)); + if arity > MAX_ARITY as isize { + // 8.5.1.3 f) + return Err(self.error_form(self.representation_error(RepFlag::MaxArity), + stub)); + } else if arity < 0 { + // 8.5.1.3 g) + return Err(self.error_form(self.domain_error(DomainError::NotLessThanZero, + Addr::Con(integer!(arity))), + stub)); } - } else { - return Err(self.error_form(self.instantiation_error(), stub)); - } - }, - _ => { - let a2 = self[temp_v!(2)].clone(); - self.unify(a1, a2); - if !self.fail { - let a3 = self[temp_v!(3)].clone(); - self.unify(a3, Addr::Con(Constant::Number(rc_integer!(0)))); + match name { + Addr::Con(_) if arity == 0 => + self.unify(a1, name), + Addr::Con(Constant::Atom(name)) => { + let f_a = Addr::Str(self.heap.h); + self.heap.push(HeapCellValue::NamedStr(arity as usize, name, None)); + + for _ in 0 .. arity { + let h = self.heap.h; + self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h))); + } + + self.unify(a1, f_a); + }, + Addr::Con(_) => + return Err(self.error_form(self.type_error(ValidType::Atom, name), + stub)), // 8.5.1.3 e) + _ => + return Err(self.error_form(self.type_error(ValidType::Atomic, name), + stub)) // 8.5.1.3 c) + }; + } else if !arity.is_ref() { + // 8.5.1.3 d) + return Err(self.error_form(self.type_error(ValidType::Integer, arity), stub)); } } }; diff --git a/src/prolog/macros.rs b/src/prolog/macros.rs index 9019233c..79ecb6f5 100644 --- a/src/prolog/macros.rs +++ b/src/prolog/macros.rs @@ -164,12 +164,6 @@ macro_rules! integer { ) } -macro_rules! rc_integer { - ($e:expr) => ( - Number::Integer(Rc::new(BigInt::from($e))) - ) -} - macro_rules! rc_atom { ($e:expr) => ( Rc::new(String::from($e)) diff --git a/src/prolog/parser b/src/prolog/parser index 7f9094ea..ae747778 160000 --- a/src/prolog/parser +++ b/src/prolog/parser @@ -1 +1 @@ -Subproject commit 7f9094eaedf235ffacb7c49f098593f22957fcfc +Subproject commit ae747778688290ecf1c80b68cf34cf28bffac9f8 diff --git a/src/tests.rs b/src/tests.rs index 6a8ae689..42b6e3e5 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -1381,7 +1381,7 @@ fn test_queries_on_builtins() 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).", + assert_prolog_success!(&mut wam, "?- catch(length(a, []), type_error(integer, E), true).", [["E = []"]]); assert_prolog_success!(&mut wam, "?- duplicate_term([1,2,3], [X,Y,Z]).",