redo an earlier commit

src/Store.hs

@@ -5,9 +5,10 @@ module Store
 
    trace,vtrace,vtrace',
 
-   OrRef,OrRefKind(Generator,Other),deref,cover,uncover,mkRef,isCovered,
+   OrRef,OrRefKind(Generator,Other),
+   deref,cover,uncover,mkRef,isCovered,
 
-   mkRefWithGenInfo, isGenerator, chainedTo, 
+   mkRefWithGenInfo, isGenerator, chainedTo, chainTo,
 
    narrowOrRef
    ) where
@@ -76,7 +77,15 @@ narrowOrRef o@(OrRef Other i) = o
 narrowOrRef o@(OrRef (Chain _) i) = o
 narrowOrRef (OrRef Generator i) = OrRef Other i
 
+updKind :: (OrRefKind -> OrRefKind) -> OrRef -> OrRef
+updKind f (Layer r)   = Layer (updKind f r)
+updKind f (OrRef k i) = OrRef (f k) i
 
+chainTo :: OrRef -> Int -> OrRef 
+chainTo r v = updKind chain r
+  where
+    chain Generator = Chain v
+    chain _         = error "Store.chainTo applied to unexpected argument"
 
 ----------------------------------
 -- tracing

src/lib/ExternalFunctionsPrelude.hs

@@ -364,7 +364,9 @@ searchTr x state = transVal (nfCTC (nfCTC (\ x _ -> x)) x state)
                    Free      -> C_Value x
                    Failed    -> C_Fail
                    Suspended -> C_Suspend
-                   Branching -> transBranching (branches x)
+                   Branching 
+                     | isGenerator (orRef x) -> C_Value x
+                     | otherwise -> transBranching (branches x)
 
     transBranching []         = C_Fail
     transBranching [x]    = transVal x

src/lib/ExternalInstancesPrelude.hs

@@ -670,14 +670,31 @@ genStrEq a b = (\ a' -> (onceMore a') `hnfCTC` b)  `hnfCTC` a
       where
       checkFree Free Free 
          | freeVarRef x Prelude.== freeVarRef y
-         = C_True --C_Success
-         | otherwise = bind (freeVarRef x) y C_True --C_Success 
+         = C_True 
+         | otherwise = bind (freeVarRef x) y C_True 
             -- maybe create new var to be symmetric?
       checkFree Free _ = let p=pattern () in 
         bind (freeVarRef x) p (hnfCTC (\ x' -> unify x' y) p st)
       checkFree _ Free = let p=pattern () in 
         bind (freeVarRef y) p (hnfCTC (unify x) p st)
+
       checkFree Val Val = strEq x y st
+
+      checkFree Branching Branching  
+         | deref rx Prelude.== dry
+         = C_True
+         | otherwise = branching (chainTo rx dry) [C_True]
+         where rx=orRef x
+               dry=deref (orRef y)
+
+      checkFree Branching _ = 
+        hnfCTC (\ x' -> unify x' y) 
+               (branching (narrowOrRef (orRef x)) (branches x)) st
+
+      checkFree _ Branching = 
+        hnfCTC (unify x)
+               (branching (narrowOrRef (orRef y)) (branches y)) st
+
       checkFree x   y   = error $ "checkFree " ++ show (x,y)
 
 strEqFail :: String -> StrEqResult