[Git][ghc/ghc][wip/romes/eqsat-pmc] Add instances for debugging
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Jun 28 20:41:47 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC
Commits:
ff5cc98a by Rodrigo Mesquita at 2023-06-28T21:41:39+01:00
Add instances for debugging
- - - - -
2 changed files:
- compiler/GHC/Core/Equality.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
Changes:
=====================================
compiler/GHC/Core/Equality.hs
=====================================
@@ -26,7 +26,7 @@ import qualified Data.Equality.Graph.Monad as EGM
import Data.Equality.Utils (Fix(..))
import GHC.Utils.Misc (all2)
-import GHC.Utils.Outputable (showPprUnsafe)
+import GHC.Utils.Outputable
import GHC.Core.Coercion (coercionType)
-- Important to note the binders are also represented by $a$
@@ -343,16 +343,37 @@ cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where
GT -> GT
go l r = compare l r
--- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!!
cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering
cmpDeBruijnType d1@(D _ t1) d2@(D _ t2)
= if eqDeBruijnType d1 d2
then EQ
+ -- ROMES:TODO: Is this OK?
else compare (showPprUnsafe t1) (showPprUnsafe t2)
-
--- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!!
cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering
cmpDeBruijnCoercion (D env1 co1) (D env2 co2)
= cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2))
+-- instances for debugging purposes
+instance Show a => Show (DeBruijnF CoreExprF a) where
+ show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id
+ show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit
+ show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b
+ show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a
+ show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a
+ show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts
+
+ show (DF (D _ (CastF a cor) )) = "CastF"
+ show (DF (D _ (TickF cotick a))) = "Tick"
+ show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t)
+ show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co
+
+
+instance Show a => Show (BindF CoreBndr a) where
+ show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a
+ show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs)
+
+instance Show a => Show (AltF CoreBndr a) where
+ show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a
+
+
=====================================
compiler/GHC/HsToCore/Pmc/Solver/Types.hs
=====================================
@@ -6,6 +6,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiWayIf #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
-- | Domain types used in "GHC.HsToCore.Pmc.Solver".
-- The ultimate goal is to define 'Nabla', which models normalised refinement
@@ -241,7 +242,7 @@ instance Outputable BotInfo where
-- | Not user-facing.
instance Outputable TmState where
- ppr (TmSt _ dirty) = text "<e-graph>" $$ ppr dirty
+ ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty
-- | Not user-facing.
instance Outputable VarInfo where
@@ -829,6 +830,9 @@ instance Outputable PmEquality where
--
type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF)
+-- TODO delete orphans for showing TmEGraph for debugging reasons
+instance Show VarInfo where
+ show = showPprUnsafe . ppr
representId :: Id -> Nabla -> (ClassId, Nabla)
-- Will need to justify this well
@@ -842,7 +846,7 @@ representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) na
-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis.
-- There ought to be a better way.
instance Eq VarInfo where
- (==) _ _ = False
+ (==) a b = vi_id a == vi_id b
instance Analysis VarInfo (DeBruijnF CoreExprF) where
{-# INLINE makeA #-}
{-# INLINE joinA #-}
@@ -865,3 +869,4 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where
-- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble
joinA _a b = b
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff5cc98af2a50e16f9b8c4e40ea3f98abb448e29
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff5cc98af2a50e16f9b8c4e40ea3f98abb448e29
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/20230628/a77ec769/attachment-0001.html>
More information about the ghc-commits
mailing list