correct support for goal expansion (bug report from Paulo Moura)

C/cdmgr.c

@@ -1656,7 +1656,7 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
   yamop *pt = cp;
 
   if (is_logupd(p)) {
-    if (p == PredGoalExpansion) {
+    if (p == PredGoalExpansion || p->FunctorOfPred == FunctorGoalExpansion2) {
       PRED_GOAL_EXPANSION_ON = TRUE;
       Yap_InitComma();
     }
@@ -1711,7 +1711,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
 {
   yamop    *ncp = ((DynamicClause *)NULL)->ClCode;
   DynamicClause   *cl;
-  if (p == PredGoalExpansion) {
+  if (p == PredGoalExpansion || p->FunctorOfPred == FunctorGoalExpansion2) {
     PRED_GOAL_EXPANSION_ON = TRUE;
     Yap_InitComma();
   }
@@ -2093,6 +2093,7 @@ mark_preds_with_this_func(Functor f, Prop p0)
   for (i = 0; i < PredHashTableSize; i++) {
     PredEntry *p = PredHash[i];
 
+    /* search the whole pred table, kind of inneficient */
     while (p) {
       Prop nextp = p->NextOfPE;
       if (p->FunctorOfPred == f)
@@ -2102,6 +2103,109 @@ mark_preds_with_this_func(Functor f, Prop p0)
   }
 }
 
+static void
+mark_preds_with_this_atom(Prop p)
+{
+  while (p) {
+    Prop nextp = p->NextOfPE;
+    if (p->KindOfPE == PEProp)
+      RepPredProp(p)->PredFlags |= GoalExPredFlag;	    
+    p = nextp;
+  }
+}
+
+static void
+goal_expansion_support(PredEntry *p, Term tf)
+{
+  if (p == PredGoalExpansion) {
+    Term tg = ArgOfTerm(1, tf);
+    Term tm = ArgOfTerm(2, tf);
+
+    if (IsVarTerm(tg) || IsVarTerm(tm)) {
+      if (!IsVarTerm(tg)) {
+	/* this is the complicated case, first I need to inform
+	   predicates for this functor */ 
+	PRED_GOAL_EXPANSION_FUNC = TRUE;
+	if (IsAtomTerm(tg)) {
+	  AtomEntry *ae = RepAtom(AtomOfTerm(tg));
+	  Prop p0 = ae->PropsOfAE;
+	  int found = FALSE;
+
+	  while (p0) {
+	    PredEntry *pe = RepPredProp(p0);
+	    if (pe->KindOfPE == PEProp) {
+	      pe->PredFlags |= GoalExPredFlag;
+	      found = TRUE;
+	    }
+	    p0 = pe->NextOfPE;
+	  }
+	  if (!found) {
+	    PredEntry *npe = RepPredProp(PredPropByAtom(AtomOfTerm(tg),IDB_MODULE));
+	    npe->PredFlags |= GoalExPredFlag;	    
+	  }
+	} else if (IsApplTerm(tg)) {
+	  FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg);
+	  Prop p0;
+
+	  p0 = fe->PropsOfFE;
+	  if (p0) {
+	    mark_preds_with_this_func(FunctorOfTerm(tg), p0);
+	  } else {
+	    Term mod = CurrentModule;
+	    PredEntry *npe;
+	    if (CurrentModule == PROLOG_MODULE)
+	      mod = IDB_MODULE;
+	    npe = RepPredProp(PredPropByFunc(fe,mod));
+	    npe->PredFlags |= GoalExPredFlag;	    
+	  }
+	}
+      } else {
+	PRED_GOAL_EXPANSION_ALL = TRUE;
+      }
+    } else {
+      if (IsAtomTerm(tm)) {
+	if (IsAtomTerm(tg)) {
+	  PredEntry *p = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
+	  p->PredFlags |= GoalExPredFlag;
+	} else if (IsApplTerm(tg)) {
+	  PredEntry *p = RepPredProp(PredPropByFunc(FunctorOfTerm(tg), tm));
+	  p->PredFlags |= GoalExPredFlag;
+	}
+      }
+    }
+  } else if (p->FunctorOfPred == FunctorGoalExpansion2) {
+    Term tg = ArgOfTerm(1, tf);
+
+    if (IsVarTerm(tg)) {
+      PRED_GOAL_EXPANSION_ALL = TRUE;
+    } else if (IsApplTerm(tg)) {
+      FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg);
+      Prop p0;
+      PredEntry *npe;
+
+      p0 = fe->PropsOfFE;
+      if (p0 && (p->ModuleOfPred == PROLOG_MODULE || p->ModuleOfPred == SYSTEM_MODULE || p->ModuleOfPred == USER_MODULE)) {
+	mark_preds_with_this_func(fe, p0);
+	PRED_GOAL_EXPANSION_FUNC = TRUE;
+      }
+      npe = RepPredProp(PredPropByFunc(fe,p->ModuleOfPred));
+      npe->PredFlags |= GoalExPredFlag;	    
+    } else if (IsAtomTerm(tg)) {
+      Atom at = AtomOfTerm(tg);
+      Prop p0;
+      PredEntry *npe;
+
+      p0 = RepAtom(at)->PropsOfAE;
+      if (p0 && (p->ModuleOfPred == PROLOG_MODULE || p->ModuleOfPred == SYSTEM_MODULE || p->ModuleOfPred == USER_MODULE)) {
+	mark_preds_with_this_atom(p0);
+	PRED_GOAL_EXPANSION_FUNC = TRUE;
+      }
+      npe = RepPredProp(PredPropByAtom(at,p->ModuleOfPred));
+      npe->PredFlags |= GoalExPredFlag;	    
+    }
+  }
+}
+
 static int
 addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
 /*
@@ -2158,63 +2262,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
   }
   if (pflags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag))
     spy_flag = TRUE;
-  if (p == PredGoalExpansion) {
+  goal_expansion_support(p, tf);
-    Term tg = ArgOfTerm(1, tf);
-    Term tm = ArgOfTerm(2, tf);
-
-    if (IsVarTerm(tg) || IsVarTerm(tm)) {
-      if (!IsVarTerm(tg)) {
-	/* this is the complicated case, first I need to inform
-	   predicates for this functor */ 
-	PRED_GOAL_EXPANSION_FUNC = TRUE;
-	if (IsAtomTerm(tg)) {
-	  AtomEntry *ae = RepAtom(AtomOfTerm(tg));
-	  Prop p0 = ae->PropsOfAE;
-	  int found = FALSE;
-
-	  while (p0) {
-	    PredEntry *pe = RepPredProp(p0);
-	    if (pe->KindOfPE == PEProp) {
-	      pe->PredFlags |= GoalExPredFlag;
-	      found = TRUE;
-	    }
-	    p0 = pe->NextOfPE;
-	  }
-	  if (!found) {
-	    PredEntry *npe = RepPredProp(PredPropByAtom(AtomOfTerm(tg),IDB_MODULE));
-	    npe->PredFlags |= GoalExPredFlag;	    
-	  }
-	} else if (IsApplTerm(tg)) {
-	  FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg);
-	  Prop p0;
-
-	  p0 = fe->PropsOfFE;
-	  if (p0) {
-	    mark_preds_with_this_func(FunctorOfTerm(tg), p0);
-	  } else {
-	    Term mod = CurrentModule;
-	    PredEntry *npe;
-	    if (CurrentModule == PROLOG_MODULE)
-	      mod = IDB_MODULE;
-	    npe = RepPredProp(PredPropByFunc(fe,mod));
-	    npe->PredFlags |= GoalExPredFlag;	    
-	  }
-	}
-      } else {
-	PRED_GOAL_EXPANSION_ALL = TRUE;
-      }
-    } else {
-      if (IsAtomTerm(tm)) {
-	if (IsAtomTerm(tg)) {
-	  PredEntry *p = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
-	  p->PredFlags |= GoalExPredFlag;
-	} else if (IsApplTerm(tg)) {
-	  PredEntry *p = RepPredProp(PredPropByFunc(FunctorOfTerm(tg), tm));
-	  p->PredFlags |= GoalExPredFlag;
-	}
-      }
-    }
-  }
   if (mode == consult)
     not_was_reconsulted(p, t, TRUE);
   /* always check if we have a valid error first */

H/iatoms.h

@@ -384,6 +384,7 @@
   FunctorGPrimitive = Yap_MkFunctor(AtomPrimitive,1);
   FunctorGVar = Yap_MkFunctor(AtomGVar,1);
   FunctorGeneratePredInfo = Yap_MkFunctor(AtomGeneratePredInfo,4);
+  FunctorGoalExpansion2 = Yap_MkFunctor(AtomGoalExpansion,2);
   FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3);
   FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3);
   FunctorId = Yap_MkFunctor(AtomId,1);

H/ratoms.h

@@ -384,6 +384,7 @@
   FunctorGPrimitive = FuncAdjust(FunctorGPrimitive);
   FunctorGVar = FuncAdjust(FunctorGVar);
   FunctorGeneratePredInfo = FuncAdjust(FunctorGeneratePredInfo);
+  FunctorGoalExpansion2 = FuncAdjust(FunctorGoalExpansion2);
   FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion);
   FunctorHandleThrow = FuncAdjust(FunctorHandleThrow);
   FunctorId = FuncAdjust(FunctorId);

H/tatoms.h

@@ -766,6 +766,8 @@
 #define FunctorGVar Yap_heap_regs->FunctorGVar_
   Functor FunctorGeneratePredInfo_;
 #define FunctorGeneratePredInfo Yap_heap_regs->FunctorGeneratePredInfo_
+  Functor FunctorGoalExpansion2_;
+#define FunctorGoalExpansion2 Yap_heap_regs->FunctorGoalExpansion2_
   Functor FunctorGoalExpansion_;
 #define FunctorGoalExpansion Yap_heap_regs->FunctorGoalExpansion_
   Functor FunctorHandleThrow_;

misc/ATOMS

@@ -389,6 +389,7 @@ F	GNumber			Number		1
 F	GPrimitive		Primitive	1
 F	GVar			GVar		1
 F	GeneratePredInfo	GeneratePredInfo	4
+F	GoalExpansion2		GoalExpansion	2
 F	GoalExpansion		GoalExpansion	3
 F	HandleThrow		HandleThrow	3
 F	Id			Id		1

pl/boot.yap

@@ -903,7 +903,7 @@ not(G) :-    \+ '$execute'(G).
 '$call'(G, CP, G0, CurMod) :-
 	( '$is_expand_goal_or_meta_predicate'(G,CurMod) ->
 	   (
-	     '$notrace'(user:goal_expansion(G, CurMod, NG)) ->
+	     '$notrace'((CurMod:goal_expansion(G,NG) ;  system:goal_expansion(G,NG) ; user:goal_expansion(G, CurMod, NG) ; user:goal_expansion(G,NG) )) ->
 	       '$call'(NG, CP, G0,CurMod)
 	     ;
 	       % repeat other code.

pl/init.yap

@@ -201,6 +201,14 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
 
 :- dynamic goal_expansion/3.
 
+:- multifile goal_expansion/2.
+
+:- dynamic goal_expansion/2.
+
+:- multifile system:goal_expansion/2.
+
+:- dynamic system:goal_expansion/2.
+
 :- multifile user:prolog_file_type/2.
 
 :- dynamic user:prolog_file_type/2.

pl/modules.yap

@@ -351,7 +351,6 @@ expand_goal(G, G).
 	->
 	 true
 	;
-	 recorded('$dialect',swi,_),
 	 '$pred_exists'(goal_expansion(G,GI), system),
 	 system:goal_expansion(G, GI)
 	->