fix current_predicate/1 and arg/3

C/cdmgr.c

@@ -138,8 +138,10 @@ restart:
       goto restart;
     }
     return RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
-  } else
+  } else {
-    return NULL;
+    Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
+  }
+  return NULL;
 }
 
 /** Look for a predicate with same functor as t,

C/inlines.c

@@ -665,6 +665,7 @@ p_arg( USES_REGS1 )
 	pt0 = RepAppl(d1);
 	d1 = *pt0;
 	if (IsExtensionFunctor((Functor) d1)) {
+	  Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
 	  return(FALSE);
 	}
 	save_hb();
@@ -708,7 +709,7 @@ p_arg( USES_REGS1 )
 	ENDP(pt0);
       }
       else {
-	/* Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3"); */
+	Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
 	return(FALSE);
       }
 

C/prim_absmi_insts.h

@@ -2390,6 +2390,9 @@
         pt0 = RepAppl(d1);
         d1 = *pt0;
         if (IsExtensionFunctor((Functor) d1)) {
+          saveregs();
+          Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
+          setregs();
           FAIL();
         }
         if ((Int)d0 <= 0 ||
@@ -2427,12 +2430,9 @@
         ENDP(pt0);
       }
       else {
-        /*
-          don't complain here for SWI Prolog compatibility
           saveregs();
           Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
           setregs();
-        */
         FAIL();
       }
 
@@ -2481,6 +2481,9 @@
         pt0 = RepAppl(d1);
         d1 = *pt0;
         if (IsExtensionFunctor((Functor) d1)) {
+          saveregs();
+          Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
+          setregs();
           FAIL();
         }
         if ((Int)d0 <= 0 ||
@@ -2518,12 +2521,9 @@
         ENDP(pt0);
       }
       else {
-        /*
+	saveregs();
-          keep SWI Prolog compatibility, just fail on trying to obtain an argument of a compound term.
+	Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
-          saveregs();
+	setregs();
-          Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
-          setregs();
-        */
         FAIL();
       }
 
@@ -2579,6 +2579,9 @@
         pt0 = RepAppl(d1);
         d1 = *pt0;
         if (IsExtensionFunctor((Functor) d1)) {
+	saveregs();
+	Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
+	setregs();
           FAIL();
         }
         if ((Int)d0 <= 0 ||
@@ -2622,12 +2625,9 @@
         ENDP(pt0);
       }
       else {
-        /*
-          don't complain here for SWI Prolog compatibility
           saveregs();
           Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
           setregs();
-        */
         FAIL();
       }
 
@@ -2677,7 +2677,10 @@
         pt0 = RepAppl(d1);
         d1 = *pt0;
         if (IsExtensionFunctor((Functor) d1)) {
-          FAIL();
+           saveregs();
+          Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
+          setregs();
+         FAIL();
         }
         if ((Int)d0 <= 0 ||
             (Int)d0 > ArityOfFunctor((Functor) d1)) {
@@ -2720,12 +2723,9 @@
         ENDP(pt0);
       }
       else {
-        /*
-          don't complain here for SWI Prolog compatibility
           saveregs();
           Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
           setregs();
-        */
         FAIL();
       }
 

pl/error.yap

@@ -18,6 +18,7 @@
 	    existence_error/2,		% +Type, +Term
 	    permission_error/3,		% +Action, +Type, +Term
             must_be_instantiated/1,        % +Term
+            must_bind_to_type/2,        % +Type, ?Term
 	    instantiation_error/1,	% +Term
 	    representation_error/1, 	% +Reason
 	    is_of_type/2		% +Type, +Term
@@ -139,6 +140,12 @@ must_be_of_type(Type, X, _Comment) :-
 	;   is_not(Type, X)
 	).
 
+must_bind_to_type(Type, X) :-
+	(   may_bind_to_type(Type, X), writeln(X)
+	->  true
+	;   is_not(Type, X)
+	).
+
 %%	@predicate is_not(+Type, @Term)
 %
 %	Throws appropriate error. It is _known_ that Term is not of type
@@ -237,6 +244,64 @@ has_type(string, X)	  :- string(X).
 has_type(stream, X)	  :- is_stream(X).
 has_type(list(Type), X)	  :- is_list(X), element_types(X, Type).
 
+%%	may_bind_to_type(+Type, @Term) is semidet.
+%
+%	True if _Term_ or term _Term\theta_ satisfies _Type_.
+
+may_bind_to_type(_, X ) :- var(X), !.
+may_bind_to_type(impossible, _) :-	instantiation_error(_).
+may_bind_to_type(any, _).
+may_bind_to_type(atom, X)	  :- atom(X).
+may_bind_to_type(atomic, X)	  :- atomic(X).
+may_bind_to_type(between(L,U), X) :- (   integer(L)
+			     ->  integer(X), between(L,U,X)
+			     ;   number(X), X >= L, X =< U
+			     ).
+may_bind_to_type(boolean, X) 	  :- (X==true;X==false), !.
+may_bind_to_type(callable, X)	  :- callable(X).
+may_bind_to_type(chars,	X)	  :- chars(X).
+may_bind_to_type(codes,	X)	  :- codes(X).
+may_bind_to_type(text, X)	  :- text(X).
+may_bind_to_type(compound, X)	  :- compound(X).
+may_bind_to_type(constant, X)	  :- atomic(X).
+may_bind_to_type(float, X)	  :- float(X).
+may_bind_to_type(ground, X)	  :- ground(X).
+may_bind_to_type(integer, X)	  :- integer(X).
+may_bind_to_type(nonneg, X)	  :- integer(X), X >= 0.
+may_bind_to_type(positive_integer, X)	  :- integer(X), X > 0.
+may_bind_to_type(negative_integer, X)	  :- integer(X), X < 0.
+may_bind_to_type(predicate_indicator, X)  :-
+	(
+	 X = M:PI
+	->
+	 may_bind_to_type( atom, M),
+	 may_bind_to_type(predicate_indicator, PI)
+	;
+	 X = N/A
+	->
+	 may_bind_to_type( atom, N),
+	 may_bind_to_type(integer, A)
+	;
+	 X = N//A
+	->
+	 may_bind_to_type( atom, N),
+	 may_bind_to_type(integer, A)
+	).
+
+
+may_bind_to_type(nonvar, _X).
+may_bind_to_type(number, X)	  :- number(X).
+may_bind_to_type(oneof(L), X)	  :- ground(X), lists:memberchk(X, L).
+may_bind_to_type(proper_list, X)  :- is_list(X).
+may_bind_to_type(list, X)  	  :- is_list(X).
+may_bind_to_type(list_or_partial_list, X)  :- is_list_or_partial_list(X).
+may_bind_to_type(symbol, X)	  :- atom(X).
+may_bind_to_type(var, X)	  :- var(X).
+may_bind_to_type(rational, X)	  :- rational(X).
+may_bind_to_type(string, X)	  :- string(X).
+may_bind_to_type(stream, X)	  :- is_stream(X).
+may_bind_to_type(list(Type), X)	  :- is_list(X), element_types(X, Type).
+
 chars(0) :- !, fail.
 chars([]).
 chars([H|T]) :-

pl/preds.yap

@@ -674,7 +674,7 @@ system_predicate(A, P0) :-
 
 
 /**
-  @pred  current_predicate( _F_) is iso
+  @pred  current_predicate( F ) is iso
 
   True if _F_ is the predicate indicator for a currently defined user or
   library predicate.The indicator  _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
@@ -683,32 +683,34 @@ system_predicate(A, P0) :-
 */
 current_predicate(F0) :-
 	'$yap_strip_module'(F0, M, F),
-  '$c_i_predicate'( F, M ).
+	must_bind_to_type( predicate_indicator, F ),
+	'$c_i_predicate'( F, M ).
 
 '$c_i_predicate'( A/N, M ) :-
-  !,
+	!,
-	( nonvar(A), nonvar(N) ->
+	(
-   functor(S, A, N),
+	 ground(A/N)
+	->
+	 atom(A), integer(N),
+	 functor(S, A, N),
 	 current_predicate(A, M:S)
 	;
-    current_predicate(A, M:S),
+	 current_predicate(A, M:S),
-    functor(S, A, N)
+	 functor(S, A, N)
-  ).
+	 ).
 '$c_i_predicate'( A//N, M ) :-
-  !,
+	(
-	( nonvar(A), nonvar(N) ->
+	 ground(A)
-   N2 is N+2,
+	->
-   functor(S, A, N2),
+	 atom(A), integer(N),
+	 N2 is N+2,
+	 functor(S, A, N2),
 	 current_predicate(A, M:S)
 	;
-    current_predicate(A, M:S),
+	 current_predicate(A, M:S),
-    functor(S, A, N2),
+	 functor(S, A, N2),
-    N is N-2
+	 N is N2-2
-  ).
+	).
-'$c_i_predicate'( F, M ) :-
-    '$do_error'(type_error(predicate_indicator,F),
-                current_predicate(M:F)).
-
 
 '$imported_predicate'(A, G, ImportingMod, G, Flags) :-
 	'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),