| ... |
... |
@@ -32,7 +32,6 @@ import GHC.Types.Basic (Arity, RepArity) |
|
32
|
32
|
import GHC.Core.DataCon
|
|
33
|
33
|
import GHC.Core.Coercion
|
|
34
|
34
|
import GHC.Core.TyCon
|
|
35
|
|
-import GHC.Core.TyCon.Set
|
|
36
|
35
|
import GHC.Core.TyCon.RecWalk
|
|
37
|
36
|
import GHC.Core.TyCo.Rep
|
|
38
|
37
|
import GHC.Core.Type
|
| ... |
... |
@@ -80,13 +79,21 @@ isNvUnaryRep :: [PrimRep] -> Bool |
|
80
|
79
|
isNvUnaryRep [_] = True
|
|
81
|
80
|
isNvUnaryRep _ = False
|
|
82
|
81
|
|
|
83
|
|
--- | Gets rid of the stuff that prevents us from understanding the
|
|
84
|
|
--- runtime representation of a type. Including:
|
|
85
|
|
--- 1. Casts
|
|
86
|
|
--- 2. Newtypes
|
|
87
|
|
--- 3. Foralls
|
|
88
|
|
--- 4. Synonyms
|
|
89
|
|
--- But not type/data families, because we don't have the envs to hand.
|
|
|
82
|
+-- | Look through casts, foralls, type synonyms, newtypes and unary classes
|
|
|
83
|
+-- at the top-level of a type.
|
|
|
84
|
+--
|
|
|
85
|
+-- Does /not/ reduce type family applications nor peel off data family instance
|
|
|
86
|
+-- newtypes.
|
|
|
87
|
+--
|
|
|
88
|
+-- Use this function to try to discover the 'TyCon' used to represent values
|
|
|
89
|
+-- of a type at runtime:
|
|
|
90
|
+--
|
|
|
91
|
+-- * the function arrow: the values are functions;
|
|
|
92
|
+-- * a data type: the values are built from its data constructors;
|
|
|
93
|
+-- * a primitive type constructor (e.g. @Int#@, @ByteArray#@).
|
|
|
94
|
+--
|
|
|
95
|
+-- __Warning__: do __not__ use this function to compute the runtime
|
|
|
96
|
+-- representation of a type (#26695). That's what 'typePrimRep' is for.
|
|
90
|
97
|
unwrapType :: Type -> Type
|
|
91
|
98
|
unwrapType ty
|
|
92
|
99
|
| Just (_, unwrapped)
|
| ... |
... |
@@ -105,12 +112,20 @@ unwrapType ty |
|
105
|
112
|
-- cf. GHC.Core.Coercion.unwrapNewTypeStepper
|
|
106
|
113
|
stepper :: RecTcChecker -> TyCon -> [Type] -> NormaliseStepResult ()
|
|
107
|
114
|
stepper rec_nts tc tys
|
|
|
115
|
+ -- Unwrap newtypes.
|
|
108
|
116
|
| Just (ty', _) <- instNewTyCon_maybe tc tys
|
|
109
|
|
- = case checkRecTc rec_nts tc of
|
|
110
|
|
- Just rec_nts' -> NS_Step rec_nts' (go ty') ()
|
|
111
|
|
- Nothing -> NS_Abort -- infinite newtypes
|
|
|
117
|
+ = step ty'
|
|
|
118
|
+ -- Look through unary classes.
|
|
|
119
|
+ | Just (_cls, dc) <- isUnaryClassTyCon_maybe tc
|
|
|
120
|
+ , [Scaled _ ty'] <- dataConInstArgTys dc tys
|
|
|
121
|
+ = step ty'
|
|
112
|
122
|
| otherwise
|
|
113
|
123
|
= NS_Done
|
|
|
124
|
+ where
|
|
|
125
|
+ step ty' =
|
|
|
126
|
+ case checkRecTc rec_nts tc of
|
|
|
127
|
+ Just rec_nts' -> NS_Step rec_nts' (go ty') ()
|
|
|
128
|
+ Nothing -> NS_Abort -- fell into a loop (e.g. recursive newtypes)
|
|
114
|
129
|
|
|
115
|
130
|
-- | Count the arity of a function post-unarisation, including zero-width arguments.
|
|
116
|
131
|
--
|
| ... |
... |
@@ -711,7 +726,7 @@ primRepToType = anyTypeOfKind . mkTYPEapp . primRepToRuntimeRep |
|
711
|
726
|
--------------
|
|
712
|
727
|
mightBeFunTy :: Type -> Bool
|
|
713
|
728
|
-- ^ Might this type be a function type, including after looking through
|
|
714
|
|
--- newtypes and reducing type family applications?
|
|
|
729
|
+-- newtypes, unary classes, and reducing type family applications?
|
|
715
|
730
|
--
|
|
716
|
731
|
-- In particular, returns @True@ for @IO a@: after unwrapping the newtype,
|
|
717
|
732
|
-- we get @State# RealWorld -> (# State# RealWorld, a #)@, which is indeed a
|
| ... |
... |
@@ -734,26 +749,9 @@ mightBeFunTy ty |
|
734
|
749
|
-- definitely not a function type.
|
|
735
|
750
|
| definitelyUnliftedType ty
|
|
736
|
751
|
= False
|
|
737
|
|
- | Just tc <- tyConAppTyCon_maybe (unwrap_type ty)
|
|
|
752
|
+ | Just tc <- tyConAppTyCon_maybe (unwrapType ty)
|
|
738
|
753
|
-- A proper datatype (such as 'Int' or 'Maybe Bool') is definitely not
|
|
739
|
754
|
-- a function type. (This does not include newtypes nor type families.)
|
|
740
|
755
|
= not $ isBoxedDataTyCon tc
|
|
741
|
756
|
| otherwise
|
|
742
|
757
|
= True |
|
743
|
|
-
|
|
744
|
|
- where
|
|
745
|
|
- -- Use 'unwrapType' to look through casts, newtypes and foralls.
|
|
746
|
|
- -- Separately, look through unary classes (supposed to be transparent as per
|
|
747
|
|
- -- Note [Unary class magic] in GHC.Core.TyCon). We don't try to reduce type
|
|
748
|
|
- -- family applications, as we don't have a FamInstEnv to hand.
|
|
749
|
|
- unwrap_type = go emptyTyConSet
|
|
750
|
|
- where
|
|
751
|
|
- go seen_tcs ty
|
|
752
|
|
- | Just (tc, tys) <- splitTyConApp_maybe (unwrapType ty)
|
|
753
|
|
- , Just (_cls, unary_dc) <- isUnaryClassTyCon_maybe tc
|
|
754
|
|
- , [inst_meth_ty] <- map scaledThing (dataConInstArgTys unary_dc tys)
|
|
755
|
|
- = if tc `elemTyConSet` seen_tcs
|
|
756
|
|
- then ty -- cycle detected: bail out
|
|
757
|
|
- else go (seen_tcs `extendTyConSet` tc) inst_meth_ty
|
|
758
|
|
- | otherwise
|
|
759
|
|
- = ty |