[Git][ghc/ghc][wip/T20155] 8 commits: tcLookupId
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Sun Aug 28 10:09:18 UTC 2022
Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC
Commits:
1f09b68d by Ben Gamari at 2022-08-26T13:34:58-04:00
tcLookupId
- - - - -
262ccaf3 by Ben Gamari at 2022-08-26T13:34:58-04:00
Revert "Fix wired-in occurrences"
This reverts commit d509aae8c99e9c2c3143c3831d19e2a5d76dbbdf.
- - - - -
367a6c88 by Ben Gamari at 2022-08-26T13:34:58-04:00
genprimopcode
- - - - -
fd140853 by Ben Gamari at 2022-08-26T13:36:06-04:00
inferId
- - - - -
162be476 by Ben Gamari at 2022-08-26T13:47:58-04:00
Back out tcLookupId
- - - - -
bed74c94 by Ben Gamari at 2022-08-26T13:48:02-04:00
tcInferId
- - - - -
5d4667de by Ben Gamari at 2022-08-26T13:48:10-04:00
Error message
- - - - -
28fc6634 by Ben Gamari at 2022-08-27T16:23:03-04:00
Fix fixed runtime-rep criteria
- - - - -
6 changed files:
- compiler/GHC/Builtin/PrimOps/Ids.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Env.hs
- utils/genprimopcode/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/PrimOps/Ids.hs
=====================================
@@ -9,7 +9,7 @@ import GHC.Prelude
-- primop rules are attached to primop ids
import {-# SOURCE #-} GHC.Core.Opt.ConstantFold (primOpRules)
-import GHC.Core.Type (mkForAllTys, mkVisFunTysMany, argsHaveFixedRuntimeRep )
+import GHC.Core.Type (mkForAllTys, mkVisFunTysMany, argsHaveFixedRuntimeRep, typeHasFixedRuntimeRep )
import GHC.Core.FVs (mkRuleInfo)
import GHC.Builtin.PrimOps
@@ -39,7 +39,7 @@ mkPrimOpId prim_op
(mkPrimOpIdUnique (primOpTag prim_op))
(AnId id) UserSyntax
id = mkGlobalId (PrimOpId prim_op lev_poly) name ty info
- lev_poly = not (argsHaveFixedRuntimeRep ty)
+ lev_poly = not (argsHaveFixedRuntimeRep ty && typeHasFixedRuntimeRep res_ty)
-- PrimOps don't ever construct a product, but we want to preserve bottoms
cpr
=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -1619,7 +1619,8 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName
where
-- See Note [Getting from RuntimeRep to PrimRep] in RepType
prim_rep_fun [lev]
- = case tyConRuntimeRepInfo (tyConAppTyCon lev) of
+ | Just lev_tc <- tyConAppTyCon_maybe lev
+ = case tyConRuntimeRepInfo lev_tc of
LiftedInfo -> [LiftedRep]
UnliftedInfo -> [UnliftedRep]
_ -> pprPanic "boxedRepDataCon" (ppr lev)
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -201,9 +201,6 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-- - ones taken apart by GHC.Tc.Gen.Head.splitHsApps
-- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
-tcExpr (HsVar _ v) res_ty
- | Just (AnId id) <- wiredInNameTyThing_maybe (unLoc v)
- = return $ HsVar noExtField (noLocA id)
tcExpr e@(HsVar {}) res_ty = tcApp e res_ty
tcExpr e@(HsApp {}) res_ty = tcApp e res_ty
tcExpr e@(OpApp {}) res_ty = tcApp e res_ty
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -1037,6 +1037,9 @@ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
-- Look up an occurrence of an Id
-- Do not instantiate its type
tcInferId id_name
+ -- TODO: Note
+ | Just (AnId id) <- wiredInNameTyThing_maybe id_name = do
+ return (HsVar noExtField (noLocA id), idType id)
| id_name `hasKey` assertIdKey
= do { dflags <- getDynFlags
; if gopt Opt_IgnoreAsserts dflags
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -456,10 +456,7 @@ tcLookupLcl_maybe name
; return (lookupNameEnv local_env name) }
tcLookup :: Name -> TcM TcTyThing
-tcLookup name
- | Just thing <- wiredInNameTyThing_maybe name = do
- return $ AGlobal thing
- | otherwise = do
+tcLookup name = do
local_env <- getLclTypeEnv
case lookupNameEnv local_env name of
Just thing -> return thing
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -339,9 +339,17 @@ gen_hs_source (Info defaults entries) =
prim_func :: String -> Ty -> Bool -> [String]
prim_func n t llvm_only
+ | not (opTyHasFixedRuntimeRep t) =
+ [ "-- No wrapper due to RuntimeRep polymorphism:"
+ , "-- " ++ wrapOp n ++ " :: " ++ pprTy t
+ ]
+ -- Representationally polymorphic functions cannot be wrapped; we
+ -- instead eta expand them.
+
| llvm_only = []
-- We can't assume that GHC.Prim will be compiled via LLVM, therefore
-- we generate bottoming wrappers for LLVM-only primops.
+ -- TODO: Where does this happen?
| 0 <- arity t = []
-- Unlifted arity-0 things like void# can't be bound at the top-level.
| otherwise =
@@ -676,6 +684,37 @@ ppTyVarBinders names = case go names of { (infs, bndrs) -> (nub infs, nub bndrs)
, (other_infs, bndrs) <- ppTyVarBinders tvs
= (infs ++ other_infs, bndr : bndrs)
+-- | Split a function type into its arguments and result types.
+splitFunTy :: Ty -> ([Ty], Ty)
+splitFunTy = go []
+ where
+ go acc (TyF arg res) = go (arg:acc) res
+ go acc (TyC arg res) = go (arg:acc) res
+ go acc ty = (reverse acc, ty)
+
+-- | This should match the levity polymorphism check in
+-- GHC.Builtin.PrimOps.Ids.mkPrimOpId.
+opTyHasFixedRuntimeRep :: Ty -> Bool
+opTyHasFixedRuntimeRep ty =
+ let (args, res) = splitFunTy ty
+ in all typeHasFixedRuntimeRep args && typeHasFixedRuntimeRep res
+
+-- | Is a type representationally monomorphic?
+typeHasFixedRuntimeRep :: Ty -> Bool
+typeHasFixedRuntimeRep (TyF a b) = True
+typeHasFixedRuntimeRep (TyC a b) = True
+typeHasFixedRuntimeRep (TyApp _ as) = True
+typeHasFixedRuntimeRep (TyVar v) = tyVarHasFixedRuntimeRep v
+typeHasFixedRuntimeRep (TyUTup as) = all typeHasFixedRuntimeRep as
+
+-- | Does a tyvar have a representationally polymorphic kind?
+tyVarHasFixedRuntimeRep :: TyVar -> Bool
+tyVarHasFixedRuntimeRep "o" = False
+tyVarHasFixedRuntimeRep "p" = False
+tyVarHasFixedRuntimeRep "v" = False
+tyVarHasFixedRuntimeRep "w" = False
+tyVarHasFixedRuntimeRep _ = True
+
ppTyVar :: TyVar -> PrimOpTyVarBinder
ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec"
ppTyVar "b" = nonDepTyVarBinder "betaTyVarSpec"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54d300661d4bfa132afcb6c40538390b8d4f4b5c...28fc66345f315e4113004b0c71b145090fbe92bf
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/54d300661d4bfa132afcb6c40538390b8d4f4b5c...28fc66345f315e4113004b0c71b145090fbe92bf
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/20220828/c2204045/attachment-0001.html>
More information about the ghc-commits
mailing list