support hidden predicates

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@578 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.21 2002-07-23 15:49:06 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.22 2002-09-02 17:33:00 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -382,7 +382,7 @@ AllocCodeSpace(unsigned int size)
 #include "windows.h"
 
 #define BASE_ADDRESS  ((LPVOID) MMAP_ADDR)
-#define MAX_WORKSPACE 0x20000000L
+#define MAX_WORKSPACE 0x80000000L
 
 static LPVOID brk;
 

C/cdmgr.c

@@ -2283,6 +2283,47 @@ p_hide_predicate(void)
   return(TRUE);
 }
 
+static Int			/* $hidden_predicate(P) */
+p_hidden_predicate(void)
+{
+  PredEntry      *pe;
+
+  Term t1 = Deref(ARG1);
+  SMALLUNSGN mod = LookupModule(Deref(ARG2));
+
+ restart_system_pred:
+  if (IsVarTerm(t1))
+    return (FALSE);
+  if (IsAtomTerm(t1)) {
+    pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), mod));
+  } else if (IsApplTerm(t1)) {
+    Functor         funt = FunctorOfTerm(t1);
+    if (IsExtensionFunctor(funt)) {
+      return(FALSE);
+    } 
+    if (funt == FunctorModule) {
+      Term nmod = ArgOfTerm(1, t1);
+      if (IsVarTerm(nmod)) {
+	Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
+	return(FALSE);
+      } 
+      if (!IsAtomTerm(nmod)) {
+	Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
+	return(FALSE);
+      }
+      t1 = ArgOfTerm(2, t1);
+      goto restart_system_pred;
+    }
+    pe = RepPredProp(GetPredPropByFunc(funt, mod));
+  } else if (IsPairTerm(t1)) {
+    return (TRUE);
+  } else
+    return (FALSE);
+  if (EndOfPAEntr(pe))
+    return(FALSE);
+  return(pe->PredFlags & HiddenPredFlag);
+}
+
 static Int			/* $cut_transparent(P) */
 p_cut_transparent(void)
 {
@@ -2358,5 +2399,6 @@ InitCdMgr(void)
   InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
   InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
   InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
+  InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
 }
 

C/stdpreds.c

@@ -64,6 +64,8 @@ STD_PROTO(static Int init_current_atom, (void));
 STD_PROTO(static Int cont_current_atom, (void));
 STD_PROTO(static Int init_current_predicate, (void));
 STD_PROTO(static Int cont_current_predicate, (void));
+STD_PROTO(static Int init_current_predicate_for_atom, (void));
+STD_PROTO(static Int cont_current_predicate_for_atom, (void));
 STD_PROTO(static OpEntry *NextOp, (OpEntry *));
 STD_PROTO(static Int init_current_op, (void));
 STD_PROTO(static Int cont_current_op, (void));
@@ -1397,12 +1399,58 @@ static Int
 init_current_predicate(void)
 {
   Term t1 = Deref(ARG1);
+  Term t2 = Deref(ARG2);
 
   if (IsVarTerm(t1) || !IsAtomTerm(t1)) cut_fail();
-  EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)ModulePred[LookupModule(t1)]);
+  if (IsVarTerm(t2) || !IsAtomTerm(t2)) cut_fail();
+  EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)ModulePred[LookupModule(t1)]);
   return (cont_current_predicate());
 }
 
+static Int 
+cont_current_predicate_for_atom(void)
+{
+  Prop pf = (Prop)IntegerOfTerm(EXTRA_CBACK_ARG(3,1));
+  SMALLUNSGN mod = LookupModule(Deref(ARG2));
+
+  while (pf != NIL) {
+    FunctorEntry *pp = RepFunctorProp(pf);
+    if (IsFunctorProperty(pp->KindOfPE)) {
+      Prop p0 = pp->PropsOfFE;
+      while (p0) {
+	PredEntry *p = RepPredProp(p0);
+	if (p->ModuleOfPred == mod ||
+	    p->ModuleOfPred == 0) {
+	  /* we found the predicate */
+	  EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextOfPE));
+	  return(unify(ARG3,MkNewApplTerm(p->FunctorOfPred,p->ArityOfPE)));
+	}
+	p0 = p->NextOfPE;
+      }
+    } else if (pp->KindOfPE == PEProp) {
+      PredEntry *pe = RepPredProp(pf);
+      if (pe->ModuleOfPred == mod ||
+	  pe->ModuleOfPred == 0) {
+	/* we found the predicate */
+	EXTRA_CBACK_ARG(3,1) = (CELL)MkIntegerTerm((Int)(pp->NextOfPE));
+	return(unify(ARG3,MkAtomTerm((Atom)(pe->FunctorOfPred))));
+      }
+    }
+    pf = pp->NextOfPE;
+  }
+  cut_fail();
+}
+
+static Int 
+init_current_predicate_for_atom(void)
+{
+  Term t1 = Deref(ARG1);
+
+  if (IsVarTerm(t1) || !IsAtomTerm(t1)) cut_fail();
+  EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)RepAtom(AtomOfTerm(t1))->PropsOfAE);
+  return (cont_current_predicate_for_atom());
+}
+
 static OpEntry *
 NextOp(OpEntry *pp)
 {
@@ -2120,6 +2168,8 @@ InitBackCPreds(void)
 		SafePredFlag|SyncPredFlag);
   InitCPredBack("$current_predicate", 3, 1, init_current_predicate, cont_current_predicate,
 		SafePredFlag|SyncPredFlag);
+  InitCPredBack("$current_predicate_for_atom", 3, 1, init_current_predicate_for_atom, cont_current_predicate_for_atom,
+		SafePredFlag|SyncPredFlag);
   InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
 		SafePredFlag|SyncPredFlag);
   InitBackIO();

pl/debug.yap

@@ -264,7 +264,7 @@ debugging :-
 	'$spy'([NM|NG]).
 '$spy'([Module|G]) :-
 %    '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
-         '$hidden'(G),
+         '$hidden_predicate'(G,Module),
          !,
 	 /* called from prolog module   */
 	 '$execute0'(G,Module),

pl/preds.yap

@@ -384,7 +384,7 @@ abolish(X) :-
 
 '$new_abolish'(V,M) :- var(V), !,
 	'$abolish_all'(M).
-'$new_abolish'(A,M) :- var(A), !,
+'$new_abolish'(A,M) :- atom(A), !,
 	'$abolish_all_atoms'(A,M).
 '$new_abolish'(M:PS,_) :- !,
 	'$new_abolish'(PS,M).
@@ -407,7 +407,7 @@ abolish(X) :-
 '$abolish_all'(_).
 
 '$abolish_all_atoms'(Na, M) :-
-        '$current_predicate'(M,Na,Ar),
+        '$current_predicate_for_atom'(Na,M,Ar),
 	'$new_abolish'(Na/Ar, M),
 	fail.
 '$abolish_all_atoms'(_,_).
@@ -476,7 +476,7 @@ abolish(X) :-
 '$abolish_all_old'(_).
 
 '$abolish_all_atoms_old'(Na, M) :-
-        '$current_predicate'(M, Na, Ar),
+        '$current_predicate_for_atom'(Na, M, Ar),
 	'$abolish'(Na, Ar, M),
 	fail.
 '$abolish_all_atoms_old'(_,_).

pl/protect.yap

@@ -19,32 +19,16 @@
 % and also makes it impossible from some predicates to be seen
 '$protect' :-
 	current_atom(Name),
-	'$make_system_preds'(Name),
+	atom_codes(Name,[0'$|_]),
-	atom_codes(Name,[36|_]),
+	'$hide_predicates'(Name),
 	'$hide'(Name).
 '$protect'.
 
-'$make_system_preds'('$directive') :- !.
+'$hide_predicates'(Name) :-
-'$make_system_preds'('$meta_predicate') :- !.
+	'$current_predicate_for_atom'(Name, prolog, P),
-'$make_system_preds'('$exec_directive') :- !.
+	'$hide_predicate'(P,prolog),
-'$make_system_preds'(goal_expansion) :- !.
-'$make_system_preds'(term_expansion) :- !.
-'$make_system_preds'(portray) :- !.
-'$make_system_preds'(library_directory) :- !.
-'$make_system_preds'(modules_with_attributes) :- !.
-'$make_system_preds'(woken_att_do) :- !.
-'$make_system_preds'(convert_att_var) :- !.
-'$make_system_preds'(Name) :- 
-%	'$format'("~NProtecting ~a",Name),
-	'$pred_defined_for'(Name,Pred),
-%	'$format'("~NProtecting ~q",Pred),	
-	'$protect_system_pred'(Pred),
 	fail.
-'$make_system_preds'(_).
+'$hide_predicates'(_).
-
-'$protect_system_pred'(Pred) :-
-	'$flags'(Pred,OldFlags,OldFlags\/8'40000).
-	
 
 % hide all atoms who start by '$'
 '$hide'('$VAR') :- !, fail.			/* not $VAR */