blob: 099ce20474ccfca8d5599f25089b5d4dc6581d57 (
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
|
module CompressArgs (compressArgs, uncompressArgs) where
import Type
import TyCoRep
import Panic
import Data.List ( findIndex )
compressArgs :: Type -> [a] -> [a]
uncompressArgs :: (a -> Type) -> (Type -> a) -> Type -> [a] -> [a]
compressArgs funTy args = go pis args
where
(pis,_) = splitPiTys funTy
-- Remove redundant type type arguments
go (Named tyBndr : pis) (_ : args)
| any (isRedundandTyVar (binderVar tyBndr)) pis
= go pis args
go (_ : pis) (a : args) = a : go pis args
go [] [] = []
-- Error conditions below
go [] _ = panic "compressArgs: not enough arrows in type"
go _ [] = panic "compressArgs: not enough args"
uncompressArgs typeOf mkType funTy args = go pis args
where
(pis,_) = splitPiTys funTy
go (Named tyBndr : pis) args
| Just i <- findIndex (isRedundandTyVar (binderVar tyBndr)) pis
-- This is a type argument we have to recover
= let args' = go pis args
in mkType (typeOf (args' !! i)) : args'
go (_ : pis) (a : args) = a : go pis args
go [] [] = []
-- Error conditions below
go [] _ = panic "uncompressArgs: not enough arrows in type"
go _ [] = panic "uncompressArgs: not enough args"
isRedundandTyVar :: TyVar -> TyBinder -> Bool
isRedundandTyVar v (Anon t) | Just v' <- getTyVar_maybe t, v == v' = True
isRedundandTyVar _ _ = False
|
