I'm somehow experimenting with GADT. I'm implementing FRP system and I get such error: Occurs check: cannot construct the infinite type: a = (a, b) In the pattern: CircuitSplit f g In the definition of `createChannel': createChannel (CircuitSplit f g) = let (df, cf) = createChannel f (dg, cg) = createChannel g .... in (df <<< dg, Map.map merge $ Map.unionWith (\ (First x) (Second y) -> Both x y) (Map.map First cf) (Map.map Second cf))
On code: import Control.Applicative import Control.Arrow import Control.Category (Category) import qualified Control.Category import Control.Monad import Control.Monad.Fix import Data.IORef import Data.Monoid hiding (First) import Data.Map (Map) import qualified Data.Map as Map import Data.Unique import Foreign import Foreign.C import Unsafe.Coerce -- | "CSignal" is a continous signal - i.e. signal which have a value at each -- point of time data CSignal a = CSignal (IO a) instance Functor CSignal where f `fmap` (CSignal v) = CSignal $ f <$> v instance Applicative CSignal where pure x = CSignal $ pure x (CSignal f) <*> (CSignal v) = CSignal $ f <*> v -- | "DSignal" is a discret signal - i.e. signal which is point-like. data DSignal a = DSignal (Map Unique ((a -> IO ()) -> IO ())) instance Functor DSignal where f `fmap` (DSignal l) = DSignal $ Map.map (. (. f)) l instance Monoid (DSignal a) where mempty = DSignal Map.empty (DSignal l) `mappend` (DSignal s) = DSignal $ Map.union l s -- | Convers the discret signal into a continous signal readAndCacheSignal :: a -- ^ Inital value -> DSignal a -- ^ Discret signal -> IO (CSignal a) -- ^ Continous signal readAndCacheSignal v (DSignal l) = do vr <- newIORef v Map.fold (>>) (return ()) $ Map.map ($ writeIORef vr) l return $ CSignal $ readIORef vr data Circuit a b where CircuitCSignal :: CSignal a -> Circuit () a CircuitDSignal :: DSignal a -> Circuit () (Maybe a) CircuitArr :: Kleisli IO a b -> Circuit a b CircuitJoint :: Circuit b c -> Circuit a b -> Circuit a c CircuitSplit :: Circuit a c -> Circuit b d -> Circuit (a, b) (c, d) CircuitChoice :: Circuit a c -> Circuit b d -> Circuit (Either a b) (Either c d) CircuitLoop :: Circuit (a, c) (b, c) -> Circuit a b instance Category Circuit where id = CircuitArr returnA f . g = CircuitJoint f g instance Arrow Circuit where arr f = CircuitArr $ arr f first = flip CircuitSplit returnA second = CircuitSplit returnA (***) = CircuitSplit instance ArrowChoice Circuit where left = flip CircuitChoice returnA right = CircuitChoice returnA (+++) = CircuitChoice instance ArrowLoop Circuit where loop = CircuitLoop data CircuitChannel a b where CircuitChannel :: Kleisli IO (c, a) b -> ((c -> IO ()) -> IO ()) -> CircuitChannel a b data ChannelJoin a b = First a | Second b | Both a b createChannel :: Circuit a b -> (Kleisli IO a b, Map Unique (CircuitChannel a b)) createChannel (CircuitCSignal (CSignal v)) = (Kleisli (const v), Map.empty) createChannel (CircuitDSignal (DSignal l)) = (arr $ const Nothing, Map.map (CircuitChannel (arr $ Just . snd)) l) createChannel (CircuitArr a) = (a, Map.empty) createChannel (CircuitJoint f g) = let (df, cf) = createChannel f (dg, cg) = createChannel g merge (First (CircuitChannel a r)) = CircuitChannel (dg <<< a) r merge (Second (CircuitChannel a r)) = CircuitChannel (a <<< second df) r merge (Both (CircuitChannel a r) (CircuitChannel b _)) = CircuitChannel (proc (d, v) -> do v' <- b -< (d, v) a -< (d, v')) r in (df <<< dg, Map.map merge $ Map.unionWith (\(First x) (Second y) -> Both x y) (Map.map First cf) (Map.map Second cf)) createChannel (CircuitSplit f g) = let (df, cf) = createChannel f (dg, cg) = createChannel g merge (First (CircuitChannel a r)) = CircuitChannel (proc (e, (c, d)) -> do c' <- a -< (e, c) d' <- dg -< d returnA -< (c', d')) r merge (Second (CircuitChannel b r)) = CircuitChannel (proc (e, (c, d)) -> do c' <- df -< c d' <- b -< (e, d) returnA -< (c', d')) r merge (Both (CircuitChannel a r) (CircuitChannel b _)) = CircuitChannel (proc (e, (c, d)) -> do c' <- a -< (e, c) d' <- b -< (e, d) returnA -< (c', d')) r in (df <<< dg, Map.map merge $ Map.unionWith (\(First x) (Second y) -> Both x y) (Map.map First cf) (Map.map Second cf)) createChannel (CircuitChoice f g) = let (df, cf) = createChannel f (dg, cg) = createChannel g merge (First (CircuitChannel a r)) = CircuitChannel (proc (e, c) -> case c of Left x -> a -< (e, x) Right x -> dg -< x) r merge (Second (CircuitChannel a r)) = CircuitChannel (proc (e, c) -> case c of Left x -> df -< x Right x -> a -< (e, x)) r merge (Both (CircuitChannel a r) (CircuitChannel b _)) = CircuitChannel (proc (e, c) -> case c of Left x -> a -< (e, x) Right x -> b -< (e, x)) r in (df ||| dg, Map.map merge $ Map.unionWith (\(First x) (Second y) -> Both x y) (Map.map First cf) (Map.map Second cf)) createChannel (CircuitLoop f) = let (df, cf) = createChannel f in (loop df, Map.map (\(CircuitChannel a r) -> CircuitChannel (proc (e, a) -> do rec (b, c) <- a -< (e, (a, c)) returnA -< b) r) cf) I know that it will require some sort of type voodoo but where's error now? Regards
signature.asc
Description: This is a digitally signed message part
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe