[Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Revert "Temporary hegg commit with rebuild before find"
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Sun Jul 2 11:29:22 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC
Commits:
a02d5225 by Rodrigo Mesquita at 2023-07-02T10:12:14+01:00
Revert "Temporary hegg commit with rebuild before find"
This reverts commit 0026561ee14d285ed08a74bc73c80a39960cbf52.
- - - - -
55a0531a by Rodrigo Mesquita at 2023-07-02T12:29:16+01:00
Scuffed merging without effects to salvage some information that might get lost in merging that happens outside of addVarCt
- - - - -
5 changed files:
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/TyThing/Ppr.hs-boot
- libraries/hegg
Changes:
=====================================
compiler/GHC/HsToCore/Pmc/Solver.hs
=====================================
@@ -855,8 +855,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y =
-- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left"
-- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge?
(vi_x, EG.rebuild -> env') -> do
- let env'' = env' & _class x . _data %~ (\i -> i{vi_id = vi_id vi_x}) -- (WTF1), we keep the id from the left of the merge (We could do this on the join operation really...) (We *should* have a lawful join operation. I think it would simplify things in the long run
- let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env''} }
+ let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} }
-- and then gradually merge every positive fact we have on x into y
let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args
nabla_pos <- foldlM add_pos nabla_equated (vi_pos vi_x)
@@ -877,7 +876,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y =
equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph)
equate eg x y = let (_, eg') = EG.merge x y eg
in (eg ^. _class x ._data, eg')
- -- Note: lookup in @eg@, not @eg'@, because it's before the merge.
+ -- Note: lookup in @eg@, not @eg'@, because we want to return x's data before the merge.
-- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based
@@ -1336,9 +1335,8 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} =
go (IS.elems dirty) env
where
go [] env = pure ts{ts_facts=env}
- go (x:xs) !_env = do
- let vi = env ^._class x._data
- vi' <- f x vi
+ go (x:xs) !env = do
+ vi' <- f x (lookupVarInfo ts x)
go xs (env & _class x._data .~ vi') -- Use 'over' or so instead?
traverseAll :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState
=====================================
compiler/GHC/HsToCore/Pmc/Solver/Types.hs
=====================================
@@ -867,6 +867,47 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where
-- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen.
-- 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
-
+ -- Hacks hacks hacks
+ -- Do some "obvious" things in this merge, despite keeping all the nuanced
+ -- joining operations in addVarCt. Some part of them will be redundant, but
+ -- if we don't do the simple things here we might end up losing information
+ -- when merging things through the e-graph outside of 'addVarCt'
+
+-- I think we really need effects, because the operation is only well-defined
+-- since it can fail when it is conflicting
+-- and that would allow us to do the merge procedure correcly here instead of in addVarCt
+-- we may be able to have Analysis (Effect VarInfo) (...)
+ joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b
+ , vi_pos = case (vi_pos a, vi_pos b) of
+ ([], []) -> []
+ ([], x) -> x
+ (x, []) -> x
+ (_x, y) -> y -- keep right
+ , vi_neg = foldr (flip extendPmAltConSet) (vi_neg b) (pmAltConSetElems $ vi_neg a)
+ , vi_bot = case (vi_bot a, vi_bot b) of
+ (IsBot,IsBot) -> IsBot
+ (IsBot,IsNotBot) -> IsNotBot -- keep b, achhhhh
+ (IsBot,MaybeBot) -> IsBot
+ (IsNotBot,IsBot) -> IsBot -- keep b, achhhhh
+ (IsNotBot,IsNotBot) -> IsNotBot
+ (IsNotBot,MaybeBot) -> IsNotBot
+ (MaybeBot, IsBot) -> IsBot
+ (MaybeBot, IsNotBot) -> IsNotBot
+ (MaybeBot, MaybeBot) -> MaybeBot
+ , vi_rcm = case (vi_rcm a, vi_rcm b) of
+ (RCM Nothing Nothing,RCM a b) -> RCM a b
+ (RCM Nothing (Just a),RCM Nothing Nothing) -> RCM Nothing (Just a)
+ (RCM Nothing (Just _a),RCM Nothing (Just b)) -> RCM Nothing (Just b) -- keep right
+ (RCM Nothing (Just a),RCM (Just b) Nothing) -> RCM (Just b) (Just a)
+ (RCM Nothing (Just _a),RCM (Just b) (Just c)) -> RCM (Just b) (Just c) -- keep right
+ (RCM (Just a) Nothing,RCM Nothing Nothing) -> RCM (Just a) Nothing
+ (RCM (Just a) Nothing,RCM Nothing (Just b)) -> RCM (Just a) (Just b)
+ (RCM (Just _a) Nothing,RCM (Just b) Nothing) -> RCM (Just b) Nothing -- keep right
+ (RCM (Just _a) Nothing,RCM (Just b) (Just c)) -> RCM (Just b) (Just c)
+ (RCM (Just a) (Just b),RCM Nothing Nothing) -> RCM (Just a) (Just b)
+ (RCM (Just a) (Just _b),RCM Nothing (Just c)) -> RCM (Just a) (Just c)
+ (RCM (Just _a) (Just b),RCM (Just c) Nothing) -> RCM (Just c) (Just b)
+ (RCM (Just _a) (Just _b),RCM (Just c) (Just d)) -> RCM (Just c) (Just d)
+ -- we could also have _ _, (Just c) (Just d) -> (Just c, Just d)
+ }
=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -41,7 +41,7 @@ import GHC.Types.SrcLoc (SrcSpan)
import GHC.Types.Basic (Activation, RuleName)
import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) )
import GHC.Parser.Errors.Basic
-import {-# SOURCE #-} Language.Haskell.Syntax.Expr
+import Language.Haskell.Syntax.Expr
import GHC.Unit.Module.Imported (ImportedModsVal)
import GHC.Data.FastString (fsLit)
import Language.Haskell.Syntax (LPat, LIdP)
=====================================
compiler/GHC/Types/TyThing/Ppr.hs-boot
=====================================
@@ -3,7 +3,7 @@ module GHC.Types.TyThing.Ppr (
pprTyThingInContext
) where
-import {-# SOURCE #-} GHC.Iface.Type ( ShowSub )
+import GHC.Iface.Type ( ShowSub )
import GHC.Types.TyThing ( TyThing )
import GHC.Utils.Outputable ( SDoc )
=====================================
libraries/hegg
=====================================
@@ -1 +1 @@
-Subproject commit c7af135c6c6c94d12e3af4f2c24f26bba531d4c6
+Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0026561ee14d285ed08a74bc73c80a39960cbf52...55a0531ad75f140a062eddde9f540827ff412fa3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0026561ee14d285ed08a74bc73c80a39960cbf52...55a0531ad75f140a062eddde9f540827ff412fa3
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/20230702/5c33ca97/attachment-0001.html>
More information about the ghc-commits
mailing list