Use fewer explicit TypeRep's

byg/src/DependencyGenerator.hs

@@ -26,9 +26,8 @@ module DependencyGenerator
   ) where
 
 import Types.Token (Token(..))
-import Types.Value
 import Types.Functions (IsFunction(), IsFunctionIO(..))
-import Types.Dependency (Action(..), Dependency, makeDependency, unListType, unTupleType)
+import Types.Dependency (Action(..), Dependency, makeDependency)
 
 import Type.Reflection (Typeable, TypeRep, typeRep)
 import Control.Monad.State (MonadState, State, runState, put, get)
@@ -67,7 +66,7 @@ genDependency :: (Typeable a, Show a) => (Token a -> Dependency) -> DepGenM (Tok
 genDependency f = genDependencyM (pure . f)
 
 inject :: (Show a, Typeable a) => a -> DepGenM (Token a)
-inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
+inject x = genDependency (makeDependency NoToken (Inject x))
 
 runFunction :: IsFunction f a b => f -> Token a -> DepGenM (Token b)
 runFunction f input = genDependency (makeDependency input (Function f))
@@ -111,7 +110,7 @@ mapDepGenM f input = do
           outp <- f inp
           pure (inp, outp)
     put top'
-    pure (makeDependency input' (MapComp typeRep typeRep subDeps innerInp innerOutp) target)
+    pure (makeDependency input' (MapComp subDeps innerInp innerOutp) target)
 
 mapDepGenM_ :: (TokenableTo [a] v, Typeable a, Show a) => (Token a -> DepGenM ()) -> v -> DepGenM ()
 mapDepGenM_ f input = do
@@ -127,7 +126,7 @@ forDepGenM_ = flip mapDepGenM_
 filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u, Typeable a, Show a) => v -> u -> DepGenM (Token [a])
 filterDepGenM' mask input = do
   tup <- toTupleToken input mask
-  genDependency (makeDependency tup (FilterComp (unListType (tokenTypeRep input))))
+  genDependency (makeDependency tup FilterComp)
 
 filterDepGenM :: (TokenableTo [a] v, Typeable a, Show a) => (Token a -> DepGenM (Token Bool)) -> v -> DepGenM (Token [a])
 filterDepGenM f input = do
@@ -147,9 +146,7 @@ untupleFstDepGenM t = do
     TupleToken a _ ->
       pure a
     Token _ ->
-      let tr = tokenTypeRep t
+      genDependency (makeDependency t' UntupleFst)
-          (ta, tb) = unTupleType tr
-      in genDependency (makeDependency t' (UntupleFst ta tb))
 
 untupleSndDepGenM :: (TokenableTo (a, b) t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token b)
 untupleSndDepGenM t = do
@@ -158,9 +155,7 @@ untupleSndDepGenM t = do
     TupleToken _ b ->
       pure b
     Token _ ->
-      let tr = tokenTypeRep t
+      genDependency (makeDependency t' UntupleSnd)
-          (ta, tb) = unTupleType tr
-      in genDependency (makeDependency t' (UntupleSnd ta tb))
 
 untupleDepGenM :: (TokenableTo (a, b) t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token a, Token b)
 untupleDepGenM t = do
@@ -176,9 +171,7 @@ unzipFstDepGenM t = do
     ZipToken a _ ->
       pure a
     _ ->
-      let tr = tokenTypeRep t
+      genDependency (makeDependency t' UnzipFst)
-          (ta, tb) = unTupleType $ unListType tr
-      in genDependency (makeDependency t' (UnzipFst ta tb))
 
 unzipSndDepGenM :: (TokenableTo [(a, b)] t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token [b])
 unzipSndDepGenM t = do
@@ -187,9 +180,7 @@ unzipSndDepGenM t = do
     ZipToken _ b ->
       pure b
     _ ->
-      let tr = tokenTypeRep t
+      genDependency (makeDependency t' UnzipSnd)
-          (ta, tb) = unTupleType $ unListType tr
-      in genDependency (makeDependency t' (UnzipSnd ta tb))
 
 unzipDepGenM :: (TokenableTo [(a, b)] t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token [a], Token [b])
 unzipDepGenM t = do

byg/src/DependencyRunner.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE MonoLocalBinds #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE PatternSynonyms #-}
 module DependencyRunner
   ( DepRunM
   , runDeps
@@ -12,7 +10,6 @@ import Types.Value
 import Types.Token
 import Types.Dependency
 
-import Type.Reflection (Typeable, TypeRep, typeRep, pattern App)
 import Data.Map (Map)
 import qualified Data.Map as M
 import Control.Monad (void, forM)
@@ -52,7 +49,7 @@ runDep (Dependency _ a action _ b) =
             putStrLn "----------"
           pure result
 
-getTokenValue :: (Typeable a, Show a) => Token a -> DepRunM Value
+getTokenValue :: Token a -> DepRunM Value
 getTokenValue token = case token of
   Token i -> do
     m <- get
@@ -80,36 +77,29 @@ putTokenValue t e = case t of
   _ ->
     error "unexpected"
 
-tupApp :: TypeRep a -> TypeRep b -> TypeRep (a, b)
-tupApp ta tb = App (App (typeRep @(,)) ta) tb
-
-listApp :: TypeRep a -> TypeRep [a]
-listApp ta = App (typeRep @[]) ta
-
 runAction :: Action a b -> Value -> DepRunM Value
 runAction action input = case action of
   Function f ->
     pure $ toValue $ evalFunction f $ fromValue input
-  InlineFunction ta tb (F f) ->
+  InlineFunction (F f) ->
-    pure $ toValueRep tb $ f $ fromValueRep ta input
+    pure $ toValue $ f $ fromValue input
   FunctionIO f ->
     liftIO (toValue <$> evalFunctionIO f (fromValue input))
-  Inject v ->
+  Inject x ->
-    pure v
+    pure $ toValue x
-  FilterComp t ->
+  FilterComp ->
-    let tl = listApp t
+    let (vs, mask) = fromValue input
-        (vs, mask) = fromValueRep (tupApp tl (typeRep @[Bool])) input
+    in pure $ toValueRep (actionTargetType action) $ map fst $ filter snd $ zip vs mask
-    in pure $ toValueRep tl $ map fst $ filter snd $ zip vs mask
+  UntupleFst ->
-  UntupleFst ta tb ->
+    pure $ toValue $ fst $ fromValueRep (actionSourceType action) input
-    pure $ toValueRep ta $ fst $ fromValueRep (tupApp ta tb) input
+  UntupleSnd ->
-  UntupleSnd ta tb ->
+    pure $ toValue $ snd $ fromValueRep (actionSourceType action) input
-    pure $ toValueRep tb $ snd $ fromValueRep (tupApp ta tb) input
+  UnzipFst ->
-  UnzipFst ta tb ->
+    pure $ toValue $ map fst $ fromValueRep (actionSourceType action) input
-    pure $ toValueRep (listApp ta) $ map fst $ fromValueRep (listApp (tupApp ta tb)) input
+  UnzipSnd ->
-  UnzipSnd ta tb ->
+    pure $ toValue $ map snd $ fromValueRep (actionSourceType action) input
-    pure $ toValueRep (listApp tb) $ map snd $ fromValueRep (listApp (tupApp ta tb)) input
+  MapComp subDeps innerInput innerOutput ->
-  MapComp ta tb subDeps innerInput innerOutput ->
+    (toValueRep (actionTargetType action) <$>) $ forM (fromValueRep (actionSourceType action) input) $ \x -> do
-    (toValueRep (listApp tb) <$>) $ forM (fromValueRep (listApp ta) input) $ \x -> do
+      putTokenValue innerInput $ Evaluated $ toValue x
-      putTokenValue innerInput $ Evaluated $ toValueRep ta x
       runDeps subDeps
-      fromValueRep tb <$> getTokenValue innerOutput
+      fromValue <$> getTokenValue innerOutput

byg/src/Types/Dependency.hs

@@ -4,14 +4,13 @@ module Types.Dependency
   , F(..)
   , Dependency(..)
   , makeDependency
-  , unListType
+  , actionSourceType
-  , unTupleType
+  , actionTargetType
   , actionTouchesFilesystem
   , formatDependencyTrees
   ) where
 
 import Types.Token (Token(..))
-import Types.Value (Value)
 import Types.Functions (IsFunction(), IsFunctionIO(..))
 
 import Type.Reflection (Typeable, TypeRep, typeRep)
@@ -21,15 +20,15 @@ import qualified Data.Text as T
 
 data Action a b where
   Function :: IsFunction f a b => f -> Action a b
-  InlineFunction :: Show b => TypeRep a -> TypeRep b -> F a b -> Action a b
+  InlineFunction :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
   FunctionIO :: IsFunctionIO f a b => f -> Action a b
-  Inject :: Value -> Action () a
+  Inject :: (Typeable a, Show a) => a -> Action () a
-  FilterComp :: Show a => TypeRep a -> Action ([a], [Bool]) [a]
+  FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a]
-  UntupleFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action (a, b) a
+  UntupleFst :: (Typeable a, Show a, Typeable b, Show b) => Action (a, b) a
-  UntupleSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action (a, b) b
+  UntupleSnd :: (Typeable a, Show a, Typeable b, Show b) => Action (a, b) b
-  UnzipFst :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action [(a, b)] [a]
+  UnzipFst :: (Typeable a, Show a, Typeable b, Show b) => Action [(a, b)] [a]
-  UnzipSnd :: (Show a, Show b) => TypeRep a -> TypeRep b -> Action [(a, b)] [b]
+  UnzipSnd :: (Typeable a, Show a, Typeable b, Show b) => Action [(a, b)] [b]
-  MapComp :: (Typeable a, Show a, Typeable b, Show b) => TypeRep a -> TypeRep b -> [Dependency] -> Token a -> Token b -> Action [a] [b]
+  MapComp :: (Typeable a, Show a, Typeable b, Show b) => [Dependency] -> Token a -> Token b -> Action [a] [b]
 
 deriving instance Show (Action a b)
 
@@ -45,24 +44,24 @@ deriving instance Show Dependency
 makeDependency :: (Typeable a, Show a, Typeable b, Show b) => Token a -> Action a b -> Token b -> Dependency
 makeDependency a action b = Dependency typeRep a action typeRep b
 
-unListType :: Typeable a => TypeRep [a] -> TypeRep a
+actionSourceType :: Typeable a => Action a b -> TypeRep a
-unListType _ = typeRep
+actionSourceType _ = typeRep
 
-unTupleType :: (Typeable a, Typeable b) => TypeRep (a, b) -> (TypeRep a, TypeRep b)
+actionTargetType :: Typeable b => Action a b -> TypeRep b
-unTupleType _ = (typeRep, typeRep)
+actionTargetType _ = typeRep
 
 actionTouchesFilesystem :: Action a b -> Bool
 actionTouchesFilesystem = \case
   Function _ -> False
-  InlineFunction _ _ _ -> False
+  InlineFunction _ -> False
   FunctionIO f -> functionIOTouchesFilesystem f
   Inject _ -> False
-  FilterComp _ -> False
+  FilterComp -> False
-  UntupleFst _ _ -> False
+  UntupleFst -> False
-  UntupleSnd _ _ -> False
+  UntupleSnd -> False
-  UnzipFst _ _ -> False
+  UnzipFst -> False
-  UnzipSnd _ _ -> False
+  UnzipSnd -> False
-  MapComp _ _ subDeps _ _ -> any dependencyTouchesFilesystem subDeps
+  MapComp subDeps _ _ -> any dependencyTouchesFilesystem subDeps
   where dependencyTouchesFilesystem (Dependency _ _ action _ _) =
           actionTouchesFilesystem action
 
@@ -107,7 +106,7 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
 
         formatAction :: Text -> Action a b -> [Text]
         formatAction indentation = \case
-          MapComp _ _ subDeps innerInput innerOutput ->
+          MapComp subDeps innerInput innerOutput ->
             concat [ [ "MapComp(" ]
                    , formatToken innerInput
                    , [ " -> " ]