[Git][ghc/ghc][wip/romes/ttg-zurich] fixup! ttg: extract Specificity, ForAllTyFlag and helper functions from GHC.Types.Var

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Fri Jun 21 10:41:51 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/ttg-zurich at Glasgow Haskell Compiler / GHC


Commits:
d63c4930 by Rodrigo Mesquita at 2024-06-20T15:58:19+01:00
fixup! ttg: extract Specificity, ForAllTyFlag and helper functions from GHC.Types.Var

- - - - -


4 changed files:

- + compiler/GHC/Hs/Specificity.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Types/Var.hs-boot
- compiler/ghc.cabal.in


Changes:

=====================================
compiler/GHC/Hs/Specificity.hs
=====================================
@@ -0,0 +1,52 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module GHC.Hs.Specificity where
+
+import Prelude
+import Control.DeepSeq (NFData(..))
+
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
+
+import Language.Haskell.Syntax.Specificity
+
+{- *********************************************************************
+*                                                                      *
+*                   ForAllTyFlag
+*                                                                      *
+********************************************************************* -}
+
+instance Outputable ForAllTyFlag where
+  ppr Required  = text "[req]"
+  ppr Specified = text "[spec]"
+  ppr Inferred  = text "[infrd]"
+
+instance Binary Specificity where
+  put_ bh SpecifiedSpec = putByte bh 0
+  put_ bh InferredSpec  = putByte bh 1
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> return SpecifiedSpec
+      _ -> return InferredSpec
+
+instance Binary ForAllTyFlag where
+  put_ bh Required  = putByte bh 0
+  put_ bh Specified = putByte bh 1
+  put_ bh Inferred  = putByte bh 2
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> return Required
+      1 -> return Specified
+      _ -> return Inferred
+
+instance NFData Specificity where
+  rnf SpecifiedSpec = ()
+  rnf InferredSpec = ()
+instance NFData ForAllTyFlag where
+  rnf (Invisible spec) = rnf spec
+  rnf Required = ()
+
+


=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -129,6 +129,7 @@ import GHC.Utils.Binary
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
+import GHC.Hs.Specificity ()
 import Language.Haskell.Syntax.Specificity
 
 import Data.Data
@@ -451,46 +452,6 @@ updateVarTypeM upd var
     result = do { ty' <- upd (varType var)
                 ; return (var { varType = ty' }) }
 
-{- *********************************************************************
-*                                                                      *
-*                   ForAllTyFlag
-*                                                                      *
-********************************************************************* -}
-
-instance Outputable ForAllTyFlag where
-  ppr Required  = text "[req]"
-  ppr Specified = text "[spec]"
-  ppr Inferred  = text "[infrd]"
-
-instance Binary Specificity where
-  put_ bh SpecifiedSpec = putByte bh 0
-  put_ bh InferredSpec  = putByte bh 1
-
-  get bh = do
-    h <- getByte bh
-    case h of
-      0 -> return SpecifiedSpec
-      _ -> return InferredSpec
-
-instance Binary ForAllTyFlag where
-  put_ bh Required  = putByte bh 0
-  put_ bh Specified = putByte bh 1
-  put_ bh Inferred  = putByte bh 2
-
-  get bh = do
-    h <- getByte bh
-    case h of
-      0 -> return Required
-      1 -> return Specified
-      _ -> return Inferred
-
-instance NFData Specificity where
-  rnf SpecifiedSpec = ()
-  rnf InferredSpec = ()
-instance NFData ForAllTyFlag where
-  rnf (Invisible spec) = rnf spec
-  rnf Required = ()
-
 {- *********************************************************************
 *                                                                      *
 *                   FunTyFlag


=====================================
compiler/GHC/Types/Var.hs-boot
=====================================
@@ -2,7 +2,7 @@
 module GHC.Types.Var where
 
 import {-# SOURCE #-} GHC.Types.Name
-import Language.Haskell.Syntax.Specificity (Specificity, ForAllTyFlag)
+import Language.Haskell.Syntax.Specificity (Specificity)
 
 data FunTyFlag
 data Var


=====================================
compiler/ghc.cabal.in
=====================================
@@ -535,6 +535,7 @@ Library
         GHC.Hs.Instances
         GHC.Hs.Lit
         GHC.Hs.Pat
+        GHC.Hs.Specificity
         GHC.Hs.Stats
         GHC.HsToCore
         GHC.HsToCore.Arrows



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d63c49305b66917063d30ddd300efc10c1841752

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d63c49305b66917063d30ddd300efc10c1841752
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/20240621/491ce27c/attachment-0001.html>


More information about the ghc-commits mailing list