[Git][ghc/ghc][wip/T24467] Some comments and notes
Artin Ghasivand (@Ei30metry)
gitlab at gitlab.haskell.org
Fri Aug 30 21:39:52 UTC 2024
Artin Ghasivand pushed to branch wip/T24467 at Glasgow Haskell Compiler / GHC
Commits:
22c2a374 by Artin Ghasivand at 2024-08-31T01:09:35+03:30
Some comments and notes
- - - - -
2 changed files:
- compiler/GHC/Core/DataCon.hs
- ghc/GHCi/UI.hs
Changes:
=====================================
compiler/GHC/Core/DataCon.hs
=====================================
@@ -1916,10 +1916,15 @@ dataConUserTyVarsNeedWrapper dc@(MkData { dcUnivTyVars = univ_tvs
answer = (univ_tvs ++ ex_tvs) /= dataConUserTyVars dc
-- Worker tyvars Wrapper tyvars
-
-{- Note [Creating dummy constructors for the normalize command]
-
+{- Note [Why do we normalize a DataCon instaed of an IfaceConDecl]
+Although it is theoretically possible to normalize IfaceDecls instead of DataCons,
+it is much more convinient and efficient to do the latter then the former.
+There are two main reasons behind this:
+ - Substitution
+ - Normalizing Type Family application
+It is much more easier to do these operations on Types than on IfaceTypes.
-}
+
-- See Note [Why do we normalize a DataCon instead of an IfaceConDecl]
normalizeDataConAt :: Bool -> FamInstEnvs -> TyCon -> [Type] -> DataCon -> Maybe DataCon
normalizeDataConAt removeSaturatedClass famEnv head args
@@ -1930,7 +1935,8 @@ normalizeDataConAt removeSaturatedClass famEnv head args
, dcOtherTheta = other_theta
, dcOrigArgTys = orig_arg_tys
, dcOrigResTy = orig_res_ty })
- | not remains
+ | not remains -- The constructor doesn't have the requested return type
+ -- so we don't need it anymore
= Nothing
| otherwise
= Just $
@@ -1943,40 +1949,47 @@ normalizeDataConAt removeSaturatedClass famEnv head args
, dcOrigResTy = i_res_ty }
where
orig_res_ty_args = tyConAppArgs orig_res_ty
+ -- Domain of the substitution
dom = shallowTyCoVarsOfType orig_res_ty
+ -- Build the substitution according to the return type
univ_subst = uncurry zipTvSubst
. unzip
. prune $ zip orig_res_ty_args args
-
+ -- Build the range of substitution
prune = foldr step []
where
step (t,ty) xs
| Just tyVar <- getTyVar_maybe t = (tyVar,ty) : xs
| otherwise = xs
-
+ -- Remaining user type variable binders
i_ty_var_binders = filter (flip notElemSubst subst . binderVar) ty_var_binders
+ -- Remaining equality constraints
i_eq_spec = filter (not . flip elemVarSet dom . eqSpecTyVar) eq_spec
+ -- Remaining universals
i_univ_ty_vars = filter (`isInScope` univ_subst) univ_tvs
-
+ -- Instantiated constraints
i_other_theta = normalize_theta other_theta
-
+ -- Instantiated argument types
i_arg_tys = map (mapScaledType substReduce) orig_arg_tys
+ -- Instantiated return types
i_res_ty = substReduce orig_res_ty
+ -- Final subsitution and the new existentials
(subst, i_ex_tyco_vars) = substVarBndrs univ_subst ex_tvs
-
+ -- In the of GADTs, the return type might not match the return type we are looking for
+ -- In that case, we don't need to keep the constructor.
remains = mkTyConApp head (args ++ drop (length args) orig_res_ty_args)
`eqType`
i_res_ty
-
+ -- Apply the substitution and reduce possible type family applications.
substReduce = reductionReducedType
. normaliseType famEnv Nominal
. substTy subst
-
+ -- Substitute and then normalize the constraints
normalize_theta = foldr (step . substReduce) []
where
step :: PredType -> [PredType] -> [PredType]
step pred preds
- | removeSaturatedClass
+ | removeSaturatedClass -- Remove fully saturated constraints if the user has asked us
, isEmptyVarSet . shallowTyCoVarsOfType $ pred
= preds
| otherwise
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1644,7 +1644,17 @@ pprInfo (thing, fixity, cls_insts, fam_insts, docs)
-----------------------------------------------------------------------------
-- :normalize
-normalize :: GHC.GhcMonad m => Bool -> String -> m ()
+{- Note [Arguments of the normalize command]
+The arguments of the normalize command should always be enclosed in parenthesis.
+This is because the command can take multiple arguments, and we need to have a clean
+way to disntinguish between actual arguments and arguments with which we want to normalize
+our type constructors.
+-}
+
+normalize :: GHC.GhcMonad m =>
+ Bool -> -- Remove fully saturated constraints
+ String -> -- List of arguments to normalize
+ m ()
nomralize rmSatConstrs "" = throwGhcException (UsageError "syntax ':n <(constructor arguments)>'")
normalize rmSatConstrs s =
handleSourceError printGhciException $ do
@@ -1653,6 +1663,7 @@ normalize rmSatConstrs s =
rendered <- showSDocForUser' sdoc
liftIO . putStrLn $ rendered ++ "\n"
where
+ -- Retrieve the actual arguments from the user input
actArgs = go (0, 0) ("", [])
go (n, m) (on, processed) (c:cs)
| c == '(' = go (n + 1, m) ('(' : on, processed) cs
@@ -1664,17 +1675,21 @@ normalize rmSatConstrs s =
| otherwise = go (n, m) (c : on, processed) cs
go (n, m) (on, processed) [] = reverse processed
-pprNormalizedIfaceDecl :: GHC.GhcMonad m => Bool -> String -> m SDoc
+pprNormalizedIfaceDecl :: GHC.GhcMonad m =>
+ Bool -> -- Remove saturated constraints
+ String -> -- Actual arguments
+ m SDoc
pprNormalizedIfaceDecl rmSatConstrs str = do
(ty,_) <- GHC.typeKind True str
case splitTyConApp_maybe ty of
- Nothing -> throwGhcException (CmdLineError "Something Bad happend!")
+ Nothing -> throwGhcException (UsageError (str ++ " is not a type constructor"))
Just (head,args) -> do
res <- runNormDecl toNormalizedIfaceDecl rmSatConstrs head args
case res of
Just x -> pure $ pprIfaceDecl showToIface x
Nothing -> throwGhcException (CmdLineError "Something bad happened!")
+-- See Note [Why do we normalize a DataCon instead of an IfaceConDecl]
toNormalizedIfaceDecl :: NormDecl TcRn IfaceDecl
toNormalizedIfaceDecl = tyThingToIfaceDecl False . ATyCon <$> mkNormalizedTyCon
where
@@ -1687,19 +1702,19 @@ toNormalizedIfaceDecl = tyThingToIfaceDecl False . ATyCon <$> mkNormalizedTyCon
= throwGhcException (Sorry "Can't normalize classes yet!")
| otherwise
= mkNormalizedDataTyConRhs
-
+ -- Normalize The RHS of a Newtype TyCon
mkNormalizedNewTyConRhs = do
(removeSatConstrs,tyCon,args,famInstEnvs) <- ask
lift $ mkNewTyConRhs (tyConName tyCon) tyCon . head
. mapMaybe (normalizeDataConAt removeSatConstrs famInstEnvs tyCon args)
$ tyConDataCons tyCon
-
+ -- Normalize The RHS of a Datatype TyCon
mkNormalizedDataTyConRhs = do
(removeSatConstrs,tyCon,args,famInstEnvs) <- ask
pure . mkDataTyConRhs
. mapMaybe (normalizeDataConAt removeSatConstrs famInstEnvs tyCon args)
$ tyConDataCons tyCon
-
+ -- Make a normalized Algebraic TyCon
mkNormalizedTyCon = do
(tyCon,args) <- asks (\(_,t,a,_) -> (t,a))
normalizedRhs <- mkNormalizedTyConRhs tyCon
@@ -1710,15 +1725,9 @@ toNormalizedIfaceDecl = tyThingToIfaceDecl False . ATyCon <$> mkNormalizedTyCon
(tyConCType_maybe tyCon)
(tyConStupidTheta tyCon)
normalizedRhs
- (fromJust $ algTyConFlavour tyCon)
+ (fromJust $ algTyConFlavour tyCon) -- FIXME
(isGadtSyntaxTyCon tyCon)
-{- Note [Why do we normalize a DataCon instead of an IfaceConDecl]
-TODO
-summary because we'll have to reduce and do all other sorts of stuff. Otherwise
-we'll have to convert back and forth between IfaceConDecl and DataCon.
--}
-
-----------------------------------------------------------------------------
-- :main
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22c2a374cd74298f9d10c6abbc7aa09363f31e79
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22c2a374cd74298f9d10c6abbc7aa09363f31e79
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240830/036b1f67/attachment-0001.html>
More information about the ghc-commits
mailing list