[Git][ghc/ghc][wip/romes/eqsat-pmc] Add instances for debugging

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC


Commits:
c97d6541 by Rodrigo Mesquita at 2023-07-01T22:35:45+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/c97d6541036baa725c50909146eabcb7892bfc0e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c97d6541036baa725c50909146eabcb7892bfc0e
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/20230701/6db8b950/attachment-0001.html>