blob: b8332bdcba6e2a36a53458ca28f89574cd3049c7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# OPTIONS_GHC -w -fno-warn-redundant-constraints #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
FlexibleContexts, FlexibleInstances,
OverlappingInstances, UndecidableInstances,
KindSignatures #-}
-- Cut down from a larger core-lint error
module Q where
import Control.Monad (foldM, liftM, ap)
data NameId = NameId
data Named name a = Named
data Arg e = Arg
data Range = Range
data Name = Name
data ALetBinding = ALetBinding
data APattern a = APattern
data CExpr = CExpr
data CPattern = CPattern
data NiceDeclaration = QQ
data TypeError = NotAValidLetBinding NiceDeclaration
data TCState = TCSt { stFreshThings :: FreshThings }
data FreshThings = Fresh
newtype NewName a = NewName a
newtype LetDef = LetDef NiceDeclaration
newtype TCMT (m :: * -> *) a = TCM ()
localToAbstract :: ToAbstract c a => c -> (a -> TCMT IO b) -> TCMT IO b
localToAbstract = undefined
typeError :: MonadTCM tcm => TypeError -> tcm a
typeError = undefined
lhsArgs :: [Arg (Named String CPattern)]
lhsArgs = undefined
freshNoName :: (MonadState s m, HasFresh NameId s) => Range -> m Name
freshNoName = undefined
class (Monad m) => MonadState s m | m -> s
class (Monad m) => MonadIO m
class ToAbstract concrete abstract | concrete -> abstract where
toAbstract :: concrete -> TCMT IO abstract
class (MonadState TCState tcm) => MonadTCM tcm where
liftTCM :: TCMT IO a -> tcm a
class HasFresh i a where
nextFresh :: a -> (i,a)
instance ToAbstract c a => ToAbstract [c] [a] where
instance ToAbstract c a => ToAbstract (Arg c) (Arg a) where
instance ToAbstract c a => ToAbstract (Named name c) (Named name a) where
instance ToAbstract CPattern (APattern CExpr) where
instance ToAbstract LetDef [ALetBinding] where
toAbstract (LetDef d) = do _ <- letToAbstract
undefined
where letToAbstract = do
localToAbstract lhsArgs $ \args ->
foldM lambda undefined (undefined :: [a])
lambda _ _ = do x <- freshNoName undefined
return undefined
lambda _ _ = typeError $ NotAValidLetBinding d
instance HasFresh NameId FreshThings where
nextFresh = undefined
instance HasFresh i FreshThings => HasFresh i TCState where
nextFresh = undefined
instance Monad m => MonadState TCState (TCMT m) where
instance Monad m => MonadTCM (TCMT m) where
liftTCM = undefined
instance Functor (TCMT m) where
fmap = liftM
instance Applicative (TCMT m) where
pure = return
(<*>) = ap
instance Monad (TCMT m) where
return = undefined
(>>=) = undefined
instance Monad m => MonadIO (TCMT m) where
|
