Commit 8545f936 authored by Bernd Brassel's avatar Bernd Brassel
Browse files

redo an earlier commit

parent dc2ef5b8
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment