diff --git a/C/utilpreds.c b/C/utilpreds.c index 8cbce9246..1c507f6dc 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -5148,10 +5148,41 @@ static Int p_skip_list( USES_REGS1 ) { Term *tail; Int len = Yap_SkipList(XREGS+2, &tail); + return Yap_unify(MkIntegerTerm(len), ARG1) && Yap_unify(*tail, ARG3); } +static Int +p_skip_list4( USES_REGS1 ) { + Term *tail; + Int len = Yap_SkipList(XREGS+1, &tail); + Term t2 = Deref(ARG2), t = *tail; + + if (!IsVarTerm(t2)) { + Int len1; + if (!IsIntegerTerm(t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "length/2"); + return FALSE; + } + if ((len1 = IntegerOfTerm(t2)) < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "length/2"); + return FALSE; + } + if (t == TermNil) + return + len1 == len && + Yap_unify(*tail, ARG4); + } + /* don't set M0 if full list, just check M */ + if (t == TermNil) { + return Yap_unify_constant(ARG4, TermNil) && + Yap_unify_constant(ARG2, MkIntegerTerm(len)); + } + return Yap_unify(MkIntegerTerm(len), ARG3) && + Yap_unify(t, ARG4); +} + void Yap_InitUtilCPreds(void) { CACHE_REGS @@ -5174,6 +5205,7 @@ void Yap_InitUtilCPreds(void) Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); /* use this carefully */ Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); + Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); Yap_InitCPred("term_hash", 4, p_term_hash, 0); diff --git a/pl/sort.yap b/pl/sort.yap index 2fe9e44d6..2b250e5a1 100644 --- a/pl/sort.yap +++ b/pl/sort.yap @@ -25,10 +25,10 @@ % length of a list. length(L, M) :- - '$skip_list'(M0, L, R), - ( R == [] -> M = M0 ; + '$skip_list'(L, M, M0, R), + ( R == [] -> true ; var(R) -> '$$_length'(R, M, M0) ; - '$do_error'(type_error(list,L),length(L,M)) + L \= [_|_], '$do_error'(type_error(list,L),length(L,M)) ). %