uhc-util 0.1.1.0 → 0.1.2.0

raw patch · 4 files changed

+76/−9 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/UHC/Util/ScopeMapGam.hs +53/−4
• src/UHC/Util/Utils.hs +12/−0
• src/UHC/Util/VarMp.hs +10/−4
• uhc-util.cabal +1/−1

@@ -21,16 +21,34 @@ module UHC.Util.ScopeMapGam     ( SGam     , emptySGam++    -- * Folding     , sgamFilterMapEltAccumWithKey, sgamMapEltWithKey, sgamMapThr, sgamMap++    -- * Construction & Destruction+    , sgamPop, sgamTop+    , sgamPushNew, sgamPushGam     , sgamMetaLevSingleton, sgamSingleton     , sgamUnionWith, sgamUnion     , sgamPartitionEltWithKey, sgamPartitionWithKey     , sgamUnzip-    , sgamPop, sgamTop-    , sgamPushNew, sgamPushGam+    +    -- * Deletion+    -- , sgamDeleteDupOnTop+    +    -- * Update+    , sgamAlterDupOnTop+    +    -- * Lookup     , sgamLookupMetaLevDup++    -- * Conversion     , sgamToAssocDupL, sgamFromAssocDupL     , sgamNoDups++	-- * Re-exports+	, MetaLev+	, metaLevVal     )   where @@ -92,7 +110,12 @@ sgameltInScp scp = inScp scp . sgeScpId {-# INLINE sgameltInScp #-} --- | filter out the out of scopes+-- | partition the in scopes+sgameltPartitionInScp :: Scp -> [SGamElt v] -> ([SGamElt v], [SGamElt v], [v'] -> [v'] -> [v'])+sgameltPartitionInScp scp = partitionAndRebuild (sgameltInScp scp)+{-# INLINE sgameltPartitionInScp #-}++-- | filter the in scopes sgameltFilterInScp :: Scp -> [SGamElt v] -> [SGamElt v] sgameltFilterInScp scp = filter (sgameltInScp scp) {-# INLINE sgameltFilterInScp #-}@@ -155,9 +178,11 @@ 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 +-- | Construct singleton gam, on a particular meta level sgamMetaLevSingleton :: MetaLev -> k -> v -> SGam k v sgamMetaLevSingleton mlev k v = mkSGam (varmpMetaLevSingleton mlev k [SGamElt 0 v]) +-- | Construct singleton gam sgamSingleton :: k -> v -> SGam k v sgamSingleton = sgamMetaLevSingleton metaLevVal @@ -167,7 +192,11 @@   = 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 ])+                     (\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@@ -210,6 +239,26 @@ -- | 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++{- unfinished...+-- | delete an in scope entry, only if on top, using a function splitting the list of values into those which are removal candidates and not+sgamDeleteDupOnTop :: Ord k => ([SGamElt v] -> ([SGamElt v],[SGamElt v])) -> k -> SGam k v -> SGam k v+sgamDeleteDupOnTop split k g@(SGam {sgMap = m, sgScp = scp@(hscp:_)})+  = g {sgMap = update updDel k m}+  where updDel vs = if null all then Nothing else Just all+          where (del,leave) = split $ sgameltFilterInScp scp vs+                del' = filter (\v -> sgeScpId v == hscp) del+                all = del' ++ leave+-}++-- | Alter on top of the scope stack, including all duplicates+sgamAlterDupOnTop :: Ord k => (Maybe v -> Maybe v) -> k -> SGam k v -> SGam k v+sgamAlterDupOnTop f k g@(SGam {sgMap = m, sgScp = scp@(hscp:_)})+  = g {sgMap = varmpAlter alt k m}+  where alt Nothing   = fmap (\v -> [SGamElt hscp v]) $ f Nothing+        alt (Just vs) = if null vs' then Nothing else Just vs'+          where (inscp,leave,mk) = sgameltPartitionInScp scp vs+                vs' = catMaybes $ mk (map (\e -> fmap (\v -> e {sgeVal = v}) $ f $ Just $ sgeVal e) inscp) (map Just leave)  -- | lookup, return at least one found value, otherwise Nothing sgamLookupMetaLevDup :: Ord k => MetaLev -> k -> SGam k v -> Maybe [v]

@@ -202,6 +202,18 @@                             | otherwise    = ([x],yys)  -------------------------------------------------------------------------+-- Partitioning with rebuild+-------------------------------------------------------------------------++-- | Partition, but also return a function which will rebuild according to the original ordering of list elements+partitionAndRebuild :: (v -> Bool) -> [v] -> ([v], [v], [v'] -> [v'] -> [v'])+partitionAndRebuild f (v:vs)+  | f v                  = (v : vs1,     vs2, \(r:r1)   r2  -> r : mk r1 r2)+  | otherwise            = (    vs1, v : vs2, \   r1 (r:r2) -> r : mk r1 r2)+  where (vs1,vs2,mk) = partitionAndRebuild f vs+partitionAndRebuild _ [] = ([], [], \_ _ -> [])++------------------------------------------------------------------------- -- Ordering ------------------------------------------------------------------------- 

@@ -29,6 +29,7 @@ 	-- , varmpFilterTy 	, varmpFilter 	, varmpDel, (|\>)+	, varmpAlter 	, varmpUnion, varmpUnions 	--, varmpTyLookupCyc 	--, varmpTyLookupCyc2@@ -107,8 +108,8 @@  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+      { 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@@ -138,11 +139,16 @@   = (VarMp l p1, VarMp l p2)   where (p1,p2) = unzip $ map (Map.partitionWithKey f) m +(|\>) :: Ord k => VarMp' k v -> [k] -> VarMp' k v+(|\>) = flip varmpDel++-- | Delete 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+-- | Alter irrespective of level+varmpAlter :: Ord k => (Maybe v -> Maybe v) -> k -> VarMp' k v -> VarMp' k v+varmpAlter f k (VarMp l c) = VarMp l (map (Map.alter f k) c)  -- shift up the level, -- or down when negative, throwing away the lower levels

@@ -1,5 +1,5 @@ Name:				uhc-util-Version:			0.1.1.0+Version:			0.1.2.0 cabal-version:      >= 1.6 License:			BSD3 Copyright:			Utrecht University, Department of Information and Computing Sciences, Software Technology group