diff --git a/src/UHC/Util/AssocL.hs b/src/UHC/Util/AssocL.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/AssocL.hs
@@ -0,0 +1,56 @@
+module UHC.Util.AssocL
+	( Assoc, AssocL
+	, assocLMapElt, assocLMapKey
+	, assocLElts, assocLKeys
+	, assocLGroupSort
+	, assocLMapUnzip
+	, ppAssocL, ppAssocL', ppAssocLV
+	, ppCurlysAssocL
+	)
+  where
+import UHC.Util.Pretty
+import UHC.Util.Utils
+import Data.List
+
+type Assoc k v = (k,v)
+type AssocL k v = [Assoc k v]
+
+ppAssocL' :: (PP k, PP v, PP s) => ([PP_Doc] -> PP_Doc) -> s -> AssocL k v -> PP_Doc
+ppAssocL' ppL sep al = ppL (map (\(k,v) -> pp k >|< sep >#< pp v) al)
+
+ppAssocL :: (PP k, PP v) => AssocL k v -> PP_Doc
+ppAssocL = ppAssocL' (ppBlock "[" "]" ",") ":"
+
+ppAssocLV :: (PP k, PP v) => AssocL k v -> PP_Doc
+ppAssocLV = ppAssocL' vlist ":"
+
+-- | intended for parsing
+ppCurlysAssocL :: (k -> PP_Doc) -> (v -> PP_Doc) -> AssocL k v -> PP_Doc
+ppCurlysAssocL pk pv = ppCurlysCommasBlock . map (\(k,v) -> pk k >#< "=" >#< pv v)
+
+assocLMap :: (k -> v -> (k',v')) -> AssocL k v -> AssocL k' v'
+assocLMap f = map (uncurry f)
+{-# INLINE assocLMap #-}
+
+assocLMapElt :: (v -> v') -> AssocL k v -> AssocL k v'
+assocLMapElt f = assocLMap (\k v -> (k,f v))
+{-# INLINE assocLMapElt #-}
+
+assocLMapKey :: (k -> k') -> AssocL k v -> AssocL k' v
+assocLMapKey f = assocLMap (\k v -> (f k,v))
+{-# INLINE assocLMapKey #-}
+
+assocLMapUnzip :: AssocL k (v1,v2) -> (AssocL k v1,AssocL k v2)
+assocLMapUnzip l = unzip [ ((k,v1),(k,v2)) | (k,(v1,v2)) <- l ]
+
+assocLKeys :: AssocL k v -> [k]
+assocLKeys = map fst
+{-# INLINE assocLKeys #-}
+
+assocLElts :: AssocL k v -> [v]
+assocLElts = map snd
+{-# INLINE assocLElts #-}
+
+assocLGroupSort :: Ord k => AssocL k v -> AssocL k [v]
+assocLGroupSort = map (foldr (\(k,v) (_,vs) -> (k,v:vs)) (panic "UHC.Util.AssocL.assocLGroupSort" ,[])) . groupSortOn fst
+
diff --git a/src/UHC/Util/Binary.hs b/src/UHC/Util/Binary.hs
--- a/src/UHC/Util/Binary.hs
+++ b/src/UHC/Util/Binary.hs
@@ -6,6 +6,9 @@
   ( module Data.Binary
   , module Data.Binary.Get
   , module Data.Binary.Put
+  , module UHC.Util.Control.Monad
+  , module Data.Typeable
+  , module Data.Generics
 
   , hGetBinary
   , getBinaryFile
@@ -14,16 +17,30 @@
   , hPutBinary
   , putBinaryFile
   , putBinaryFPath
+
+  , putEnum, getEnum
+  , putEnum8, getEnum8
+  , putList, getList
   )
   where
 
 import qualified Data.ByteString.Lazy as L
+import Data.Typeable (Typeable,Typeable1)
+import Data.Generics (Data)
 import Data.Binary
 import Data.Binary.Put(runPut,putWord16be)
 import Data.Binary.Get(runGet,getWord16be)
 import System.IO
 import Control.Monad
+import UHC.Util.Control.Monad
 
+{-
+import Data.Generics.Aliases
+import Data.Word
+import Data.Array
+import Control.Monad
+-}
+
 import UHC.Util.FPath
 
 -------------------------------------------------------------------------
@@ -72,4 +89,40 @@
   = do { fpathEnsureExists fp
        ; putBinaryFile (fpathToStr fp) pt
        }
+
+-------------------------------------------------------------------------
+-- Enum based put/get
+-------------------------------------------------------------------------
+
+-- | put an Enum
+putEnum :: Enum x => x -> Put
+putEnum x = put (fromEnum x)
+
+-- | get an Enum
+getEnum :: Enum x => Get x
+getEnum = do n <- get
+             return (toEnum n)
+
+
+-- | put an Enum as Word8
+putEnum8 :: Enum x => x -> Put
+putEnum8 x = putWord8 (fromIntegral $ fromEnum x)
+
+-- | get an Enum from Word8
+getEnum8 :: Enum x => Get x
+getEnum8 = do n <- getWord8
+              return (toEnum $ fromIntegral n)
+
+-- | put a []
+putList :: (Binary a, Binary b) => (x -> Bool) -> (x -> (a,b)) -> x -> Put
+putList isNil getCons x | isNil x   = putWord8 0
+                        | otherwise = let (a,b) = getCons x in putWord8 1 >> put a >> put b
+
+-- | get a []
+getList :: (Binary a, Binary b) => x -> (a -> b -> x) -> Get x
+getList nil cons
+  = do tag <- getWord8
+       case tag of
+         0 -> return nil
+         1 -> liftM2 cons get get
 
diff --git a/src/UHC/Util/Control/Monad.hs b/src/UHC/Util/Control/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/Control/Monad.hs
@@ -0,0 +1,39 @@
+{- |
+Extensions to Control.Monad
+-}
+
+module UHC.Util.Control.Monad
+  ( liftM6
+  , liftM7
+  , liftM8
+  , liftM9
+  )
+  where
+
+liftM6  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> r)
+           -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m r
+liftM6 f m1 m2 m3 m4 m5 m6
+  = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6
+       ; return (f x1 x2 x3 x4 x5 x6)
+       }
+
+liftM7  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> r)
+           -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m a7 -> m r
+liftM7 f m1 m2 m3 m4 m5 m6 m7
+  = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7
+       ; return (f x1 x2 x3 x4 x5 x6 x7)
+       }
+
+liftM8  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> r)
+           -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m a7 -> m a8 -> m r
+liftM8 f m1 m2 m3 m4 m5 m6 m7 m8
+  = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8
+       ; return (f x1 x2 x3 x4 x5 x6 x7 x8)
+       }
+
+liftM9  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> r)
+           -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m a7 -> m a8 -> m a9 -> m r
+liftM9 f m1 m2 m3 m4 m5 m6 m7 m8 m9
+  = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7; x8 <- m8; x9 <- m9
+       ; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9)
+       }
diff --git a/src/UHC/Util/ScopeMapGam.hs b/src/UHC/Util/ScopeMapGam.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/ScopeMapGam.hs
@@ -0,0 +1,249 @@
+{- |
+Environment/Gamma where the lexical level + scoping is used to provide nesting behavior.
+Both a SGam and its entries know at which scope they are.
+
+Insertion is efficient, lookup also, because a single Map is used.
+
+The Map holds multiple entries, each with its own scope identifier.
+An SGam holds
+- a stack of scopes, encoding the nesting, where
+- each scope holds mappings for MetaLev's
+
+Results are filtered out w.r.t. this stack, i.e. are checked to be in scope.
+In principle this can be done eagerly, that is, immediately after a change in scope, in particular in sgamPop.
+After some experimentation it did turn out that doing this lazily is overall faster, that is, when the SGam is consulted (lookup, conversion to association list, etc).
+Conceptually thus the invariant is that no entry is in the map which is not in scope. Guaranteeing this invariant is thus not done by the one function breaking it (sgamPop).
+
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module UHC.Util.ScopeMapGam
+    ( SGam
+    , emptySGam
+    , sgamFilterMapEltAccumWithKey, sgamMapEltWithKey, sgamMapThr, sgamMap
+    , sgamMetaLevSingleton, sgamSingleton
+    , sgamUnionWith, sgamUnion
+    , sgamPartitionEltWithKey, sgamPartitionWithKey
+    , sgamUnzip
+    , sgamPop, sgamTop
+    , sgamPushNew, sgamPushGam
+    , sgamLookupMetaLevDup
+    , sgamToAssocDupL, sgamFromAssocDupL
+    , sgamNoDups
+    )
+  where
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.List
+import UHC.Util.VarMp
+import UHC.Util.Utils
+import UHC.Util.AssocL
+-- import EH100.Base.Common
+import Data.Typeable (Typeable)
+import Data.Generics (Data)
+import UHC.Util.Serialize
+import Control.Monad
+-- import EH100.Base.Binary
+
+-- Scope Gam, a Gam with entries having a level in a scope, and the Gam a scope
+
+type Scp = [Int]									-- ^ a stack of scope idents defines what's in scope
+
+data SGamElt v
+  = SGamElt
+      { sgeScpId	:: !Int							-- ^ scope ident
+      , sgeVal		:: v							-- ^ the value
+      }
+  deriving (Typeable, Data)
+
+type SMap k v = VarMp' k [SGamElt v]
+
+emptySMap :: SMap k v
+emptySMap = emptyVarMp
+
+data SGam k v
+  = SGam
+      { sgScpId		:: !Int							-- ^ current scope, increment with each change in scope
+      , sgScp		:: !Scp							-- ^ scope stack
+      , sgMap		:: SMap k v						-- ^ map holding the values
+      }
+  deriving (Typeable, Data)
+
+mkSGam :: SMap k v -> SGam k v
+mkSGam = SGam 0 [0]
+
+emptySGam :: SGam k v
+emptySGam = mkSGam emptySMap
+
+instance Show (SGam k v) where
+  show _ = "SGam"
+
+
+-- | scope ident in scope?
+inScp :: Scp -> Int -> Bool
+inScp = flip elem
+{-# INLINE inScp #-}
+
+-- | sgam elt in scope?
+sgameltInScp :: Scp -> SGamElt v -> Bool
+sgameltInScp scp = inScp scp . sgeScpId
+{-# INLINE sgameltInScp #-}
+
+-- | filter out the out of scopes
+sgameltFilterInScp :: Scp -> [SGamElt v] -> [SGamElt v]
+sgameltFilterInScp scp = filter (sgameltInScp scp)
+{-# INLINE sgameltFilterInScp #-}
+
+-- | map the in scopes
+sgameltMapInScp :: Scp -> (v -> v) -> [SGamElt v] -> [SGamElt v]
+sgameltMapInScp scp f = map (\e -> if sgameltInScp scp e then e {sgeVal = f (sgeVal e)} else e)
+{-# INLINE sgameltMapInScp #-}
+
+-- | extract the in scopes
+sgameltGetFilterInScp :: Scp -> (v -> v') -> [SGamElt v] -> [v']
+sgameltGetFilterInScp scp f es = [ f (sgeVal e) | e <- es, sgameltInScp scp e ]
+{-# INLINE sgameltGetFilterInScp #-}
+
+-- | filter out the out of scopes, applying a mapping function on the fly
+mapFilterInScp' :: Ord k => Scp -> ([SGamElt v] -> [SGamElt v]) -> SMap k v -> SMap k v
+mapFilterInScp' scp f m
+  = varmpMapMaybe (\es -> maybeNull Nothing (Just . f) $ sgameltFilterInScp scp es) m
+{-# INLINE mapFilterInScp' #-}
+
+mapFilterInScp :: Ord k => Scp -> (SGamElt v -> SGamElt v) -> SMap k v -> SMap k v
+mapFilterInScp scp f m
+  = mapFilterInScp' scp (map f) m
+{-# INLINE mapFilterInScp #-}
+
+sgamFilterInScp :: Ord k => SGam k v -> SGam k v
+sgamFilterInScp g@(SGam {sgScp = scp, sgMap = m})
+  = g {sgMap = mapFilterInScp scp id m}
+{-# INLINE sgamFilterInScp #-}
+
+-- | do it all: map, filter, fold
+sgamFilterMapEltAccumWithKey
+  :: (Ord k')
+       => (k -> SGamElt v -> Bool)
+          -> (k -> SGamElt v -> acc -> (k',SGamElt v',acc))
+          -> (k -> SGamElt v -> acc -> acc)
+          -> acc -> SGam k v -> (SGam k' v',acc)
+sgamFilterMapEltAccumWithKey p fyes fno a g
+  = (g {sgMap = mkVarMp m'},a')
+  where (m,_)   = varmpAsMap (sgMap g)
+        (m',a') = Map.foldrWithKey
+                    (\k es ma@(m,a)
+                      -> foldr (\e (m,a)
+                                 -> if p k e
+                                    then let (k',e',a') = fyes k e a
+                                         in  (Map.insertWith (++) k' [e'] m,a')
+                                    else (m,fno k e a)
+                               ) ma
+                         $ sgameltFilterInScp (sgScp g) es
+                    ) (Map.empty,a) m
+
+sgamMapEltWithKey :: (Ord k,Ord k') => (k -> SGamElt v -> (k',SGamElt v')) -> SGam k v -> SGam k' v'
+sgamMapEltWithKey f g
+  = g'
+  where (g',_) = sgamFilterMapEltAccumWithKey (\_ _ -> True) (\k e a -> let (k',e') = f k e in (k',e',a)) undefined () g
+
+sgamMapThr :: (Ord k,Ord k') => ((k,v) -> t -> ((k',v'),t)) -> t -> SGam k v -> (SGam k' v',t)
+sgamMapThr f thr g = sgamFilterMapEltAccumWithKey (\_ _ -> True) (\k e thr -> let ((k',v'),thr') = f (k,sgeVal e) thr in (k',e {sgeVal = v'},thr')) undefined thr g
+
+sgamMap :: (Ord k,Ord k') => ((k,v) -> (k',v')) -> SGam k v -> SGam k' v'
+sgamMap f g = sgamMapEltWithKey (\k e -> let (k',v') = f (k,sgeVal e) in (k',e {sgeVal = v'})) g
+
+sgamMetaLevSingleton :: MetaLev -> k -> v -> SGam k v
+sgamMetaLevSingleton mlev k v = mkSGam (varmpMetaLevSingleton mlev k [SGamElt 0 v])
+
+sgamSingleton :: k -> v -> SGam k v
+sgamSingleton = sgamMetaLevSingleton metaLevVal
+
+-- | combine gam, g1 is added to g2 with scope of g2
+sgamUnionWith :: Ord k => Maybe (v -> [v] -> [v]) -> SGam k v -> SGam k v -> SGam k v
+sgamUnionWith cmb g1@(SGam {sgScp = scp1, sgMap = m1}) g2@(SGam {sgScp = scp2@(hscp2:_), sgMap = m2})
+  = g2 {sgMap = varmpUnionWith cmb' m1' m2}
+  where m1' = mapFilterInScp scp1 (\e -> e {sgeScpId = hscp2}) m1
+        cmb' = maybe (++)
+                     (\c -> \l1 l2 -> concat [ map (SGamElt scp) $ foldr c [] $ map sgeVal g | g@(SGamElt {sgeScpId = scp} : _) <- groupSortOn sgeScpId $ l1 ++ l2 ])
+                     cmb
+
+-- combine gam, g1 is added to g2 with scope of g2
+sgamUnion :: Ord k => SGam k v -> SGam k v -> SGam k v
+sgamUnion = sgamUnionWith Nothing
+{-# INLINE sgamUnion #-}
+
+-- | equivalent of partition
+sgamPartitionEltWithKey :: Ord k => (k -> SGamElt v -> Bool) -> SGam k v -> (SGam k v,SGam k v)
+sgamPartitionEltWithKey p g
+  = (g1, SGam (sgScpId g1) (sgScp g1) m2)
+  where (g1,m2) = sgamFilterMapEltAccumWithKey p (\k e a -> (k,e,a)) (\k e a -> varmpInsertWith (++) k [e] a) emptySMap g
+
+sgamPartitionWithKey :: Ord k => (k -> v -> Bool) -> SGam k v -> (SGam k v,SGam k v)
+sgamPartitionWithKey p = sgamPartitionEltWithKey (\k e -> p k (sgeVal e))
+
+-- | equivalent of unzip
+sgamUnzip :: Ord k => SGam k (v1,v2) -> (SGam k v1,SGam k v2)
+sgamUnzip g
+  = (g1, g1 {sgMap = m2})
+  where (g1,m2) = sgamFilterMapEltAccumWithKey (\_ _ -> True) (\k e@(SGamElt {sgeVal = (v1,v2)}) m -> (k,e {sgeVal = v1},varmpInsertWith (++) k [e {sgeVal = v2}] m)) undefined emptySMap g
+
+-- | split gam in top and the rest, both with the same scope
+sgamPop :: Ord k => SGam k v -> (SGam k v, SGam k v)
+sgamPop g@(SGam {sgMap = m, sgScpId = scpId, sgScp = scp@(hscp:tscp)})
+  = (SGam scpId [hscp] m, SGam scpId tscp m)
+  -- = (sgamFilterInScp $ SGam scpId [hscp] m, sgamFilterInScp $ SGam scpId tscp m)
+
+-- | top gam, with same scope as g
+sgamTop :: Ord k => SGam k v -> SGam k v
+sgamTop g
+  = fst $ sgamPop g
+
+-- | enter a new scope
+sgamPushNew :: SGam k v -> SGam k v
+sgamPushNew g
+ = g {sgScpId = si, sgScp = si : sgScp g}
+ where si = sgScpId g + 1
+
+-- | enter a new scope, add g1 in that scope to g2
+sgamPushGam :: Ord k => SGam k v -> SGam k v -> SGam k v
+sgamPushGam g1 g2 = g1 `sgamUnion` sgamPushNew g2
+
+-- | lookup, return at least one found value, otherwise Nothing
+sgamLookupMetaLevDup :: Ord k => MetaLev -> k -> SGam k v -> Maybe [v]
+sgamLookupMetaLevDup mlev k g@(SGam {sgMap = m, sgScpId = scpId, sgScp = scp})
+  = case varlookupWithMetaLev mlev k m of
+      Just es | not (null vs)
+        -> Just vs
+        where vs = {- map sgeVal es -- -} sgameltGetFilterInScp scp id es
+      _ -> Nothing
+
+-- | convert to association list, with all duplicates, scope is lost
+sgamToAssocDupL :: Ord k => SGam k v -> AssocL k [v]
+sgamToAssocDupL g@(SGam {sgScp = scp, sgMap = m})
+  = varmpToAssocL $ varmpMap (map sgeVal) $ sgMap $ sgamFilterInScp g
+
+-- | convert from association list, assume default scope
+sgamFromAssocDupL :: Ord k => AssocL k [v] -> SGam k v
+sgamFromAssocDupL l
+  = mkSGam m
+  where m = varmpMap (map (SGamElt 0)) $ assocLToVarMp l
+
+-- | get rid of duplicate entries, by taking the first of them all
+sgamNoDups :: Ord k => SGam k v -> SGam k v
+sgamNoDups g@(SGam {sgScp = scp, sgMap = m})
+  = g {sgMap = mapFilterInScp' scp (\(e:_) -> [e]) m}
+
+instance (Serialize v) => Serialize (SGamElt v) where
+  sput (SGamElt a b) = sput a >> sput b
+  sget = liftM2 SGamElt sget sget
+
+instance (Ord k, Serialize k, Serialize v) => Serialize (SGam k v) where
+  sput (SGam a b c) = sput a >> sput b >> sput c
+  sget = liftM3 SGam sget sget sget
+
+-- instance (Binary v) => Serialize (SGamElt v)
+-- instance (Ord k, Binary k, Binary v) => Serialize (SGam k v)
+
diff --git a/src/UHC/Util/Serialize.hs b/src/UHC/Util/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/Serialize.hs
@@ -0,0 +1,422 @@
+{-
+Serialization is built on top of Binary, adding sharing, additionally
+requiring Typeable and Ord instances for maintaining maps. Whilst
+putting/getting a map is maintained which remembers previously put
+values. When such a value is put a 2nd time, a reference to it is put
+instead.
+
+Values which are shared, put share commands (SCmd) onto the Binary
+serialization. There are SCmds for defining a shared value and referring
+to it, coming in 8/16/.. bitsized reference flavors (this saves space).
+
+Turning on serialization means defining an instance for the type of the
+value, similar to instances for Binary:
+
+\begin{code}
+data Foo = Bar1 | Bar2 Int Int
+
+instance Serialize Foo where
+  sput (Bar1    ) = sputWord8 0
+  sput (Bar2 a b) = sputWord8 1 >> sput a >> sput b
+  sget
+    = do t <- sgetWord8
+         case t of
+           0 -> return Bar1
+           1 -> liftM2 Bar2 sget sget
+\end{code}
+
+When a Binary instance already is defined, the definition can be more simple:
+\begin{code}
+instance Serialize Foo where
+  sput = sputPlain
+  sget = sgetPlain
+\end{code}
+
+The plain variants delegate the work to their Binary equivalents.
+
+By default no sharing is done, it can be enabled by:
+
+\begin{code}
+instance Serialize Foo where
+  sput = sputShared
+  sget = sgetShared
+  sputNested = sputPlain
+  sgetNested = sgetPlain
+\end{code}
+
+When shared the internals are not shared, as above. If the internals
+(i.e. the fields) also must be shared the following instance is
+required, using the original code for sput/sget for the fields of a
+value:
+
+\begin{code}
+instance Serialize Foo where
+  sput = sputShared
+  sget = sgetShared
+  sputNested (Bar1    ) = sputWord8 0
+  sputNested (Bar2 a b) = sputWord8 1 >> sput a >> sput b
+  sgetNested
+    = do t <- sgetWord8
+         case t of
+           0 -> return Bar1
+           1 -> liftM2 Bar2 sget sget
+\end{code}
+
+
+-}
+
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module UHC.Util.Serialize
+	( SPut
+	, SGet
+	, Serialize (..)
+	, sputPlain, sgetPlain
+	, sputUnshared, sputShared
+	, sgetShared
+	, sputWord8, sgetWord8
+	, sputWord16, sgetWord16
+	, sputEnum8, sgetEnum8
+	, runSPut, runSGet
+	, serialize, unserialize
+	, putSPutFile, getSGetFile
+	, putSerializeFile, getSerializeFile
+	)
+  where
+import qualified UHC.Util.Binary as Bn
+import qualified Data.ByteString.Lazy as L
+import System.IO
+import System.IO (openBinaryFile)
+import UHC.Util.Utils
+import Data.Typeable
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+import Data.Word
+import Data.Array
+import Control.Monad
+import qualified Control.Monad.State as St
+import Control.Monad.Trans
+
+{- | Serialization with state.
+Shared values are stored in a per type map, to keep all type correct. To
+make this work a double mapping is maintained, keyed by the type
+descriptor string of a type (obtained via Typeable) and keyed by the Int
+reference to it.
+-}
+data SCmd
+  = SCmd_Unshared
+  | SCmd_ShareDef   | SCmd_ShareRef			--
+  | SCmd_ShareDef16 | SCmd_ShareRef16
+  | SCmd_ShareDef8  | SCmd_ShareRef8
+  deriving (Enum)
+
+instance Bn.Binary SCmd where
+  put = Bn.putEnum8
+  get = Bn.getEnum8
+
+scmdTo16 :: SCmd -> SCmd
+scmdTo16 SCmd_ShareDef = SCmd_ShareDef16
+scmdTo16 SCmd_ShareRef = SCmd_ShareRef16
+scmdTo16 c             = c
+
+scmdTo8 :: SCmd -> SCmd
+scmdTo8 SCmd_ShareDef = SCmd_ShareDef8
+scmdTo8 SCmd_ShareRef = SCmd_ShareRef8
+scmdTo8 c             = c
+
+scmdToNrBits :: SCmd -> Int
+scmdToNrBits SCmd_ShareDef16 = 16
+scmdToNrBits SCmd_ShareRef16 = 16
+scmdToNrBits SCmd_ShareDef8  = 8
+scmdToNrBits SCmd_ShareRef8  = 8
+scmdToNrBits _               = 32
+
+scmdFrom :: SCmd -> SCmd
+scmdFrom SCmd_ShareDef16 = SCmd_ShareDef
+scmdFrom SCmd_ShareRef16 = SCmd_ShareRef
+scmdFrom SCmd_ShareDef8  = SCmd_ShareDef
+scmdFrom SCmd_ShareRef8  = SCmd_ShareRef
+scmdFrom c               = c
+
+data SerPutMp = forall x . (Typeable x, Ord x) => SerPutMp (Map.Map x Int)
+
+data SPutS
+  = SPutS
+      { sputsInx :: Int
+      , sputsSMp :: Map.Map String SerPutMp
+      , sputsPut :: Bn.Put
+      }
+
+emptySPutS = SPutS 0 Map.empty (return ())
+
+type SPut = St.State SPutS ()
+
+
+data SerGetMp = forall x . (Typeable x, Ord x) => SerGetMp (Map.Map Int x)
+
+data SGetS
+  = SGetS
+      { sgetsSMp :: Map.Map String SerGetMp
+      }
+
+type SGet x = St.StateT SGetS Bn.Get x
+
+class Serialize x where
+  sput :: x -> SPut
+  sget :: SGet x
+
+  sputNested :: x -> SPut
+  sgetNested :: SGet x
+
+  -- default just falls back on Binary, invoked by sputShared/sgetShared
+  sputNested = panic "not implemented (must be done by instance): Serialize.sputNested"
+  sgetNested = panic "not implemented (must be done by instance): Serialize.sgetNested"
+
+
+liftP :: Bn.Put -> SPut
+liftP p
+  = do { s <- St.get
+       ; St.put (s { sputsPut = sputsPut s >> p
+                   })
+       }
+
+liftG :: Bn.Get x -> SGet x
+liftG g = lift g
+
+sputPlain :: (Bn.Binary x,Serialize x) => x -> SPut
+sputPlain x = liftP (Bn.put x)
+{-# INLINE sputPlain #-}
+
+sgetPlain :: (Bn.Binary x,Serialize x) => SGet x
+sgetPlain = lift Bn.get
+{-# INLINE sgetPlain #-}
+
+
+sputUnshared :: (Bn.Binary x,Serialize x) => x -> SPut
+sputUnshared x
+  = do { s <- St.get
+       ; St.put (s { sputsPut = sputsPut s >> Bn.put SCmd_Unshared >> Bn.put x
+                   })
+       }
+
+putRef :: SCmd -> Int -> Bn.Put
+putRef c i
+  = if i < 256
+    then do { Bn.put (scmdTo8 c)
+            ; Bn.putWord8 (fromIntegral i)
+            }
+    else if i < 65000
+    then do { Bn.put (scmdTo16 c)
+            ; Bn.putWord16be (fromIntegral i)
+            }
+    else do { Bn.put c
+            ; Bn.put i
+            }
+
+sputShared :: (Ord x, Serialize x, Typeable x) => x -> SPut
+sputShared x
+  = do { s <- St.get
+       ; let tykey = tyConName $ typeRepTyCon $ typeOf x
+       ; case Map.lookup tykey (sputsSMp s) of
+           Just (SerPutMp m)
+             -> case Map.lookup xcasted m of
+                  Just i
+                    -> useExisting i s
+                  _ -> addNew tykey x xcasted m s
+             where xcasted = panicJust "Serialize.sputShared A" $ cast x
+           _ -> addNew tykey x x Map.empty s
+       }
+  where useExisting i s
+          = St.put (s { sputsPut = sputsPut s >> putRef SCmd_ShareRef i })
+        addNew tykey x xcasted m s
+          = do { St.put (s { sputsInx = i+1
+                           , sputsSMp = Map.insert tykey (SerPutMp (Map.insert xcasted i m)) (sputsSMp s)
+                           , sputsPut = sputsPut s >> putRef SCmd_ShareDef i
+                           })
+               ; sputNested x
+               }
+          where i = sputsInx s
+
+getRef :: SCmd -> Bn.Get Int
+getRef c
+  = case scmdToNrBits c of
+      8 -> do { i <- Bn.getWord8
+              ; return (fromIntegral i :: Int)
+              }
+      16-> do { i <- Bn.getWord16be
+              ; return (fromIntegral i :: Int)
+              }
+      _ -> Bn.get
+
+sgetShared :: forall x. (Ord x, Serialize x, Typeable x) => SGet x
+sgetShared
+  = do { cmd <- lift Bn.get
+       ; case scmdFrom cmd of
+           SCmd_Unshared
+             -> sgetNested
+           SCmd_ShareDef
+             -> do { i <- lift (getRef cmd)
+                   ; x <- sgetNested
+                   ; s <- St.get
+                   ; let tykey = tyConName $ typeRepTyCon $ typeOf (undefined :: x)
+                   ; case Map.lookup tykey (sgetsSMp s) of
+                       Just (SerGetMp m)
+                         -> St.put (s { sgetsSMp = Map.insert tykey (SerGetMp (Map.insert i xcasted m)) (sgetsSMp s)
+                                      })
+                         where xcasted = panicJust "Serialize.sgetShared A" $ cast x
+                       _ -> St.put (s { sgetsSMp = Map.insert tykey (SerGetMp (Map.singleton i x)) (sgetsSMp s)
+                                      })
+                   ; return x
+                   }
+           SCmd_ShareRef
+             -> do { i <- lift (getRef cmd)
+                   ; s <- St.get
+                   ; let tykey = tyConName $ typeRepTyCon $ typeOf (undefined :: x)
+                   ; case Map.lookup tykey (sgetsSMp s) of
+                       Just (SerGetMp m)
+                         -> return $ panicJust "Serialize.sgetShared C" $ cast $ panicJust "Serialize.sgetShared B" $ Map.lookup i m
+                       _ -> panic "Serialize.sgetShared D"
+                   }
+       }
+
+
+-- Low level
+
+sputWord8            :: Word8 -> SPut
+sputWord8 x          = liftP (Bn.putWord8 x)
+{-# INLINE sputWord8 #-}
+
+sgetWord8 :: SGet Word8
+sgetWord8 = liftG Bn.getWord8
+{-# INLINE sgetWord8 #-}
+
+
+sputWord16           :: Word16 -> SPut
+sputWord16 x         = liftP (Bn.putWord16be x)
+{-# INLINE sputWord16 #-}
+
+sgetWord16 :: SGet Word16
+sgetWord16 = liftG Bn.getWord16be
+{-# INLINE sgetWord16 #-}
+
+
+sputEnum8 :: Enum x => x -> SPut
+sputEnum8 x = liftP (Bn.putEnum8 x)
+{-# INLINE sputEnum8 #-}
+
+sgetEnum8 :: Enum x => SGet x
+sgetEnum8 = liftG Bn.getEnum8
+{-# INLINE sgetEnum8 #-}
+
+-- Default instances, copied & modified from Binary
+
+instance Serialize () where
+  sput _ = return ()
+  sget   = return ()
+
+instance Serialize Int where
+  sput = sputPlain
+  sget = sgetPlain
+
+instance Serialize Char where
+  sput = sputPlain
+  sget = sgetPlain
+
+instance Serialize Bool where
+  sput = sputPlain
+  sget = sgetPlain
+
+instance Serialize Integer where
+  sput = sputPlain
+  sget = sgetPlain
+
+{-
+instance Serialize String where
+  sput = sputShared
+  sget = sgetShared
+  sputNested = sputPlain
+  sgetNested = sgetPlain
+-}
+
+instance (Serialize a, Serialize b) => Serialize (a,b) where
+    sput (a,b)           = sput a >> sput b
+    sget                 = liftM2 (,) sget sget
+
+instance (Serialize a, Serialize b, Serialize c) => Serialize (a,b,c) where
+    sput (a,b,c)         = sput a >> sput b >> sput c
+    sget                 = liftM3 (,,) sget sget sget
+
+instance Serialize a => Serialize [a] where
+    sput l  = sput (length l) >> mapM_ sput l
+    sget    = do n <- sget :: SGet Int
+                 replicateM n sget
+
+instance (Serialize a) => Serialize (Maybe a) where
+    sput Nothing  = sputWord8 0
+    sput (Just x) = sputWord8 1 >> sput x
+    sget = do
+        w <- sgetWord8
+        case w of
+            0 -> return Nothing
+            _ -> liftM Just sget
+
+instance (Ord a, Serialize a) => Serialize (Set.Set a) where
+    sput = sput . Set.toAscList
+    sget = liftM Set.fromDistinctAscList sget
+
+instance (Ord k, Serialize k, Serialize e) => Serialize (Map.Map k e) where
+    sput = sput . Map.toAscList
+    sget = liftM Map.fromDistinctAscList sget
+
+-- The actual IO
+
+runSPut :: SPut -> Bn.Put
+runSPut x = sputsPut $ St.execState x emptySPutS
+
+runSGet :: SGet x -> Bn.Get x
+runSGet x = St.evalStateT x (SGetS Map.empty)
+
+
+serialize :: Serialize x => x -> Bn.Put
+serialize x = runSPut (sput x)
+
+unserialize :: Serialize x => Bn.Get x
+unserialize = runSGet sget
+
+
+-- | SPut to FilePath
+putSPutFile :: FilePath -> SPut -> IO ()
+putSPutFile fn x
+  = do { h <- openBinaryFile fn WriteMode
+       ; L.hPut h (Bn.runPut $ runSPut x)
+       ; hClose h
+       }
+
+-- | SGet from FilePath
+getSGetFile :: FilePath -> SGet a -> IO a
+getSGetFile fn x
+  = do { h <- openBinaryFile fn ReadMode
+       ; b <- liftM (Bn.runGet $ runSGet x) (L.hGetContents h)
+       -- ; hClose h
+       ; return b ;
+       }
+
+-- | Serialize to FilePath
+putSerializeFile :: Serialize a => FilePath -> a -> IO ()
+putSerializeFile fn x
+  = do { h <- openBinaryFile fn WriteMode
+       ; L.hPut h (Bn.runPut $ serialize x)
+       ; hClose h
+       }
+
+-- | Unserialize from FilePath
+getSerializeFile :: Serialize a => FilePath -> IO a
+getSerializeFile fn
+  = do { h <- openBinaryFile fn ReadMode
+       ; b <- liftM (Bn.runGet unserialize) (L.hGetContents h)
+       -- ; hClose h
+       ; return b ;
+       }
+
diff --git a/src/UHC/Util/VarLookup.hs b/src/UHC/Util/VarLookup.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/VarLookup.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+module UHC.Util.VarLookup
+	( VarLookup (..)
+	, varlookupMap
+	, VarLookupFix, varlookupFix
+	, varlookupFixDel
+	, VarLookupCmb (..)
+	, VarLookupBase (..)
+	, VarLookupCmbFix, varlookupcmbFix
+	
+	, MetaLev
+	, metaLevVal
+    )
+  where
+
+-- import EH100.Base.Common
+import Data.Maybe
+
+-- | Level to lookup into
+type MetaLev = Int
+
+-- | Base level (of values, usually)
+metaLevVal :: MetaLev
+metaLevVal = 0
+
+{- |
+VarLookup abstracts from a Map.
+The purpose is to be able to combine maps only for the purpose of searching without actually merging the maps.
+This then avoids the later need to unmerge such mergings.
+The class interface serves to hide this.
+-}
+
+class VarLookup m k v where
+  varlookupWithMetaLev :: MetaLev -> k -> m -> Maybe v
+  varlookup :: k -> m -> Maybe v
+
+  -- defaults
+  varlookup = varlookupWithMetaLev 0
+
+instance (VarLookup m1 k v,VarLookup m2 k v) => VarLookup (m1,m2) k v where
+  varlookupWithMetaLev l k (m1,m2)
+    = case varlookupWithMetaLev l k m1 of
+        r@(Just _) -> r
+        _          -> varlookupWithMetaLev l k m2
+
+instance VarLookup m k v => VarLookup [m] k v where
+  varlookupWithMetaLev l k ms = listToMaybe $ catMaybes $ map (varlookupWithMetaLev l k) ms
+
+varlookupMap :: VarLookup m k v => (v -> Maybe res) -> k -> m -> Maybe res
+varlookupMap get k m
+  = do { v <- varlookup k m
+       ; get v
+       }
+
+type VarLookupFix k v = k -> Maybe v
+
+-- | fix looking up to be for a certain var mapping
+varlookupFix :: VarLookup m k v => m -> VarLookupFix k v
+varlookupFix m = \k -> varlookup k m
+
+-- | simulate deletion
+varlookupFixDel :: Ord k => [k] -> VarLookupFix k v -> VarLookupFix k v
+varlookupFixDel ks f = \k -> if k `elem` ks then Nothing else f k
+
+{- |
+VarLookupCmb abstracts the 'combining' of/from a substitution.
+The interface goes along with VarLookup but is split off to avoid functional dependency restrictions.
+The purpose is to be able to combine maps only for the purpose of searching without actually merging the maps.
+This then avoids the later need to unmerge such mergings.
+-}
+
+infixr 7 |+>
+
+class VarLookupCmb m1 m2 where
+  (|+>) :: m1 -> m2 -> m2
+
+instance VarLookupCmb m1 m2 => VarLookupCmb m1 [m2] where
+  m1 |+> (m2:m2s) = (m1 |+> m2) : m2s
+
+instance (VarLookupCmb m1 m1, VarLookupCmb m1 m2) => VarLookupCmb [m1] [m2] where
+  m1 |+> (m2:m2s) = (foldr1 (|+>) m1 |+> m2) : m2s
+
+class VarLookupBase m k v | m -> k v where
+  varlookupEmpty :: m
+  -- varlookupTyUnit :: k -> v -> m
+
+type VarLookupCmbFix m1 m2 = m1 -> m2 -> m2
+
+-- | fix combining up to be for a certain var mapping
+varlookupcmbFix :: VarLookupCmb m1 m2 => VarLookupCmbFix m1 m2
+varlookupcmbFix m1 m2 = m1 |+> m2
+
diff --git a/src/UHC/Util/VarMp.hs b/src/UHC/Util/VarMp.hs
new file mode 100644
--- /dev/null
+++ b/src/UHC/Util/VarMp.hs
@@ -0,0 +1,570 @@
+{- |
+A VarMp maps from variables (tvars, ...) to whatever else has to be
+mapped to (Ty, ...).
+
+Starting with variant 6 (which introduces kinds) it allows multiple meta
+level mapping, in that the VarMp holds mappings for multiple meta
+levels. This allows one map to both map to base level info and to higher
+levels. In particular this is used by fitsIn which also instantiates
+types, and types may quantify over type variables with other kinds than
+kind *, which must be propagated. A separate map could have been used,
+but this holds the info together and is extendible to more levels.
+
+A multiple level VarMp knows its own absolute metalevel, which is the default to use for lookup.
+-}
+
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+module UHC.Util.VarMp
+	( VarMp'(..)
+	-- , VarMp
+	, ppVarMpV
+	-- , vmiMbTy
+	-- , tyAsVarMp', tyAsVarMp
+	-- , varmpFilterTy
+	, varmpFilter
+	, varmpDel, (|\>)
+	, varmpUnion, varmpUnions
+	--, varmpTyLookupCyc
+	--, varmpTyLookupCyc2
+	, module UHC.Util.VarLookup
+	-- , VarMpInfo (..)
+	, mkVarMp
+	, emptyVarMp, varmpIsEmpty
+	, varmpShiftMetaLev, varmpIncMetaLev, varmpDecMetaLev
+	, varmpSelectMetaLev
+	, varmpKeys, varmpKeysSet
+	, varmpMetaLevSingleton, varmpSingleton
+	, assocMetaLevLToVarMp, assocLToVarMp
+	-- , assocMetaLevTyLToVarMp, assocTyLToVarMp, varmpToAssocTyL
+	, varmpToAssocL
+	, varmpPlus
+	, varmpUnionWith
+	-- , instToL1VarMp
+	-- , varmpMetaLevTyUnit, varmpTyUnit
+	-- , tyRestrictKiVarMp
+	, varmpLookup
+	-- , varmpTyLookup
+	, ppVarMp
+	, varmpAsMap
+	, varmpMapMaybe, varmpMap
+	, varmpInsertWith
+	, VarMpStk'
+	, emptyVarMpStk, varmpstkUnit
+	, varmpstkPushEmpty, varmpstkPop
+	, varmpstkToAssocL, varmpstkKeysSet
+	, varmpstkUnions
+	, varmpSize
+	-- , vmiMbImpls, vmiMbScope, vmiMbPred, vmiMbAssNm
+	-- , varmpTailAddOcc
+	-- , varmpMapThr
+	-- , varmpMapThrTy
+	-- , varmpImplsUnit, assocImplsLToVarMp, varmpScopeUnit, varmpPredUnit, varmpAssNmUnit
+	-- , varmpImplsLookup, varmpScopeLookup, varmpPredLookup
+	-- , varmpImplsLookupImplsCyc, varmpImplsLookupCyc, varmpScopeLookupScopeCyc, varmpAssNmLookupAssNmCyc
+	-- , varmpPredLookup2, varmpScopeLookup2, varmpAssNmLookup2, varmpImplsLookupCyc2
+	-- , vmiMbLabel, vmiMbOffset
+	-- , varmpLabelUnit, varmpOffsetUnit
+	-- , varmpLabelLookup, varmpOffsetLookup
+	-- , varmpLabelLookupCyc, varmpLabelLookupLabelCyc
+	-- , vmiMbPredSeq
+	-- , varmpPredSeqUnit
+	-- , varmpPredSeqLookup
+	, varmpToMap
+	-- , varmpinfoMkVar
+	-- , ppVarMpInfoCfgTy, ppVarMpInfoDt
+	)
+  where
+
+import Data.List
+-- import EH100.Base.Common
+-- import EH100.Ty
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Maybe
+import UHC.Util.Pretty
+-- import EH100.Ty.Pretty
+-- import EH100.Error
+import UHC.Util.AssocL
+import UHC.Util.VarLookup
+-- import EH100.Base.Debug
+import UHC.Util.Utils
+import Control.Monad
+import Data.Typeable (Typeable)
+import Data.Generics (Data)
+-- import EH100.Base.Binary
+import UHC.Util.Serialize
+
+
+
+
+
+
+data VarMp' k v
+  = VarMp
+      { varmpMetaLev 	:: !MetaLev				-- the base meta level
+      , varmpMpL 		:: [Map.Map k v]		-- for each level a map, starting at the base meta level
+      }
+  deriving ( Eq, Ord
+           , Typeable, Data
+           )
+
+-- get the base meta level map, ignore the others
+varmpToMap :: VarMp' k v -> Map.Map k v
+varmpToMap (VarMp _ (m:_)) = m
+
+mkVarMp :: Map.Map k v -> VarMp' k v
+mkVarMp m = VarMp 0 [m]
+
+emptyVarMp :: VarMp' k v
+emptyVarMp = mkVarMp Map.empty
+
+varmpIsEmpty :: VarMp' k v -> Bool
+varmpIsEmpty (VarMp {varmpMpL=l}) = all Map.null l
+
+instance VarLookupBase (VarMp' k v) k v where
+  varlookupEmpty = emptyVarMp
+
+varmpFilter :: Ord k => (k -> v -> Bool) -> VarMp' k v -> VarMp' k v
+varmpFilter f (VarMp l c) = VarMp l (map (Map.filterWithKey f) c)
+
+varmpPartition :: Ord k => (k -> v -> Bool) -> VarMp' k v -> (VarMp' k v,VarMp' k v)
+varmpPartition f (VarMp l m)
+  = (VarMp l p1, VarMp l p2)
+  where (p1,p2) = unzip $ map (Map.partitionWithKey f) m
+
+varmpDel :: Ord k => [k] -> VarMp' k v -> VarMp' k v
+varmpDel tvL c = varmpFilter (const.not.(`elem` tvL)) c
+
+(|\>) :: Ord k => VarMp' k v -> [k] -> VarMp' k v
+(|\>) = flip varmpDel
+
+-- shift up the level,
+-- or down when negative, throwing away the lower levels
+varmpShiftMetaLev :: MetaLev -> VarMp' k v -> VarMp' k v
+varmpShiftMetaLev inc (VarMp mlev fm)
+  | inc < 0   = let mlev' = mlev+inc in VarMp (mlev' `max` 0) (drop (- (mlev' `min` 0)) fm)
+  | otherwise = VarMp (mlev+inc) fm
+
+varmpIncMetaLev :: VarMp' k v -> VarMp' k v
+varmpIncMetaLev = varmpShiftMetaLev 1
+
+varmpDecMetaLev :: VarMp' k v -> VarMp' k v
+varmpDecMetaLev = varmpShiftMetaLev (-1)
+
+varmpSelectMetaLev :: [MetaLev] -> VarMp' k v -> VarMp' k v
+varmpSelectMetaLev mlevs (VarMp mlev ms)
+  = (VarMp mlev [ if l `elem` mlevs then m else Map.empty | (l,m) <- zip [mlev..] ms ])
+
+-- | Extract first level map, together with a construction function putting a new map into the place of the previous one
+varmpAsMap :: VarMp' k v -> (Map.Map k v, Map.Map k v -> VarMp' k v)
+varmpAsMap (VarMp mlev (m:ms)) = (m, \m' -> VarMp mlev (m':ms))
+
+-- VarMp: properties
+
+varmpSize :: VarMp' k v -> Int
+varmpSize (VarMp _ m) = sum $ map Map.size m
+
+varmpKeys :: Ord k => VarMp' k v -> [k]
+varmpKeys (VarMp _ fm) = Map.keys $ Map.unions fm
+
+varmpKeysSet :: Ord k => VarMp' k v -> Set.Set k
+varmpKeysSet (VarMp _ fm) = Set.unions $ map Map.keysSet fm
+
+-- VarMp construction
+
+varmpMetaLevSingleton :: MetaLev -> k -> v -> VarMp' k v
+varmpMetaLevSingleton mlev k v = VarMp mlev [Map.singleton k v]
+
+varmpSingleton :: k -> v -> VarMp' k v
+varmpSingleton = varmpMetaLevSingleton metaLevVal
+
+assocMetaLevLToVarMp :: Ord k => AssocL k (MetaLev,v) -> VarMp' k v
+assocMetaLevLToVarMp l = varmpUnions [ varmpMetaLevSingleton lev k v | (k,(lev,v)) <- l ]
+
+assocLToVarMp :: Ord k => AssocL k v -> VarMp' k v
+assocLToVarMp = mkVarMp . Map.fromList
+
+{-
+assocMetaLevTyLToVarMp :: Ord k => AssocL k (MetaLev,Ty) -> VarMp' k VarMpInfo
+assocMetaLevTyLToVarMp = assocMetaLevLToVarMp . assocLMapElt (\(ml,t) -> (ml, VMITy t)) -- varmpUnions [ varmpMetaLevTyUnit lev v t | (v,(lev,t)) <- l ]
+
+assocTyLToVarMp :: Ord k => AssocL k Ty -> VarMp' k VarMpInfo
+assocTyLToVarMp = assocLToVarMp . assocLMapElt VMITy
+-}
+
+varmpToAssocL :: VarMp' k i -> AssocL k i
+varmpToAssocL (VarMp _ []   ) = []
+varmpToAssocL (VarMp _ (l:_)) = Map.toList l
+
+{-
+varmpToAssocTyL :: VarMp' k VarMpInfo -> AssocL k Ty
+varmpToAssocTyL c = [ (v,t) | (v,VMITy t) <- varmpToAssocL c ]
+-}
+
+-- VarMp: combine
+
+infixr 7 `varmpPlus`
+
+varmpPlus :: Ord k => VarMp' k v -> VarMp' k v -> VarMp' k v
+varmpPlus = (|+>) -- (VarMp l1) (VarMp l2) = VarMp (l1 `Map.union` l2)
+
+varmpUnion :: Ord k => VarMp' k v -> VarMp' k v -> VarMp' k v
+varmpUnion = varmpPlus
+
+varmpUnions :: Ord k => [VarMp' k v] -> VarMp' k v
+varmpUnions [ ] = emptyVarMp
+varmpUnions [x] = x
+varmpUnions l   = foldr1 varmpPlus l
+
+-- | combine by taking the lowest level, adapting the lists with maps accordingly
+varmpUnionWith :: Ord k => (v -> v -> v) -> VarMp' k v -> VarMp' k v -> VarMp' k v
+varmpUnionWith f (VarMp l1 ms1) (VarMp l2 ms2)
+  = case compare l1 l2 of
+      EQ -> VarMp l1 (cmb                                   ms1                                    ms2 )
+      LT -> VarMp l1 (cmb                                   ms1  (replicate (l2 - l1) Map.empty ++ ms2))
+      GT -> VarMp l2 (cmb (replicate (l1 - l2) Map.empty ++ ms1)                                   ms2 )
+  where cmb (m1:ms1) (m2:ms2) = Map.unionWith f m1 m2 : cmb ms1 ms2
+        cmb ms1      []       = ms1
+        cmb []       ms2      = ms2
+
+-- Fold: map
+
+varmpMapMaybe :: Ord k => (a -> Maybe b) -> VarMp' k a -> VarMp' k b
+varmpMapMaybe f m = m {varmpMpL = map (Map.mapMaybe f) $ varmpMpL m}
+
+varmpMap :: Ord k => (a -> b) -> VarMp' k a -> VarMp' k b
+varmpMap f m = m {varmpMpL = map (Map.map f) $ varmpMpL m}
+
+-- Insertion
+
+varmpInsertWith :: Ord k => (v -> v -> v) -> k -> v -> VarMp' k v -> VarMp' k v
+varmpInsertWith f k v = varmpUnionWith f (varmpSingleton k v)
+
+-- Lookup as VarLookup
+
+instance Ord k => VarLookup (VarMp' k v) k v where
+  varlookupWithMetaLev l k    (VarMp vmlev ms) = lkup (l-vmlev) ms
+                                               where lkup _ []     = Nothing
+                                                     lkup 0 (m:_)  = Map.lookup k m
+                                                     lkup l (_:ms) = lkup (l-1) ms
+  varlookup              k vm@(VarMp vmlev _ ) = varlookupWithMetaLev vmlev k vm
+
+
+instance Ord k => VarLookupCmb (VarMp' k v) (VarMp' k v) where
+  m1 |+> m2 = varmpUnionWith const m1 m2
+
+{-
+instToL1VarMp :: [InstTo] -> VarMp
+instToL1VarMp = varmpIncMetaLev . assocMetaLevTyLToVarMp . instToL1AssocL
+-}
+
+{-
+data VarMpInfo
+  = VMITy      !Ty
+  | VMIImpls   !Impls
+  | VMIScope   !PredScope
+  | VMIPred    !Pred
+  | VMIAssNm   !VarUIDHsName
+  | VMILabel   !Label
+  | VMIOffset  !LabelOffset
+--  | VMIExts    !RowExts
+  | VMIPredSeq !PredSeq
+  deriving
+    ( Eq, Ord, Show
+    , Typeable, Data
+    )
+
+vmiMbTy      i = case i of {VMITy      x -> Just x; _ -> Nothing}
+
+vmiMbImpls   i = case i of {VMIImpls   x -> Just x; _ -> Nothing}
+vmiMbScope   i = case i of {VMIScope   x -> Just x; _ -> Nothing}
+vmiMbPred    i = case i of {VMIPred    x -> Just x; _ -> Nothing}
+vmiMbAssNm   i = case i of {VMIAssNm   x -> Just x; _ -> Nothing}
+vmiMbLabel   i = case i of {VMILabel   x -> Just x; _ -> Nothing}
+vmiMbOffset  i = case i of {VMIOffset  x -> Just x; _ -> Nothing}
+vmiMbPredSeq i = case i of {VMIPredSeq x -> Just x; _ -> Nothing}
+
+type VarMp  = VarMp' TyVarId VarMpInfo
+-}
+
+instance Show (VarMp' k v) where
+  show _ = "VarMp"
+
+{-
+varmpFilterTy :: Ord k => (k -> Ty -> Bool) -> VarMp' k VarMpInfo -> VarMp' k VarMpInfo
+varmpFilterTy f
+  = varmpFilter
+        (\v i -> case i of {VMITy t -> f v t ; _ -> True})
+
+varmpTailAddOcc :: ImplsProveOcc -> Impls -> (Impls,VarMp)
+varmpTailAddOcc o (Impls_Tail i os) = (t, varmpImplsUnit i t)
+                                    where t = Impls_Tail i (o:os)
+varmpTailAddOcc _ x                 = (x,emptyVarMp)
+-}
+
+{-
+varmpMapThr :: (MetaLev -> TyVarId -> VarMpInfo -> thr -> (VarMpInfo,thr)) -> thr -> VarMp -> (VarMp,thr)
+varmpMapThr f thr (VarMp l ms)
+  = (VarMp l ms',thr')
+  where (ms',thr') = foldMlev thr ms
+        foldMp mlev thr fm
+          = Map.foldrWithKey
+              (\v i (fm,thr)
+                 -> let  (i',thr') = f mlev v i thr
+                    in   (Map.insert v i' fm,thr')
+              )
+              (Map.empty,thr) fm
+        foldMlev thr ms
+          = foldr
+              (\(mlev,m) (ms,thr)
+                -> let (m',thr') = foldMp mlev thr m
+                   in  (m':ms,thr')
+              )
+              ([],thr) (zip [0..] ms)
+-}
+
+{-
+varmpMapThrTy :: (MetaLev -> TyVarId -> Ty -> thr -> (Ty,thr)) -> thr -> VarMp -> (VarMp,thr)
+varmpMapThrTy f
+  = varmpMapThr
+      (\mlev v i thr
+         -> case i of
+              VMITy t -> (VMITy t,thr')
+                      where (t',thr') = f mlev v t thr
+              _       -> (i,thr)
+      )
+
+varmpinfoMkVar :: TyVarId -> VarMpInfo -> Ty
+varmpinfoMkVar v i
+  = case i of
+      VMITy       t -> mkTyVar v
+      VMIImpls    i -> mkImplsVar v
+      _             -> mkTyVar v					-- rest incomplete
+
+varmpMetaLevTyUnit :: Ord k => MetaLev -> k -> Ty -> VarMp' k VarMpInfo
+varmpMetaLevTyUnit mlev v t = varmpMetaLevSingleton mlev v (VMITy t)
+
+varmpTyUnit :: Ord k => k -> Ty -> VarMp' k VarMpInfo
+varmpTyUnit = varmpMetaLevTyUnit metaLevVal
+
+varmpImplsUnit :: ImplsVarId -> Impls -> VarMp
+varmpImplsUnit v i = mkVarMp (Map.fromList [(v,VMIImpls i)])
+
+varmpScopeUnit :: TyVarId -> PredScope -> VarMp
+varmpScopeUnit v sc = mkVarMp (Map.fromList [(v,VMIScope sc)])
+
+varmpPredUnit :: TyVarId -> Pred -> VarMp
+varmpPredUnit v p = mkVarMp (Map.fromList [(v,VMIPred p)])
+
+varmpAssNmUnit :: TyVarId -> VarUIDHsName -> VarMp
+varmpAssNmUnit v p = mkVarMp (Map.fromList [(v,VMIAssNm p)])
+
+assocImplsLToVarMp :: AssocL ImplsVarId Impls -> VarMp
+assocImplsLToVarMp = mkVarMp . Map.fromList . assocLMapElt VMIImpls
+
+varmpLabelUnit :: LabelVarId -> Label -> VarMp
+varmpLabelUnit v l = mkVarMp (Map.fromList [(v,VMILabel l)])
+
+varmpOffsetUnit :: UID -> LabelOffset -> VarMp
+varmpOffsetUnit v l = mkVarMp (Map.fromList [(v,VMIOffset l)])
+
+
+varmpPredSeqUnit :: TyVarId -> PredSeq -> VarMp
+varmpPredSeqUnit v l = mkVarMp (Map.fromList [(v,VMIPredSeq l)])
+
+-- restrict the kinds of tvars bound to value identifiers to kind *
+tyRestrictKiVarMp :: [Ty] -> VarMp
+tyRestrictKiVarMp ts = varmpIncMetaLev $ assocTyLToVarMp [ (v,kiStar) | t <- ts, v <- maybeToList $ tyMbVar t ]
+
+-- | Encode 'ty' as a tvar + VarMp, with additional initial construction
+tyAsVarMp' :: (UID -> Ty -> Ty) -> UID -> Ty -> (Ty,VarMp)
+tyAsVarMp' f u t
+  = case f v1 t of
+      t | tyIsVar t -> (t, emptyVarMp)
+        | otherwise -> (mkTyVar v2, varmpTyUnit v2 t)
+  where [v1,v2] = mkNewLevUIDL 2 u
+
+-- | Encode 'ty' as a tvar + VarMp
+tyAsVarMp :: UID -> Ty -> (Ty,VarMp)
+tyAsVarMp = tyAsVarMp' (flip const)
+-}
+
+varmpLookup :: (VarLookup m k i,Ord k) => k -> m -> Maybe i
+varmpLookup = varlookupMap (Just . id)
+
+{-
+varmpTyLookup :: (VarLookup m k VarMpInfo,Ord k) => k -> m -> Maybe Ty
+varmpTyLookup = varlookupMap vmiMbTy
+
+varmpImplsLookup :: VarLookup m ImplsVarId VarMpInfo => ImplsVarId -> m -> Maybe Impls
+varmpImplsLookup = varlookupMap vmiMbImpls
+
+varmpScopeLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe PredScope
+varmpScopeLookup = varlookupMap vmiMbScope
+
+varmpPredLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe Pred
+varmpPredLookup = varlookupMap vmiMbPred
+
+varmpAssNmLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe VarUIDHsName
+varmpAssNmLookup = varlookupMap vmiMbAssNm
+
+varmpLabelLookup :: VarLookup m LabelVarId VarMpInfo => LabelVarId -> m -> Maybe Label
+varmpLabelLookup = varlookupMap vmiMbLabel
+
+varmpOffsetLookup :: VarLookup m UID VarMpInfo => UID -> m -> Maybe LabelOffset
+varmpOffsetLookup = varlookupMap vmiMbOffset
+
+varmpPredSeqLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe PredSeq
+varmpPredSeqLookup = varlookupMap vmiMbPredSeq
+
+varmpTyLookupCyc :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe Ty
+varmpTyLookupCyc x m = lookupLiftCycMb2 tyMbVar (flip varmpTyLookup m) x
+
+varmpImplsLookupImplsCyc :: VarLookup m ImplsVarId VarMpInfo => Impls -> m -> Maybe Impls
+varmpImplsLookupImplsCyc x m = lookupLiftCycMb1 implsMbVar (flip varmpImplsLookup m) x
+
+varmpImplsLookupCyc :: VarLookup m ImplsVarId VarMpInfo => TyVarId -> m -> Maybe Impls
+varmpImplsLookupCyc x m = lookupLiftCycMb2 implsMbVar (flip varmpImplsLookup m) x
+
+varmpScopeLookupScopeCyc :: VarLookup m ImplsVarId VarMpInfo => PredScope -> m -> Maybe PredScope
+varmpScopeLookupScopeCyc x m = lookupLiftCycMb1 pscpMbVar (flip varmpScopeLookup m) x
+
+varmpAssNmLookupAssNmCyc :: VarLookup m ImplsVarId VarMpInfo => VarUIDHsName -> m -> Maybe VarUIDHsName
+varmpAssNmLookupAssNmCyc x m = lookupLiftCycMb1 vunmMbVar (flip varmpAssNmLookup m) x
+
+varmpLabelLookupLabelCyc :: VarLookup m ImplsVarId VarMpInfo => Label -> m -> Maybe Label
+varmpLabelLookupLabelCyc x m = lookupLiftCycMb1 labelMbVar (flip varmpLabelLookup m) x
+
+varmpLabelLookupCyc :: VarLookup m ImplsVarId VarMpInfo => TyVarId -> m -> Maybe Label
+varmpLabelLookupCyc x m = lookupLiftCycMb2 labelMbVar (flip varmpLabelLookup m) x
+
+varmpTyLookupCyc2 :: VarMp -> TyVarId -> Maybe Ty
+varmpTyLookupCyc2 x m = varmpTyLookupCyc m x
+
+varmpScopeLookup2 :: VarMp -> TyVarId -> Maybe PredScope
+varmpScopeLookup2 m v = varmpScopeLookup v m
+
+varmpImplsLookup2 :: VarMp -> ImplsVarId -> Maybe Impls
+varmpImplsLookup2 m v = varmpImplsLookup v m
+
+varmpImplsLookupCyc2 :: VarMp -> ImplsVarId -> Maybe Impls
+varmpImplsLookupCyc2 m v = varmpImplsLookupCyc v m
+
+varmpPredLookup2 :: VarMp -> TyVarId -> Maybe Pred
+varmpPredLookup2 m v = varmpPredLookup v m
+
+varmpAssNmLookup2 :: VarMp -> TyVarId -> Maybe VarUIDHsName
+varmpAssNmLookup2 m v = varmpAssNmLookup v m
+
+varmpLabelLookup2 :: VarMp -> LabelVarId -> Maybe Label
+varmpLabelLookup2 m v = varmpLabelLookup v m
+-}
+
+-- VarMp stack, for nested/local behavior
+
+newtype VarMpStk' k v
+  = VarMpStk [VarMp' k v]
+  deriving (Show)
+
+emptyVarMpStk :: VarMpStk' k v
+emptyVarMpStk = VarMpStk [emptyVarMp]
+
+varmpstkUnit :: Ord k => k -> v -> VarMpStk' k v
+varmpstkUnit k v = VarMpStk [mkVarMp (Map.fromList [(k,v)])]
+
+varmpstkPushEmpty :: VarMpStk' k v -> VarMpStk' k v
+varmpstkPushEmpty (VarMpStk s) = VarMpStk (emptyVarMp : s)
+
+varmpstkPop :: VarMpStk' k v -> (VarMpStk' k v, VarMpStk' k v)
+varmpstkPop (VarMpStk (s:ss)) = (VarMpStk [s], VarMpStk ss)
+varmpstkPop _                 = panic "varmpstkPop: empty"
+
+varmpstkToAssocL :: VarMpStk' k v -> AssocL k v
+varmpstkToAssocL (VarMpStk s) = concatMap varmpToAssocL s
+
+varmpstkKeysSet :: Ord k => VarMpStk' k v -> Set.Set k
+varmpstkKeysSet (VarMpStk s) = Set.unions $ map varmpKeysSet s
+
+varmpstkUnions :: Ord k => [VarMpStk' k v] -> VarMpStk' k v
+varmpstkUnions [x] = x
+varmpstkUnions l   = foldr (|+>) emptyVarMpStk l
+
+instance Ord k => VarLookup (VarMpStk' k v) k v where
+  varlookupWithMetaLev l k (VarMpStk s) = varlookupWithMetaLev l k s
+
+instance Ord k => VarLookupCmb (VarMpStk' k v) (VarMpStk' k v) where
+  (VarMpStk s1) |+> (VarMpStk s2) = VarMpStk (s1 |+> s2)
+
+-- Pretty printing
+
+ppVarMpV :: (PP k, PP v) => VarMp' k v -> PP_Doc
+ppVarMpV = ppVarMp vlist
+
+ppVarMp :: (PP k, PP v) => ([PP_Doc] -> PP_Doc) -> VarMp' k v -> PP_Doc
+ppVarMp ppL (VarMp mlev ms)
+  = ppL [ "@" >|< pp lev >|< ":" >#< ppL [ pp n >|< ":->" >|< pp v | (n,v) <- Map.toList m]
+        | (lev,m) <- zip [mlev..] ms
+        ]
+
+instance (PP k, PP v) => PP (VarMp' k v) where
+  pp = ppVarMp (ppListSepFill "" "" ", ")
+
+instance (PP k, PP v) => PP (VarMpStk' k v) where
+  pp (VarMpStk s) = ppListSepFill "" "" "; " $ map pp s
+
+{-
+ppVarMpInfoCfgTy :: CfgPPTy -> VarMpInfo -> PP_Doc
+ppVarMpInfoCfgTy c i
+  = case i of
+      VMITy       t -> ppTyWithCfg    c t
+      VMIImpls    i -> ppImplsWithCfg c i
+      VMIScope    s -> pp s						-- rest incomplete
+      VMIPred     p -> pp p
+      VMILabel    x -> pp x
+      VMIOffset   x -> pp x
+      VMIPredSeq  x -> pp "predseq" -- pp x
+
+ppVarMpInfoDt :: VarMpInfo -> PP_Doc
+ppVarMpInfoDt = ppVarMpInfoCfgTy cfgPPTyDT
+
+instance PP VarMpInfo where
+  pp (VMITy       t) = pp t
+  pp (VMIImpls    i) = pp i
+  pp (VMIScope    s) = pp s
+  pp (VMIPred     p) = pp p
+  pp (VMILabel    x) = pp x
+  pp (VMIOffset   x) = pp x
+  -- pp (VMIExts     x) = pp "exts" -- pp x
+  pp (VMIPredSeq  x) = pp "predseq" -- pp x
+
+instance Serialize VarMpInfo where
+  sput (VMITy      a) = sputWord8 0  >> sput a
+  sput (VMIImpls   a) = sputWord8 1  >> sput a
+  sput (VMIScope   a) = sputWord8 2  >> sput a
+  sput (VMIPred    a) = sputWord8 3  >> sput a
+  sput (VMIAssNm   a) = sputWord8 4  >> sput a
+  sput (VMILabel   a) = sputWord8 5  >> sput a
+  sput (VMIOffset  a) = sputWord8 6  >> sput a
+  sput (VMIPredSeq a) = sputWord8 7  >> sput a
+  sget = do t <- sgetWord8
+            case t of
+              0 -> liftM VMITy      sget
+              1 -> liftM VMIImpls   sget
+              2 -> liftM VMIScope   sget
+              3 -> liftM VMIPred    sget
+              4 -> liftM VMIAssNm   sget
+              5 -> liftM VMILabel   sget
+              6 -> liftM VMIOffset  sget
+              7 -> liftM VMIPredSeq sget
+-}
+
+instance (Ord k, Serialize k, Serialize v) => Serialize (VarMp' k v) where
+  sput (VarMp a b) = sput a >> sput b
+  sget = liftM2 VarMp sget sget
+
diff --git a/uhc-util.cabal b/uhc-util.cabal
--- a/uhc-util.cabal
+++ b/uhc-util.cabal
@@ -1,5 +1,5 @@
 Name:				uhc-util
-Version:			0.1.0.2
+Version:			0.1.1.0
 cabal-version:      >= 1.6
 License:			BSD3
 Copyright:			Utrecht University, Department of Information and Computing Sciences, Software Technology group
@@ -13,6 +13,10 @@
 Description:		General purpose utilities for UHC and related tools
 Synopsis:			UHC utilities
 
+source-repository head
+  type:     git
+  location: git://github.com/UU-ComputerScience/uhc-utils.git
+
 library
   Build-Depends:
     base >= 4 && < 5,
@@ -27,15 +31,18 @@
     bytestring >= 0.9 && < 1,
     uulib >= 0.9 && < 1,
     time-compat >= 0.1.0.1 && < 0.2,
-    time >= 1.2 && < 1.5
+    time >= 1.2 && < 1.5,
+    syb  >= 0.3.6
   Exposed-Modules:
     UHC.Util.AGraph,
+    UHC.Util.AssocL,
     UHC.Util.Binary,
     UHC.Util.CompileRun,
+    UHC.Util.Control.Monad,
     UHC.Util.Debug,
     UHC.Util.DependencyGraph,
-    UHC.Util.FPath,
     UHC.Util.FastSeq,
+    UHC.Util.FPath,
     UHC.Util.Nm,
     UHC.Util.ParseErrPrettyPrint,
     UHC.Util.ParseUtils,
@@ -44,8 +51,12 @@
     UHC.Util.PrettyUtils,
     UHC.Util.Rel,
     UHC.Util.ScanUtils,
+    UHC.Util.ScopeMapGam,
+    UHC.Util.Serialize,
+    UHC.Util.Time,
     UHC.Util.Utils,
-    UHC.Util.Time
+    UHC.Util.VarLookup,
+    UHC.Util.VarMp
   Ghc-Options:		
   HS-Source-Dirs:     	src
   Build-Tools: