Commit df01b74d authored by bbr's avatar bbr
Browse files

unification in or based mode now working

parent a6ddd2b5
......@@ -104,16 +104,15 @@ ctcStore mode cont x state =
Branching -> let ref = orRef x
bs = branches x
in case state of
Nothing -> if isGenerator ref && not mode
then cont x state
else mapOr (ctcStore mode cont) ref bs state
Nothing -> if mode || not (isGenerator ref)
then mapOr (ctcStore mode cont) ref bs state
else cont x state
Just store -> case fromStore store ref of
Nothing -> if isGenerator ref && not mode
then cont x state
else branching ref
(zipWith (ctcBranch contCTC ref store)
[0..]
bs)
Nothing -> if mode || not (isGenerator ref)
then branching (narrowOrRef ref)
(zipWith (ctcBranch contCTC ref store)
[0..] bs)
else cont x state
Just i -> ctcStore mode cont (bs!!i) state
Free -> let ref = freeVarRef x in
......
......@@ -27,11 +27,11 @@ data OrRefKind = Generator | Chain Int | Other
data OrRef = OrRef OrRefKind Int
| Layer OrRef deriving (Eq,Show,Read)
-- constructors
uncover :: OrRef -> OrRef
uncover x@(OrRef _ _) = x
uncover (Layer x) = x
-- constructors
cover :: OrRef -> OrRef
cover = Layer
......@@ -43,12 +43,10 @@ mkRefWithGenInfo = OrRef
-- selectors
deref :: OrRef -> Int
deref (OrRef _ x) = x
deref (Layer l) = deref l
deref r = (\ (OrRef _ x) -> x) (uncover r)
refKind :: OrRef -> OrRefKind
refKind (OrRef x _) = x
refKind (Layer l) = refKind l
refKind r = (\ (OrRef x _) -> x) (uncover r)
-- tester
isCovered :: OrRef -> Bool
......@@ -71,16 +69,17 @@ chainedTo o = case refKind o of
_ -> Nothing
--operations
narrowOrRef :: OrRef -> OrRef
narrowOrRef (Layer l) = Layer (narrowOrRef l)
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
narrowOrRef :: OrRef -> OrRef
narrowOrRef = updKind narrow
where narrow o@Other = o
narrow o@(Chain _) = o
narrow Generator = Other
chainTo :: OrRef -> Int -> OrRef
chainTo r v = updKind chain r
where
......@@ -101,9 +100,11 @@ vtrace x = x
--vtrace' = trace
vtrace' _ x = x
------------------------------
-------------------------------------------------------
-- finally: the store
------------------------------
-------------------------------------------------------
-- negative numbers are references to other variables
-------------------------------------------------------
newtype Store = Store (IntMap Int) deriving (Show)
......@@ -111,11 +112,23 @@ emptyStore :: Store
emptyStore = Store empty
addToStore :: Store -> OrRef -> Int -> Store
addToStore (Store a) m x = trace ("add binding "++show m)
(Store (insert (deref m) x a))
addToStore (Store st) r i = Store (add st (deref r) i)
where
add store ref choice =
case insertLookupWithKey (\ _ new _ -> new) ref i st of
(Nothing, newStore) -> newStore
(Just ref',newStore) -> add newStore (-ref') choice
fromStore :: Store -> OrRef -> Maybe Int
fromStore (Store a) n = lookup (deref n) a
fromStore (Store store) r = from (deref r)
where
from ref = maybe Nothing follow (lookup ref store)
follow i | i<0 = from (negate i)
| otherwise = Just i
chainInStore :: Store -> OrRef -> OrRef -> Store
chainInStore (Store st) from to =
Store (insert (deref from) (negate (deref to)) st)
storeSize :: Store -> Int
storeSize (Store st) = size st
\ No newline at end of file
......@@ -357,7 +357,7 @@ getSearchTree x _ = C_IO (\ state -> Prelude.return (IOVal (searchTr x state)))
searchTr :: Curry a => a -> Result (C_SearchTree a)
searchTr x state = transVal (nfCTC (nfCTC (\ x _ -> x)) x state)
searchTr x state = transVal (nfCTC (nfCTC const) x state)
where
transVal x = case consKind x of
Val -> C_Value x
......
......@@ -9,7 +9,6 @@ import List
import System.IO.Unsafe
import Data.IORef
import AutoGenerated2
--import qualified Debug.Trace as H
strace s x = unsafePerformIO (putStrLn s >> return x)
-----------------------------------------------------------------
......
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