[Git][ghc/ghc][wip/ttg-booleanformula] back to IfLclName, keep the from/toIfacebooleanformula
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Sun Oct 20 15:49:24 UTC 2024
Hassan Al-Awwadi pushed to branch wip/ttg-booleanformula at Glasgow Haskell Compiler / GHC
Commits:
320af165 by Hassan Al-Awwadi at 2024-10-20T17:48:58+02:00
back to IfLclName, keep the from/toIfacebooleanformula
use mkUnboundName to switch back and forth.
- - - - -
2 changed files:
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
Changes:
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -50,6 +50,7 @@ module GHC.Iface.Syntax (
import GHC.Prelude
+import GHC.Builtin.Names(mkUnboundName)
import GHC.Data.FastString
import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
@@ -63,9 +64,9 @@ import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Core.Class
import GHC.Types.FieldLabel
-import GHC.Types.Name.Set
import GHC.Core.Coercion.Axiom ( BranchIndex )
import GHC.Types.Name
+import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.CostCentre
import GHC.Types.Literal
@@ -216,7 +217,7 @@ data IfaceClassBody
}
data IfaceBooleanFormula
- = IfVar IfaceTopBndr
+ = IfVar IfLclName
| IfAnd [IfaceBooleanFormula]
| IfOr [IfaceBooleanFormula]
| IfParens IfaceBooleanFormula
@@ -224,15 +225,17 @@ data IfaceBooleanFormula
toIfaceBooleanFormula :: BooleanFormula GhcRn -> IfaceBooleanFormula
toIfaceBooleanFormula = go
where
- go (Var nm ) = IfVar $ unLoc nm
+ go (Var nm ) = IfVar $ mkIfLclName . getOccFS . unLoc $ nm
go (And bfs ) = IfAnd $ map go bfs
go (Or bfs ) = IfOr $ map go bfs
go (Parens bf) = IfParens $ go bf
+-- | note that this makes unbound names, so if you actually want
+-- proper Names, you'll need to properly Rename it (lookupIfaceTop).
fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula GhcRn
fromIfaceBooleanFormula = go
where
- go (IfVar nm ) = Var $ noLocA nm
+ go (IfVar nm ) = Var $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm
go (IfAnd bfs ) = And $ map go bfs
go (IfOr bfs ) = Or $ map go bfs
go (IfParens bf) = Parens $ go bf
@@ -2149,14 +2152,14 @@ instance Binary IfaceDecl where
instance Binary IfaceBooleanFormula where
put_ bh = \case
- IfVar a1 -> putByte bh 0 >> putIfaceTopBndr bh a1
+ IfVar a1 -> putByte bh 0 >> put_ bh a1
IfAnd a1 -> putByte bh 1 >> put_ bh a1
IfOr a1 -> putByte bh 2 >> put_ bh a1
IfParens a1 -> putByte bh 3 >> put_ bh a1
get bh = do
getByte bh >>= \case
- 0 -> IfVar <$> getIfaceTopBndr bh
+ 0 -> IfVar <$> get bh
1 -> IfAnd <$> get bh
2 -> IfOr <$> get bh
_ -> IfParens <$> get bh
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -123,6 +123,10 @@ import GHC.Types.Tickish
import GHC.Types.TyThing
import GHC.Types.Error
+import GHC.Parser.Annotation (noLocA)
+
+import GHC.Hs.Extension ( GhcRn )
+
import GHC.Fingerprint
import Control.Monad
@@ -136,7 +140,8 @@ import qualified Data.List.NonEmpty as NE
import GHC.Builtin.Names (ioTyConName, rOOT_MAIN)
import GHC.Iface.Errors.Types
-import Language.Haskell.Syntax.BooleanFormula (mkOr)
+import Language.Haskell.Syntax.BooleanFormula (mkOr, BooleanFormula)
+import Language.Haskell.Syntax.BooleanFormula qualified as BF(BooleanFormula(..))
import Language.Haskell.Syntax.Extension (NoExtField (NoExtField))
{-
@@ -298,14 +303,9 @@ mergeIfaceDecl d1 d2
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
(mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
- -- same as BooleanFormula's mkOr, but specialized to IfaceBooleanFormula,
- -- which can be taught of as being (BooleanFormula IfacePass) morally.
- -- In practice, however, its a seperate type so it needs its own function
- -- It makes an Or and does some super basic simplification.
-
in d1 { ifBody = (ifBody d1) {
ifSigs = ops,
- ifMinDef = toIfaceBooleanFormula . mkOr $ map fromIfaceBooleanFormula [ bf1, bf2]
+ ifMinDef = toIfaceBooleanFormula . mkOr . map fromIfaceBooleanFormula $ [ bf1, bf2]
}
} `withRolesFrom` d2
-- It doesn't matter; we'll check for consistency later when
@@ -801,7 +801,7 @@ tc_iface_decl _parent ignore_prags
; sigs <- mapM tc_sig rdr_sigs
; fds <- mapM tc_fd rdr_fds
; traceIf (text "tc-iface-class3" <+> ppr tc_name)
- ; let mindef = fromIfaceBooleanFormula if_mindef
+ ; mindef <- tc_boolean_formula if_mindef
; cls <- fixM $ \ cls -> do
{ ats <- mapM (tc_at cls) rdr_ats
; traceIf (text "tc-iface-class4" <+> ppr tc_name)
@@ -850,6 +850,13 @@ tc_iface_decl _parent ignore_prags
-- e.g. type AT a; type AT b = AT [b] #8002
return (ATI tc mb_def)
+ tc_boolean_formula :: IfaceBooleanFormula -> IfL (BooleanFormula GhcRn)
+ tc_boolean_formula (IfVar nm ) = BF.Var . noLocA <$>
+ (lookupIfaceTop . mkVarOccFS . ifLclNameFS) nm
+ tc_boolean_formula (IfAnd ibfs ) = BF.And <$> traverse tc_boolean_formula ibfs
+ tc_boolean_formula (IfOr ibfs ) = BF.Or <$> traverse tc_boolean_formula ibfs
+ tc_boolean_formula (IfParens ibf) = BF.Parens <$> tc_boolean_formula ibf
+
mk_sc_doc pred = text "Superclass" <+> ppr pred
mk_at_doc tc = text "Associated type" <+> ppr tc
mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/320af165fd71594fc678d12956e9d63c81f24000
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/320af165fd71594fc678d12956e9d63c81f24000
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/20241020/9a00fa1e/attachment-0001.html>
More information about the ghc-commits
mailing list