Split Meta Variable

package.yaml

@@ -65,6 +65,7 @@ dependencies:
   - safe >= 0.3.19 && < 1
   - template-haskell >= 2.20 && < 3
   - transformers >= 0.6.1 && < 1
+  - type-map >= 0.1.7.0 && < 1
   - vector >= 0.13.1 && < 1
   - vector-algorithms >= 0.9.0.1 && < 1
   - vector-th-unbox >= 0.2.2 && < 1

src/MCSP/Data/Meta.hs

@@ -1,52 +1,53 @@
 -- | Additional variables and parameters.
 module MCSP.Data.Meta (
-    MetaVariable,
-
     -- * Collection of variables
     VariableMap,
-    empty,
-    (<:),
     lookup,
 
+    -- * Data Class
+    MetaInputVariable (..),
+    MetaOutputVariable (..),
+
     -- * Monadic operations
     Meta,
-    setVar,
+    getOrDefine,
+    setOutputVar,
+    inspect,
     (<::),
-    getVar,
-    getVarOrDefault,
 
     -- ** Execution
-    evalMetaWith,
-    runMetaWith,
     evalMeta,
     runMeta,
 ) where
 
 import Control.Applicative (Applicative)
-import Control.Monad (Monad, (>>), (>>=))
+import Control.Monad (Monad, (>>))
 import Control.Monad.Trans.State.Strict (State, evalState, gets, modify, runState, state)
-import Data.Dynamic (Dynamic, fromDynamic, toDyn)
-import Data.Function (($), (.))
+import Data.Function (id, ($), (.))
 import Data.Functor (Functor (..))
-import Data.Map.Strict qualified as Map (Map, empty, insert, keys, lookup)
 import Data.Maybe (Maybe (..))
-import Data.Proxy (Proxy (..))
-import Data.Typeable (TypeRep, Typeable, typeOf, typeRep)
-import Text.Show (Show (..), showChar, showString)
+import Data.TypeMap.Dynamic.Alt qualified as Map (Item, TypeMap, empty, insert, lookup, map, toList)
+import Data.Typeable (Typeable, showsTypeRep, typeOf)
+import Text.Show (Show (..), showChar, showListWith, showString)
 
--- | Represents a additional variable that can be used as input or output of a computation.
---
--- These variables are set and resolved dynamically inside the `Meta` monad.
-class Typeable v => MetaVariable v
+-- ---------- --
+-- Collection --
+
+-- | A fully dynamic `TypeMap` mapping from a type to itself.
+data Dynamic
+
+type instance Map.Item Dynamic v = v
 
 -- | A polymorphic storage of `MetaVariable`s.
-newtype VariableMap = VariableMap (Map.Map TypeRep Dynamic)
+newtype VariableMap = VariableMap (Map.TypeMap Dynamic)
 
 instance Show VariableMap where
-    showsPrec d (VariableMap vars) =
+    showsPrec _ (VariableMap vars) =
         showString "VariableMap"
             . showChar ' '
-            . showsPrec d (Map.keys vars)
+            . showListWith id keys
+      where
+        keys = Map.toList $ Map.map (showsTypeRep . typeOf) vars
 
 -- | A map with no variables set.
 --
@@ -59,136 +60,131 @@ empty = VariableMap Map.empty
 -- | Insert a meta-variable into the map.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
 --
 -- >>> insert @Int 12 empty
 -- VariableMap [Int]
-insert :: MetaVariable v => v -> VariableMap -> VariableMap
-insert val (VariableMap vars) =
-    VariableMap $ Map.insert (typeOf val) (toDyn val) vars
+insert :: Typeable v => v -> VariableMap -> VariableMap
+insert value (VariableMap vm) = VariableMap (Map.insert value vm)
 {-# INLINEABLE insert #-}
 
--- | Insert a meta-variable into the map.
---
--- Infix version of `insert`.
---
--- >>> import Prelude (Int, Double, String)
--- >>> instance MetaVariable Int
--- >>> instance MetaVariable Double
--- >>> instance MetaVariable String
---
--- >>> empty <: (12 :: Int) <: (3.14 :: Double) <: "Hello"
--- VariableMap [Double,Int,[Char]]
-(<:) :: MetaVariable v => VariableMap -> v -> VariableMap
-vars <: val = insert val vars
-{-# INLINEABLE (<:) #-}
-
--- | Return `Just` the value a `MetaVariable` of the given type, or `Nothing` if no such variable is
+-- | Return `Just` the value a meta-variable of the given type, or `Nothing` if no such variable is
 -- available.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
 -- >>> lookup @Int empty
 -- Nothing
 --
--- >>> lookup @Int (empty <: (12 :: Int))
+-- >>> let (_, vars) = runMeta (setVar (12 :: Int))
+-- >>> lookup @Int vars
 -- Just 12
-lookup :: forall v. MetaVariable v => VariableMap -> Maybe v
-lookup (VariableMap vars) = Map.lookup (typeRep (Proxy @v)) vars >>= fromDynamic
+lookup :: Typeable v => VariableMap -> Maybe v
+lookup (VariableMap vars) = Map.lookup vars
 {-# INLINEABLE lookup #-}
 
 -- | Return the previous value of a `MetaVariable` of the given type, or insert and return the
--- default values if no such variable is available.
+-- default value if no such variable is available.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
 -- >>> lookupOrInsert (12 :: Int) empty
 -- (12,VariableMap [Int])
 --
--- >>> lookupOrInsert (12 :: Int) $ empty <: (34 :: Int)
+-- >>> let (_, vars) = runMeta (setVar (34 :: Int))
+-- >>> lookupOrInsert (12 :: Int) vars
 -- (34,VariableMap [Int])
-lookupOrInsert :: MetaVariable v => v -> VariableMap -> (v, VariableMap)
+lookupOrInsert :: Typeable v => v -> VariableMap -> (v, VariableMap)
 lookupOrInsert defaultValue vars = case lookup vars of
     Just value -> (value, vars)
     Nothing -> (defaultValue, insert defaultValue vars)
 {-# INLINEABLE lookupOrInsert #-}
 
--- | A monad that represents operation with `MetaVariable`s.
+-- ---------------------- --
+-- Dynamic Variable Class --
+
+-- | Represents a additional variable that can be used as input of a computation.
+--
+-- These variables are set and resolved dynamically inside the `Meta` monad.
+class Typeable v => MetaInputVariable v where
+    -- | Extracts the input variable, possibly modifying the environment.
+    getVar :: Meta v
+
+-- | Represents a additional variable that can be set as output of a computation.
+--
+-- These variables are set and resolved dynamically inside the `Meta` monad.
+class Typeable v => MetaOutputVariable v where
+    -- | Updates the output variable, possibly modifying the environment.
+    setVar :: v -> Meta ()
+    setVar = setOutputVar
+
+-- ----------------- --
+-- Monadic Operation --
+
+-- | A monad that represents operation with meta-variables.
 --
 -- The meta-variables may be used as input, output or both.
 newtype Meta a = Meta (State VariableMap a)
     deriving newtype (Functor, Applicative, Monad)
 
--- | Set meta-variable for the given type.
+-- | Get the value of an input meta-variable or set a default one.
+--
+-- >>> import Prelude (String)
+-- >>> instance MetaInputVariable String where getVar = getOrDefine ""
+--
+-- >>> runMeta (getOrDefine "default")
+-- ("default",VariableMap [[Char]])
+--
+-- >>> runMeta (getOrDefine "default" <:: "pre-set")
+-- ("pre-set",VariableMap [[Char]])
+getOrDefine :: MetaInputVariable v => v -> Meta v
+getOrDefine value = Meta $ state (lookupOrInsert value)
+{-# INLINEABLE getOrDefine #-}
+
+-- | Set the value of meta-variable for the given type, without any additional side-effect.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int where
+-- >>>     setVar = setOutputVar
 --
--- >>> runMeta (setVar (12 :: Int))
+-- >>> runMeta (setOutputVar @Int 12)
 -- ((),VariableMap [Int])
-setVar :: MetaVariable v => v -> Meta ()
-setVar value = Meta $ modify (insert value)
-{-# INLINEABLE setVar #-}
+setOutputVar :: MetaOutputVariable v => v -> Meta ()
+setOutputVar value = Meta (modify $ insert value)
+{-# INLINEABLE setOutputVar #-}
 
--- | Set a meta-variable for the given type.
---
--- Infix version of `setVar`.
+-- | Set an input meta-variable for the given type.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaInputVariable Int where getVar = getOrDefine 0
 --
 -- >>> runMeta (getVar @Int <:: (12 :: Int))
--- (Just 12,VariableMap [Int])
-(<::) :: MetaVariable v => Meta a -> v -> Meta a
-m <:: value = setVar value >> m
+-- (12,VariableMap [Int])
+(<::) :: MetaInputVariable v => Meta a -> v -> Meta a
+m <:: value = Meta (modify $ insert value) >> m
 {-# INLINEABLE (<::) #-}
 
 -- | Get a meta-variable for the expected type.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
--- >>> runMeta (getVar @Int)
+-- >>> runMeta (inspect @Int)
 -- (Nothing,VariableMap [])
 --
--- >>> runMeta (getVar @Int <:: (12 :: Int))
+-- >>> runMeta (setVar (12 :: Int) >> inspect @Int)
 -- (Just 12,VariableMap [Int])
-getVar :: MetaVariable v => Meta (Maybe v)
-getVar = Meta $ gets lookup
-{-# INLINEABLE getVar #-}
-
--- | Get the value of a meta-variable or set a default one.
---
--- >>> import Prelude (String)
--- >>> instance MetaVariable String
---
--- >>> runMeta (getVarOrDefault "default")
--- ("default",VariableMap [[Char]])
---
--- >>> runMeta (getVarOrDefault "default" <:: "pre-set")
--- ("pre-set",VariableMap [[Char]])
-getVarOrDefault :: MetaVariable v => v -> Meta v
-getVarOrDefault value = Meta $ state (lookupOrInsert value)
-{-# INLINEABLE getVarOrDefault #-}
-
--- | Execute a `Meta` monad with the given variables and return the output.
-evalMetaWith :: VariableMap -> Meta a -> a
-evalMetaWith vars (Meta m) = evalState m vars
-{-# INLINEABLE evalMetaWith #-}
+inspect :: MetaOutputVariable v => Meta (Maybe v)
+inspect = Meta $ gets lookup
+{-# INLINEABLE inspect #-}
 
 -- | Execute a `Meta` monad and return the output.
 evalMeta :: Meta a -> a
-evalMeta = evalMetaWith empty
+evalMeta (Meta m) = evalState m empty
 {-# INLINEABLE evalMeta #-}
 
--- | Execute a `Meta` monad with the given variables and return the output and the final variables.
-runMetaWith :: VariableMap -> Meta a -> (a, VariableMap)
-runMetaWith vars (Meta m) = runState m vars
-{-# INLINEABLE runMetaWith #-}
-
 -- | Execute a `Meta` monad and return the output and the final variables.
 runMeta :: Meta a -> (a, VariableMap)
-runMeta = runMetaWith empty
+runMeta (Meta m) = runState m empty
 {-# INLINEABLE runMeta #-}

src/MCSP/Heuristics/Combine.hs

@@ -9,7 +9,7 @@ import Prelude hiding (String, concat, (++))
 
 import Data.Set (Set)
 
-import MCSP.Data.Meta (Meta, MetaVariable, getVarOrDefault)
+import MCSP.Data.Meta (Meta, MetaInputVariable (..), getOrDefine)
 import MCSP.Data.Pair (Pair, both, first, second)
 import MCSP.Data.String (String (..), Unbox, concat, (++))
 import MCSP.Data.String.Extra (Partition, chars, hasOneOf, singletons)
@@ -109,7 +109,8 @@ combineWithSingletons (x, y)
 newtype UseSingletons = UseSingletons Bool
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable UseSingletons
+instance MetaInputVariable UseSingletons where
+    getVar = getOrDefine (UseSingletons True)
 
 -- | MSCP combine heuristic.
 --
@@ -120,7 +121,7 @@ combine strs@(Unboxed, _) = combineP (chars `both` strs)
 -- | Lifted MSCP combine heuristic.
 combineP :: (Unbox a, Ord a) => Pair (Partition a) -> Meta (Pair (Partition a))
 combineP parts = do
-    UseSingletons withSingletons <- getVarOrDefault (UseSingletons True)
+    UseSingletons withSingletons <- getVar
     pure $
         if withSingletons
             then combineWithSingletons parts