[Git][ghc/ghc][wip/T20155] 2 commits: Revert "mkLocalId"

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC


Commits:
e1e4d8bf by Ben Gamari at 2022-08-26T09:35:33-04:00
Revert "mkLocalId"

This reverts commit ccfe60272dee0f01844d2a2569626bfffc772770.

- - - - -
54d30066 by Ben Gamari at 2022-08-26T11:39:30-04:00
genprimops

- - - - -


3 changed files:

- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/TyThing.hs-boot
- utils/genprimopcode/Main.hs


Changes:

=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -150,7 +150,6 @@ import GHC.Types.Name
 import GHC.Unit.Module
 import GHC.Core.Class
 import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
-import {-# SOURCE #-} GHC.Types.TyThing (tyThingId)
 import GHC.Types.ForeignCall
 import GHC.Data.Maybe
 import GHC.Types.SrcLoc
@@ -305,7 +304,6 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId
 
 -- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal"
 mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id
-mkLocalId name _ _ | Just thing <- wiredInNameTyThing_maybe name = tyThingId thing
 mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo
 
 -- | Make a local CoVar


=====================================
compiler/GHC/Types/TyThing.hs-boot
=====================================
@@ -2,9 +2,7 @@ module GHC.Types.TyThing where
 
 import {-# SOURCE #-} GHC.Core.TyCon
 import {-# SOURCE #-} GHC.Types.Var
-import GHC.Utils.Misc
 
 data TyThing
 mkATyCon :: TyCon -> TyThing
 mkAnId   :: Id -> TyThing
-tyThingId :: HasDebugCallStack => TyThing -> Id


=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -339,7 +339,13 @@ gen_hs_source (Info defaults entries) =
 
     prim_func :: String -> Ty -> Bool -> [String]
     prim_func n t llvm_only
-      | isRepPolyType t = []
+      | not (argsHaveFixedRuntimeRep 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.
@@ -678,21 +684,34 @@ ppTyVarBinders names = case go names of { (infs, bndrs) -> (nub infs, nub bndrs)
        , (other_infs, bndrs) <- ppTyVarBinders tvs
        = (infs ++ other_infs, bndr : bndrs)
 
--- | Is a type representationally polymorphic?
-isRepPolyType :: Ty -> Bool
-isRepPolyType (TyF a b)    = isRepPolyType a || isRepPolyType b
-isRepPolyType (TyC a b)    = isRepPolyType a || isRepPolyType b
-isRepPolyType (TyApp _ as) = any isRepPolyType as
-isRepPolyType (TyVar v)    = isRepPolyTyVar v
-isRepPolyType (TyUTup as)  = any isRepPolyType as
+-- | 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)
+
+argsHaveFixedRuntimeRep :: Ty -> Bool
+argsHaveFixedRuntimeRep ty =
+    let (args, _res) = splitFunTy ty
+     in all typeHasFixedRuntimeRep args
+
+-- | Is a type representationally monomorphic?
+typeHasFixedRuntimeRep :: Ty -> Bool
+typeHasFixedRuntimeRep (TyF a b)    = True
+typeHasFixedRuntimeRep (TyC a b)    = True
+typeHasFixedRuntimeRep (TyApp _ as) = all typeHasFixedRuntimeRep as
+typeHasFixedRuntimeRep (TyVar v)    = tyVarHasFixedRuntimeRep v
+typeHasFixedRuntimeRep (TyUTup as)  = all typeHasFixedRuntimeRep as
 
 -- | Does a tyvar have a representationally polymorphic kind?
-isRepPolyTyVar :: TyVar -> Bool
-isRepPolyTyVar "o" = True
-isRepPolyTyVar "p" = True
-isRepPolyTyVar "v" = True
-isRepPolyTyVar "w" = True
-isRepPolyTyVar _   = False
+tyVarHasFixedRuntimeRep :: TyVar -> Bool
+tyVarHasFixedRuntimeRep "o" = True
+tyVarHasFixedRuntimeRep "p" = True
+tyVarHasFixedRuntimeRep "v" = True
+tyVarHasFixedRuntimeRep "w" = True
+tyVarHasFixedRuntimeRep _   = False
 
 ppTyVar :: TyVar -> PrimOpTyVarBinder
 ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6c28bb13b7d83c1516e5820268adcfe28f4996f...54d300661d4bfa132afcb6c40538390b8d4f4b5c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6c28bb13b7d83c1516e5820268adcfe28f4996f...54d300661d4bfa132afcb6c40538390b8d4f4b5c
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/20220826/1a66da2f/attachment-0001.html>