git.iko.soy/distributed-process
on master help sign in
Finish first implementation rank1dynamic
425cd78Edsko de Vries
rank1dynamic/rank1dynamic.cabal+8−4
compare with master
unifiedsplit
@@ -1,7 +1,9 @@
1Name: rank1dynamic
1Name: rank1dynamic
2Version: 0.1.0.0
2Version: 0.1.0.0
3−Synopsis: Version of Data.Dynamic with support for rank-1 types
3+Synopsis: Version of Data.Dynamic with support for rank-1 polymorphic types
4−-- description:
4+Description: "Data.Typeable" and "Data.Dynamic" only support monomorphic types.
5+ In this package we provide similar functionality but with
6+ support for rank-1 polymorphic types.
5Homepage: http://github.com/haskell-distributed/distributed-process
7Homepage: http://github.com/haskell-distributed/distributed-process
6License: BSD3
8License: BSD3
7License-File: LICENSE
9License-File: LICENSE
@@ -15,8 +17,10 @@ Cabal-Version: >=1.8
15Library
17Library
16 Exposed-Modules: Data.Rank1Dynamic,
18 Exposed-Modules: Data.Rank1Dynamic,
17 Data.Rank1Typeable
19 Data.Rank1Typeable
18− Build-Depends: base ==4.5.*
20+ Build-Depends: base ==4.5.*,
21+ ghc-prim >= 0.2 && < 0.3
19 HS-Source-Dirs: src
22 HS-Source-Dirs: src
20 GHC-Options: -Wall
23 GHC-Options: -Wall
21 Extensions: EmptyDataDecls,
24 Extensions: EmptyDataDecls,
22− DeriveDataTypeable
25+ DeriveDataTypeable,
26+ ViewPatterns
rank1dynamic/src/Data/Rank1Dynamic.hs+118−1
@@ -1,3 +1,120 @@
1+-- | Dynamic values with support for rank-1 polymorphic types.
2+--
3+-- [Examples of fromDynamic]
4+--
5+-- These examples correspond to the 'Data.Rank1Typeable.isInstanceOf' examples
6+-- in "Data.Rank1Typeable".
7+--
8+-- > > do f <- fromDynamic (toDynamic (even :: Int -> Bool)) ; return $ (f :: Int -> Int) 0
9+-- > Left "Cannot unify Int and Bool"
10+-- >
11+-- > > do f <- fromDynamic (toDynamic (const 1 :: ANY -> Int)) ; return $ (f :: Int -> Int) 0
12+-- > Right 1
13+-- >
14+-- > > do f <- fromDynamic (toDynamic (unsafeCoerce :: ANY1 -> ANY2)) ; return $ (f :: Int -> Int) 0
15+-- > Right 0
16+-- >
17+-- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int -> Bool) 0
18+-- > Left "Cannot unify Bool and Int"
19+-- >
20+-- > > do f <- fromDynamic (toDynamic (undefined :: ANY)) ; return $ (f :: Int -> Int) 0
21+-- > Right *** Exception: Prelude.undefined
22+-- >
23+-- > > do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int)
24+-- > Left "Cannot unify Int and ->"
25+--
26+-- [Examples of dynApply]
27+--
28+-- These examples correspond to the 'Data.Rank1Typeable.funResultTy' examples
29+-- in "Data.Rank1Typeable".
30+--
31+-- > > do app <- toDynamic (id :: ANY -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Bool)
32+-- > Right True
33+-- >
34+-- > > do app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic True ; f <- fromDynamic app ; return $ (f :: Int -> Bool) 0
35+-- > Right True
36+-- >
37+-- > > do app <- toDynamic (($ True) :: (Bool -> ANY) -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return (f :: Bool)
38+-- > Right True
39+-- >
40+-- > > app <- toDynamic (const :: ANY -> ANY1 -> ANY) `dynApply` toDynamic (id :: ANY -> ANY) ; f <- fromDynamic app ; return $ (f :: Int -> Bool -> Bool) 0 True
41+-- > Right True
42+-- >
43+-- > > do app <- toDynamic ((\f -> f . f) :: (ANY -> ANY) -> ANY -> ANY) `dynApply` toDynamic (even :: Int -> Bool) ; f <- fromDynamic app ; return (f :: ())
44+-- > Left "Cannot unify Int and Bool"
45+--
46+-- [Using toDynamic]
47+--
48+-- When using polymorphic values you need to give an explicit type annotation:
49+--
50+-- > > toDynamic id
51+-- >
52+-- > <interactive>:46:1:
53+-- > Ambiguous type variable `a0' in the constraint:
54+-- > (Typeable a0) arising from a use of `toDynamic'
55+-- > Probable fix: add a type signature that fixes these type variable(s)
56+-- > In the expression: toDynamic id
57+-- > In an equation for `it': it = toDynamic id
58+--
59+-- versus
60+--
61+-- > > toDynamic (id :: ANY -> ANY)
62+-- > <<ANY -> ANY>>
63+--
64+-- Note that these type annotation are checked by ghc like any other:
65+--
66+-- > > toDynamic (id :: ANY -> ANY1)
67+-- >
68+-- > <interactive>:45:12:
69+-- > Couldn't match expected type `V1' with actual type `V0'
70+-- > Expected type: ANY -> ANY1
71+-- > Actual type: ANY -> ANY
72+-- > In the first argument of `toDynamic', namely `(id :: ANY -> ANY1)'
73+-- > In the expression: toDynamic (id :: ANY -> ANY1)
1−module Data.Rank1Dynamic () where
74+module Data.Rank1Dynamic
75+ ( Dynamic
76+ , toDynamic
77+ , fromDynamic
78+ , TypeError
79+ , dynTypeRep
80+ , dynApply
81+ ) where
2
82
83+import qualified GHC.Prim as GHC (Any)
84+import Data.Rank1Typeable
85+ ( Typeable
86+ , TypeRep
87+ , typeOf
88+ , isInstanceOf
89+ , TypeError
90+ , funResultTy
91+ )
92+import Unsafe.Coerce (unsafeCoerce)
3
93
94+-- | Encapsulate an object and its type
95+data Dynamic = Dynamic TypeRep GHC.Any
96+
97+instance Show Dynamic where
98+ showsPrec _ (Dynamic t _) = showString "<<" . shows t . showString ">>"
99+
100+-- | Introduce a dynamic value
101+toDynamic :: Typeable a => a -> Dynamic
102+toDynamic x = Dynamic (typeOf x) (unsafeCoerce x)
103+
104+-- | Eliminate a dynamic value
105+fromDynamic :: Typeable a => Dynamic -> Either TypeError a
106+fromDynamic (Dynamic t v) =
107+ case unsafeCoerce v of
108+ r -> case typeOf r `isInstanceOf` t of
109+ Left err -> Left err
110+ Right () -> Right r
111+
112+-- | Apply one dynamic value to another
113+dynApply :: Dynamic -> Dynamic -> Either TypeError Dynamic
114+dynApply (Dynamic t1 f) (Dynamic t2 x) = do
115+ t3 <- funResultTy t1 t2
116+ return $ Dynamic t3 (unsafeCoerce f x)
117+
118+-- | The type representation of a dynamic value
119+dynTypeRep :: Dynamic -> TypeRep
120+dynTypeRep (Dynamic t _) = t
rank1dynamic/src/Data/Rank1Typeable.hs+308−85
@@ -1,8 +1,86 @@
1+-- | Runtime type representation of terms with support for rank-1 polymorphic
2+-- types with type variables of kind *.
3+--
4+-- The essence of this module is that we use the standard 'Typeable'
5+-- representation of "Data.Typeable" but we introduce a special (empty) data
6+-- type 'TypVar' which represents type variables. 'TypVar' is indexed by an
7+-- arbitrary other data type, giving you an unbounded number of type variables;
8+-- for convenience, we define 'ANY', 'ANY1', .., 'ANY9'.
9+--
10+-- [Examples of isInstanceOf]
11+--
12+-- > -- We CANNOT use a term of type 'Int -> Bool' as 'Int -> Int'
13+-- > > typeOf (undefined :: Int -> Int) `isInstanceOf` typeOf (undefined :: Int -> Bool)
14+-- > Left "Cannot unify Int and Bool"
15+-- >
16+-- > -- We CAN use a term of type 'forall a. a -> Int' as 'Int -> Int'
17+-- > > typeOf (undefined :: Int -> Int) `isInstanceOf` typeOf (undefined :: ANY -> Int)
18+-- > Right ()
19+-- >
20+-- > -- We CAN use a term of type 'forall a b. a -> b' as 'forall a. a -> a'
21+-- > > typeOf (undefined :: ANY -> ANY) `isInstanceOf` typeOf (undefined :: ANY -> ANY1)
22+-- > Right ()
23+-- >
24+-- > -- We CANNOT use a term of type 'forall a. a -> a' as 'forall a b. a -> b'
25+-- > > typeOf (undefined :: ANY -> ANY1) `isInstanceOf` typeOf (undefined :: ANY -> ANY)
26+-- > Left "Cannot unify Succ and Zero"
27+-- >
28+-- > -- We CAN use a term of type 'forall a. a' as 'forall a. a -> a'
29+-- > > typeOf (undefined :: ANY -> ANY) `isInstanceOf` typeOf (undefined :: ANY)
30+-- > Right ()
31+-- >
32+-- > -- We CANNOT use a term of type 'forall a. a -> a' as 'forall a. a'
33+-- > > typeOf (undefined :: ANY) `isInstanceOf` typeOf (undefined :: ANY -> ANY)
34+-- > Left "Cannot unify Skolem and ->"
35+--
36+-- (Admittedly, the quality of the type errors could be improved.)
37+--
38+-- [Examples of funResultTy]
39+--
40+-- > -- Apply fn of type (forall a. a -> a) to arg of type Bool gives Bool
41+-- > > funResultTy (typeOf (undefined :: ANY -> ANY)) (typeOf (undefined :: Bool))
42+-- > Right Bool
43+-- >
44+-- > -- Apply fn of type (forall a b. a -> b -> a) to arg of type Bool gives forall a. a -> Bool
45+-- > > funResultTy (typeOf (undefined :: ANY -> ANY1 -> ANY)) (typeOf (undefined :: Bool))
46+-- > Right (ANY -> Bool) -- forall a. a -> Bool
47+-- >
48+-- > -- Apply fn of type (forall a. (Bool -> a) -> a) to argument of type (forall a. a -> a) gives Bool
49+-- > > funResultTy (typeOf (undefined :: (Bool -> ANY) -> ANY)) (typeOf (undefined :: ANY -> ANY))
50+-- > Right Bool
51+-- >
52+-- > -- Apply fn of type (forall a b. a -> b -> a) to arg of type (forall a. a -> a) gives (forall a b. a -> b -> b)
53+-- > > funResultTy (typeOf (undefined :: ANY -> ANY1 -> ANY)) (typeOf (undefined :: ANY1 -> ANY1))
54+-- > Right (ANY -> ANY1 -> ANY1)
55+-- >
56+-- > -- Cannot apply function of type (forall a. (a -> a) -> a -> a) to arg of type (Int -> Bool)
57+-- > > funResultTy (typeOf (undefined :: (ANY -> ANY) -> (ANY -> ANY))) (typeOf (undefined :: Int -> Bool))
58+-- > Left "Cannot unify Int and Bool"
1module Data.Rank1Typeable
59module Data.Rank1Typeable
2− ( Rank1TypeRep
60+ ( -- * Basic types
3− , underlyingTypeRep
61+ TypeRep
4 , typeOf
62 , typeOf
63+ , splitTyConApp
64+ , mkTyConApp
65+ , underlyingTypeRep
66+ -- * Operations on type representations
67+ , isInstanceOf
68+ , funResultTy
69+ , TypeError
5 -- * Type variables
70 -- * Type variables
71+ , TypVar
72+ , Zero
73+ , Succ
74+ , V0
75+ , V1
76+ , V2
77+ , V3
78+ , V4
79+ , V5
80+ , V6
81+ , V7
82+ , V8
83+ , V9
6 , ANY
84 , ANY
7 , ANY1
85 , ANY1
8 , ANY2
86 , ANY2
@@ -13,95 +91,240 @@ module Data.Rank1Typeable
13 , ANY7
91 , ANY7
14 , ANY8
92 , ANY8
15 , ANY9
93 , ANY9
16− -- * Internal functions
94+ -- * Re-exports from Typeable
17− , occurs
95+ , Typeable
18− , subst
19− , unify
20 ) where
96 ) where
21
97
22−import Data.Typeable (Typeable, TypeRep, TyCon)
98+import Prelude hiding (succ)
23−import Control.Arrow ((***))
99+import Control.Arrow ((***), second)
100+import Control.Monad (void)
101+import Control.Applicative ((<$>))
102+import Data.List (intersperse, isPrefixOf)
103+import Data.Maybe (fromMaybe)
104+import Data.Typeable (Typeable, TyCon, tyConName, mkTyCon3)
105+import Data.Typeable.Internal (listTc, funTc)
24−import qualified Data.Typeable as Typeable (typeOf, splitTyConApp, mkTyConApp)
106+import qualified Data.Typeable as Typeable
107+ ( TypeRep
108+ , typeOf
109+ , splitTyConApp
110+ , mkTyConApp
111+ )
25
112
113+--------------------------------------------------------------------------------
114+-- The basic type --
115+--------------------------------------------------------------------------------
116+
117+-- | Dynamic type representation with support for rank-1 types
118+newtype TypeRep = TypeRep {
119+ -- | Return the underlying standard ("Data.Typeable") type representation
26−newtype Rank1TypeRep = Rank1TypeRep { underlyingTypeRep :: TypeRep }
120+ underlyingTypeRep :: Typeable.TypeRep
121+ }
27 deriving Eq
122 deriving Eq
28
123
29−instance Show Rank1TypeRep where
124+-- | The type representation of any 'Typeable' term
30− show = show . underlyingTypeRep
31−
32−typeOf :: Typeable a => a -> Rank1TypeRep
125+typeOf :: Typeable a => a -> TypeRep
33−typeOf = Rank1TypeRep . Typeable.typeOf
126+typeOf = TypeRep . Typeable.typeOf
34−
127+
35−data ANY deriving Typeable
128+--------------------------------------------------------------------------------
36−data ANY1 deriving Typeable
129+-- Constructors/destructors (views) --
37−data ANY2 deriving Typeable
130+--------------------------------------------------------------------------------
38−data ANY3 deriving Typeable
131+
39−data ANY4 deriving Typeable
132+-- | Split a type representation into the application of
40−data ANY5 deriving Typeable
133+-- a type constructor and its argument
41−data ANY6 deriving Typeable
42−data ANY7 deriving Typeable
43−data ANY8 deriving Typeable
44−data ANY9 deriving Typeable
45−
46−tvars :: [Rank1TypeRep]
47−tvars =
48− [ typeOf (undefined :: ANY)
49− , typeOf (undefined :: ANY1)
50− , typeOf (undefined :: ANY2)
51− , typeOf (undefined :: ANY3)
52− , typeOf (undefined :: ANY4)
53− , typeOf (undefined :: ANY5)
54− , typeOf (undefined :: ANY6)
55− , typeOf (undefined :: ANY7)
56− , typeOf (undefined :: ANY8)
57− , typeOf (undefined :: ANY9)
58− ]
59−
60−isTVar :: Rank1TypeRep -> Bool
61−isTVar = flip elem tvars
62−
63−splitTyConApp :: Rank1TypeRep -> (TyCon, [Rank1TypeRep])
134+splitTyConApp :: TypeRep -> (TyCon, [TypeRep])
64splitTyConApp t =
135splitTyConApp t =
65 let (c, ts) = Typeable.splitTyConApp (underlyingTypeRep t)
136 let (c, ts) = Typeable.splitTyConApp (underlyingTypeRep t)
66− in (c, map Rank1TypeRep ts)
137+ in (c, map TypeRep ts)
67
138
139+-- | Inverse of 'splitTyConApp'
68−mkTyConApp :: TyCon -> [Rank1TypeRep] -> Rank1TypeRep
140+mkTyConApp :: TyCon -> [TypeRep] -> TypeRep
69mkTyConApp c ts
141mkTyConApp c ts
70− = Rank1TypeRep (Typeable.mkTyConApp c (map underlyingTypeRep ts))
142+ = TypeRep (Typeable.mkTyConApp c (map underlyingTypeRep ts))
71−
143+
72−occurs :: Rank1TypeRep -> Rank1TypeRep -> Bool
144+isTypVar :: TypeRep -> Maybe Var
73−occurs x t
145+isTypVar (splitTyConApp -> (c, [t])) | c == typVar = Just t
74− | x == t = True
146+isTypVar _ = Nothing
147+
148+mkTypVar :: Var -> TypeRep
149+mkTypVar x = mkTyConApp typVar [x]
150+
151+typVar :: TyCon
75− | otherwise = let (_, ts) = splitTyConApp t
152+typVar = let (c, _) = splitTyConApp (typeOf (undefined :: TypVar V0)) in c
76− in any (occurs x) ts
153+
77−
154+skolem :: TyCon
78−subst :: Rank1TypeRep -> Rank1TypeRep -> Rank1TypeRep -> Rank1TypeRep
155+skolem = let (c, _) = splitTyConApp (typeOf (undefined :: Skolem V0)) in c
79−subst x t t'
156+
80− | x == t' = t
157+--------------------------------------------------------------------------------
81− | otherwise = let (c, ts) = splitTyConApp t'
158+-- Type variables --
82− in mkTyConApp c (map (subst x t) ts)
159+--------------------------------------------------------------------------------
83−
160+
84−unify :: Monad m => Rank1TypeRep -> Rank1TypeRep -> m [(Rank1TypeRep, Rank1TypeRep)]
161+data TypVar a deriving Typeable
162+data Skolem a deriving Typeable
163+data Zero deriving Typeable
164+data Succ a deriving Typeable
165+
166+type V0 = Zero
167+type V1 = Succ V0
168+type V2 = Succ V1
169+type V3 = Succ V2
170+type V4 = Succ V3
171+type V5 = Succ V4
172+type V6 = Succ V5
173+type V7 = Succ V6
174+type V8 = Succ V7
175+type V9 = Succ V8
176+
177+type ANY = TypVar V0
178+type ANY1 = TypVar V1
179+type ANY2 = TypVar V2
180+type ANY3 = TypVar V3
181+type ANY4 = TypVar V4
182+type ANY5 = TypVar V5
183+type ANY6 = TypVar V6
184+type ANY7 = TypVar V7
185+type ANY8 = TypVar V8
186+type ANY9 = TypVar V9
187+
188+--------------------------------------------------------------------------------
189+-- Operations on type reps --
190+--------------------------------------------------------------------------------
191+
192+-- | If 'isInstanceOf' fails it returns a type error
193+type TypeError = String
194+
195+-- | @t1 `isInstanceOf` t2@ checks if @t1@ is an instance of @t2@
196+isInstanceOf :: TypeRep -> TypeRep -> Either TypeError ()
85−unify t1 t2 = unify' [(t1, t2)]
197+isInstanceOf t1 t2 = void (unify (skolemize t1) t2)
86−
198+
87−unify' :: Monad m
199+-- | @funResultTy t1 t2@ is the type of the result when applying a function
88− => [(Rank1TypeRep, Rank1TypeRep)]
200+-- of type @t1@ to an argument of type @t2@
89− -> m [(Rank1TypeRep, Rank1TypeRep)]
201+funResultTy :: TypeRep -> TypeRep -> Either TypeError TypeRep
90−unify' [] =
202+funResultTy (splitTyConApp -> (fc, [farg, fres])) x | fc == funTc = do
91− return []
203+ s <- unify (alphaRename "f" farg) (alphaRename "x" x)
92−unify' ((x, t) : eqs) | isTVar x && not (isTVar t) =
204+ return (normalize (subst s (alphaRename "f" fres)))
93− if x `occurs` t
205+funResultTy f _ =
94− then fail "Occurs check"
206+ Left $ show f ++ " is not a function"
95− else do
207+
208+--------------------------------------------------------------------------------
209+-- Alpha-renaming and normalization --
210+--------------------------------------------------------------------------------
211+
212+alphaRename :: String -> TypeRep -> TypeRep
213+alphaRename prefix (isTypVar -> Just x) =
214+ mkTypVar (mkTyConApp (mkTyCon prefix) [x])
215+alphaRename prefix (splitTyConApp -> (c, ts)) =
216+ mkTyConApp c (map (alphaRename prefix) ts)
217+
218+tvars :: TypeRep -> [Var]
219+tvars (isTypVar -> Just x) = [x]
220+tvars (splitTyConApp -> (_, ts)) = concatMap tvars ts
221+
222+normalize :: TypeRep -> TypeRep
223+normalize t = subst (zip (tvars t) anys) t
224+ where
225+ anys :: [TypeRep]
226+ anys = map mkTypVar (iterate succ zero)
227+
228+ succ :: TypeRep -> TypeRep
229+ succ = mkTyConApp succTyCon . (:[])
230+
231+ zero :: TypeRep
232+ zero = mkTyConApp zeroTyCon []
233+
234+mkTyCon :: String -> TyCon
235+mkTyCon = mkTyCon3 "rank1typeable" "Data.Rank1Typeable"
236+
237+succTyCon :: TyCon
238+succTyCon = let (c, _) = splitTyConApp (typeOf (undefined :: Succ Zero)) in c
239+
240+zeroTyCon :: TyCon
241+zeroTyCon = let (c, _) = splitTyConApp (typeOf (undefined :: Zero)) in c
242+
243+--------------------------------------------------------------------------------
244+-- Unification --
245+--------------------------------------------------------------------------------
246+
247+type Substitution = [(Var, TypeRep)]
248+type Equation = (TypeRep, TypeRep)
249+type Var = TypeRep
250+
251+skolemize :: TypeRep -> TypeRep
252+skolemize (isTypVar -> Just x) = mkTyConApp skolem [x]
253+skolemize (splitTyConApp -> (c, ts)) = mkTyConApp c (map skolemize ts)
254+
255+occurs :: Var -> TypeRep -> Bool
256+occurs x (isTypVar -> Just x') = x == x'
257+occurs x (splitTyConApp -> (_, ts)) = any (occurs x) ts
258+
259+subst :: Substitution -> TypeRep -> TypeRep
260+subst s (isTypVar -> Just x) = fromMaybe (mkTypVar x) (lookup x s)
261+subst s (splitTyConApp -> (c, ts)) = mkTyConApp c (map (subst s) ts)
262+
263+unify :: TypeRep
264+ -> TypeRep
265+ -> Either TypeError Substitution
266+unify = \t1 t2 -> go [] [(t1, t2)]
267+ where
268+ go :: Substitution
269+ -> [Equation]
270+ -> Either TypeError Substitution
271+ go acc [] =
272+ return acc
273+ go acc ((t1, t2) : eqs) | t1 == t2 = -- Note: equality check is fast
274+ go acc eqs
275+ go acc ((isTypVar -> Just x, t) : eqs) =
276+ if x `occurs` t
277+ then Left "Occurs check"
278+ else go ((x, t) : map (second $ subst [(x, t)]) acc)
96− s <- unify' (map (subst x t *** subst x t) eqs)
279+ (map (subst [(x, t)] *** subst [(x, t)]) eqs)
97− return ((x, t) : s)
280+ go acc ((t, isTypVar -> Just x) : eqs) =
98−unify' ((t, x) : eqs) | isTVar x && not (isTVar t) =
281+ go acc ((mkTypVar x, t) : eqs)
99− unify' ((x, t) : eqs)
100−unify' ((x, x') : eqs) | isTVar x && isTVar x' && x == x' =
101− unify' eqs
102−unify' ((t1, t2) : eqs) = do
103− let (c1, ts1) = splitTyConApp t1
282+ go acc ((splitTyConApp -> (c1, ts1), splitTyConApp -> (c2, ts2)) : eqs) =
104− (c2, ts2) = splitTyConApp t2
105− if c1 /= c2
283+ if c1 /= c2
106− then fail $ "Cannot unify' " ++ show c1 ++ " and " ++ show c2
284+ then Left $ "Cannot unify " ++ show c1 ++ " and " ++ show c2
107− else unify' (zip ts1 ts2 ++ eqs)
285+ else go acc (zip ts1 ts2 ++ eqs)
286+
287+--------------------------------------------------------------------------------
288+-- Pretty-printing --
289+--------------------------------------------------------------------------------
290+
291+instance Show TypeRep where
292+ showsPrec p (splitTyConApp -> (tycon, tys)) =
293+ case tys of
294+ [] -> showsPrec p tycon
295+ [anyIdx -> Just i] | tycon == typVar -> showString "ANY" . showIdx i
296+ [x] | tycon == listTc ->
297+ showChar '[' . shows x . showChar ']'
298+ [a,r] | tycon == funTc ->
299+ showParen (p > 8) $ showsPrec 9 a
300+ . showString " -> "
301+ . showsPrec 8 r
302+ xs | isTupleTyCon tycon ->
303+ showTuple xs
304+ _ ->
305+ showParen (p > 9) $ showsPrec p tycon
306+ . showChar ' '
307+ . showArgs tys
308+ where
309+ showIdx 0 = showString ""
310+ showIdx i = shows i
311+
312+showArgs :: Show a => [a] -> ShowS
313+showArgs [] = id
314+showArgs [a] = showsPrec 10 a
315+showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
316+
317+anyIdx :: TypeRep -> Maybe Int
318+anyIdx (splitTyConApp -> (c, [])) | c == zeroTyCon = Just 0
319+anyIdx (splitTyConApp -> (c, [t])) | c == succTyCon = (+1) <$> anyIdx t
320+anyIdx _ = Nothing
321+
322+showTuple :: [TypeRep] -> ShowS
323+showTuple args = showChar '('
324+ . foldr (.) id ( intersperse (showChar ',')
325+ $ map (showsPrec 10) args
326+ )
327+ . showChar ')'
328+
329+isTupleTyCon :: TyCon -> Bool
330+isTupleTyCon = isPrefixOf "(," . tyConName