diff options
author | Rodrigo Mesquita <rodrigo.m.mesquita@gmail.com> | 2023-05-11 14:53:55 +0100 |
---|---|---|
committer | Rodrigo Mesquita <rodrigo.m.mesquita@gmail.com> | 2023-05-11 14:53:59 +0100 |
commit | d97c081f88fc793e336e76ac59c5c5c57e557612 (patch) | |
tree | 051990936419e66dc07297cb3b0e1255f9112230 | |
parent | 9e29c1644350f13a1804a53cc57269064ffe5c56 (diff) | |
download | haskell-d97c081f88fc793e336e76ac59c5c5c57e557612.tar.gz |
Make match variables always lambda boundwip/romes/linear-core
The burning question being: Will variables selected for match
(`selectMatchVar`) always be bound in case patterns?
-rw-r--r-- | compiler/GHC/Core/Make.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Iteration.hs | 15 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Match.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Match/Constructor.hs | 34 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Monad.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Utils.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Types/Id.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Types/Var.hs | 1 |
9 files changed, 66 insertions, 20 deletions
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 3bf58dcd55..5984992b31 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -182,7 +182,7 @@ mkCoreAppTyped d (fun, fun_ty) arg -- -- See Note [WildCard binders] in "GHC.Core.Opt.Simplify.Env" mkWildValBinder :: Mult -> Type -> Id -mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName (LambdaBound w) ty -- ROMES: for now we consider wildcards to be lambdabound +mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName (LambdaBound w) ty -- ROMES: just tepmorarily now we consider wildcards to be lambdabound -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors -- (e.g. see test T15695). Ticket #17291 covers fixing this problem. diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs index 74c3e04e82..2dcdeaa7dc 100644 --- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs +++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs @@ -809,14 +809,14 @@ prepareRhs env top_lvl occ rhs0 anfise other = return (emptyLetFloats, other) -makeTrivialArg :: HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) +makeTrivialArg :: HasCallStack => HasDebugCallStack => SimplEnv -> ArgSpec -> SimplM (LetFloats, ArgSpec) makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) = do { (floats, e') <- makeTrivial env NotTopLevel dmd (fsLit "arg") e ; return (floats, arg { as_arg = e' }) } makeTrivialArg _ arg = return (emptyLetFloats, arg) -- CastBy, TyArg -makeTrivial :: HasDebugCallStack +makeTrivial :: HasCallStack => HasDebugCallStack => SimplEnv -> TopLevelFlag -> Demand -> FastString -- ^ A "friendly name" to build the new binder from -> OutExpr @@ -3676,7 +3676,12 @@ mkDupableContWithDmds env _ ; let join_body = wrapFloats floats1 join_inner res_ty = contResultType cont - ; mkDupableStrictBind env bndr' join_body res_ty } + -- romes: The `x` becomes an arg of the join point, so it should move + -- from let bound to lambda bound (with which multiplicity? ROMES:TODO). + -- (Note [Duplicating StrictBind] explains the transformation) + bndr'' = bndr' `setIdBinding` LambdaBound ManyTy + + ; mkDupableStrictBind env bndr'' join_body res_ty } mkDupableContWithDmds env _ (StrictArg { sc_fun = fun, sc_cont = cont @@ -3792,7 +3797,9 @@ mkDupableContWithDmds env _ -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils , sc_cont = mkBoringStop (contResultType cont) } ) } -mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType +-- ROMES:TODO: What does this function do? +-- Refer to Note [Dupable StrictBind]? StrictBind con? +mkDupableStrictBind :: HasCallStack => SimplEnv -> OutId -> OutExpr -> OutType -> SimplM (SimplFloats, SimplCont) mkDupableStrictBind env arg_bndr join_rhs res_ty | exprIsTrivial join_rhs -- See point (2) of Note [Duplicating join points] diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 06c9e32e61..0060736ab5 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -217,6 +217,12 @@ dsUnliftedBind p@(PatBind { pat_lhs = pat, pat_rhs = grhss -- ROMES:TODO: I will need to make this correct here... this transformation seems suspicious -- Matching will turn a group of equations and matching ids into a group of case expressions? -- It seems really weird for the eqn to have let bound variables, if they're patterns...? + -- + -- Should match equations ever move a let bound var into a case bound position? + -- If not, then it is never its responsibility to update the IdBindings + -- + -- It seems in matchConFamily is where we treat C x# y# = ... ==> case rhs of C x# y# -> ..? + ; pprTraceM "dsUnliftedBind:eqn" (ppr var <+> ppr eqn) ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ; return (bindNonRec var rhs result) } diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs index 6b0ea1f12d..f0e2643613 100644 --- a/compiler/GHC/HsToCore/Match.hs +++ b/compiler/GHC/HsToCore/Match.hs @@ -371,6 +371,7 @@ Among other things in the resulting Pattern: The bindings created by the above patterns are put into the returned wrapper instead. +-- ROMES:TODO: Do something about this, lambda bound can become let bound for irrefutable patterns This means a definition of the form: f x = rhs when called with v get's desugared to the equivalent of: @@ -825,8 +826,9 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches $ replicate (length (grhssGRHSs m)) initNablas +-- No wait, doesn't seem quite right? -- | Matching will turn a group of pattern-matching equations and MatchId's --- into a group of case expressions +-- into a case expression -- -- For example: -- @@ -840,6 +842,8 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- (x:xs) -> case ys' of -- [] -> [] -- (y:ys) -> f x y : mappairs f xs ys +-- +-- See also 'match' matchEquations :: HasCallStack => HsMatchContext GhcRn -> [MatchId] -> [EquationInfo] -> Type -> DsM CoreExpr @@ -970,7 +974,7 @@ groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf -- (b) none of the gi are empty -- The ordering of equations is unchanged groupEquations platform eqns - = NEL.groupBy same_gp $ [(patGroup platform (firstPat eqn), eqn) | eqn <- eqns] + = NEL.groupBy same_gp $ [pprTrace "groupEquations" (ppr (firstPat eqn)) $! (patGroup platform (firstPat eqn), eqn) | eqn <- eqns] -- comprehension on NonEmpty where same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs index 50127f9fe3..9ab8913099 100644 --- a/compiler/GHC/HsToCore/Match/Constructor.hs +++ b/compiler/GHC/HsToCore/Match/Constructor.hs @@ -93,17 +93,36 @@ have-we-used-all-the-constructors? question; the local function @match_cons_used@ does all the real work. -} +-- | Turn group of equations for a single constructor into a case expression? +-- +-- Example: +-- +-- data T = C Int Int | D Bool +-- +-- ROMES: Doesn't seem quite right, perhaps each group can only have 1 expr it's deconstructing? +-- let C a b = <expr> +-- D c = <expr> -- not sure about this second one, I think it's wrong here, just adding it bc I'm unsure. +-- in ... +-- +-- ==> +-- +-- case <expr> of +-- C a b -> ... +-- D c -> ... -- not sure about this second constructor being correct +-- +-- Relevant notes seem to be [Match Ids] and [Localise pattern binders] matchConFamily :: HasCallStack => NonEmpty Id -> Type -> NonEmpty (NonEmpty EquationInfo) -> DsM (MatchResult CoreExpr) -- Each group of eqns is for a single constructor matchConFamily (var :| vars) ty groups - = do let mult = idMult var + = pprTrace "matchConFamily" (ppr var <+> hsep (map ppr vars) $$ ppr (map idBinding (var:vars)) $$ ppr groups) $ + do let !mult = idMult var -- Each variable in the argument list correspond to one column in the -- pattern matching equations. Its multiplicity is the context -- multiplicity of the pattern. We extract that multiplicity, so that - -- 'matchOneconLike' knows the context multiplicity, in case it needs + -- 'matchOneConLike' knows the context multiplicity, in case it needs -- to come up with new variables. alts <- mapM (fmap toRealAlt . matchOneConLike vars ty mult) groups return (mkCoAlgCaseMatchResult var ty alts) @@ -198,9 +217,16 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- necessarily correct, as it may come from a variable which was -- originally let bound and will now be lambda bound. -- See comments in dsUnliftedBind too. - ; let arg_vars' = map (`setIdBinding` (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! + -- + -- ROMES:TODO:No,! We should only set LambdaBound x if we have a + -- LetBound var, otherwise it already has a multiplicity? Or should we + -- simply recompute it completely here? + -- + -- What if the only case putting us here really is dsUnliftedBind? Try to make the change there. + -- ; let arg_vars' = map (`setIdBinding` (LambdaBound ManyTy)) arg_vars -- ROMES:TODO: Not ManyTy!! It depends on the constructor! Don't always overwrite? + -- ...these arg_vars sometimes contain variables that were originally let bound, when do we make the change passing let bound variables to matchEquations? Should we always discern it here? ; return $ MkCaseAlt{ alt_pat = con1, - alt_bndrs = tvs1 ++ dicts1 ++ arg_vars', -- these arg_vars contain variables that were originally let bound + alt_bndrs = tvs1 ++ dicts1 ++ arg_vars, alt_wrapper = wrapper1, alt_result = foldr1 combineMatchResults match_results } } where diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs index fcc80f8dba..811c19375a 100644 --- a/compiler/GHC/HsToCore/Monad.hs +++ b/compiler/GHC/HsToCore/Monad.hs @@ -395,7 +395,7 @@ newSysLocalDs = mkSysLocalM (fsLit "ds") newFailLocalDs = mkSysLocalM (fsLit "fail") newSysLocalsDs :: [Scaled Type] -> DsM [Id] -newSysLocalsDs = mapM (\(Scaled w t) -> newSysLocalDs (LambdaBound w) t) -- Scaled -> LambdaBound +newSysLocalsDs = mapM (\(Scaled w t) -> newSysLocalDs (LambdaBound w) t) -- Scaled -> LambdaBound? {- We can also reach out and either set/grab location information from diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs index 0aad7eab1a..d05e3c956f 100644 --- a/compiler/GHC/HsToCore/Utils.hs +++ b/compiler/GHC/HsToCore/Utils.hs @@ -143,7 +143,7 @@ selectMatchVar :: HasCallStack => Mult -> Pat GhcTc -> DsM Id selectMatchVar w (BangPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (LazyPat _ pat) = selectMatchVar w (unLoc pat) selectMatchVar w (ParPat _ _ pat _) = selectMatchVar w (unLoc pat) -selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId (unLoc var)) +selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWithBinding (unLoc var)) $ return (localiseId ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) -- ROMES:TODO: see comment below about match variables being put in cases -- Note [Localise pattern binders] -- -- Remark: when the pattern is a variable (or @@ -151,8 +151,9 @@ selectMatchVar _w (VarPat _ var) = pprTrace "selectMatchVar:VarPat" (pprIdWit -- multiplicity stored within the variable -- itself. It's easier to pull it from the -- variable, so we ignore the multiplicity. -selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (unLoc var)) -selectMatchVar w other_pat = newSysLocalDs (LambdaBound w) (hsPatType other_pat) -- ROMES:TODO: provenance isn't so trivial in match var? +selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return ((unLoc var) `setIdBinding` (LambdaBound ManyTy))) -- ROMES:TODO: Are match variables always put in cases? If yes, then this could be a way to guarantee match variables are lambda bound/case bound +-- selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (unLoc var)) +selectMatchVar w other_pat = newSysLocalDs (LambdaBound w) (hsPatType other_pat) -- ROMES:TODO: Can match variables end up in lets and cases?, I think yes. {- Note [Localise pattern binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -300,7 +301,7 @@ data CaseAlt a = HasCallStack => MkCaseAlt{ alt_pat :: a, alt_result :: MatchResult CoreExpr } mkCoAlgCaseMatchResult - :: Id -- ^ Scrutinee + :: HasCallStack => Id -- ^ Scrutinee -> Type -- ^ Type of exp -> NonEmpty (CaseAlt DataCon) -- ^ Alternatives (bndrs *include* tyvars, dicts) -> MatchResult CoreExpr @@ -310,7 +311,7 @@ mkCoAlgCaseMatchResult var ty match_alts mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1 | otherwise - = mkDataConCase var ty match_alts + = pprTrace "mkCoAlgCaseMatchResult" (pprIdWithBinding var) $ mkDataConCase var ty match_alts where isNewtype = isNewTyCon (dataConTyCon (alt_pat alt1)) @@ -348,9 +349,9 @@ mkPatSynCase var ty alt fail = do ensure_unstrict cont | needs_void_lam = Lam voidArgId cont | otherwise = cont -mkDataConCase :: Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult CoreExpr +mkDataConCase :: HasCallStack => Id -> Type -> NonEmpty (CaseAlt DataCon) -> MatchResult CoreExpr mkDataConCase var ty alts@(alt1 :| _) - = liftA2 mk_case mk_default mk_alts + = pprTrace "mkDataConCase" (ppr var <+> ppr (idBinding var)) $ liftA2 mk_case mk_default mk_alts -- The liftA2 combines the failability of all the alternatives and the default where con1 = alt_pat alt1 @@ -365,7 +366,7 @@ mkDataConCase var ty alts@(alt1 :| _) -- (not that splitTyConApp does, these days) mk_case :: Maybe CoreAlt -> [CoreAlt] -> CoreExpr - mk_case def alts = mkWildCase (Var var) (idScaledType var) ty $ + mk_case def alts = mkWildCase (Var var) (pprTrace "mk_case:var" (pprIdWithBinding var) $ idScaledType var) ty $ maybeToList def ++ alts mk_alts :: MatchResult [CoreAlt] diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index 1d3c5ec495..bf429bbe61 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -223,6 +223,7 @@ idUsageEnv x = case Var.idBinding x of -- ROMES: Scaled Types seem to be used mainly in data cons; I think Scaled -- things remain as they are, bc they seem to only occur in places where the Id is definitely a lambda bound (or datacon, which would be the same) variable +-- Truly horrendous that this might fail like this, not how we'll leave it... at least return an optional value idScaledType :: HasCallStack => Id -> Scaled Type idScaledType id = Scaled (idMult id) (idType id) diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs index 412aee27e0..5615643275 100644 --- a/compiler/GHC/Types/Var.hs +++ b/compiler/GHC/Types/Var.hs @@ -280,6 +280,7 @@ data Var data IdBinding where LambdaBound :: !Mult -> IdBinding -- ^ includes lambda-bound and constructor fields---pattern bound LetBound :: HasCallStack => UsageEnv -> IdBinding -- ^ a local let binding has a usage env bc it might have free linear variables in its body + -- ROMES:TODO: What about type variables? LambdaBound too? Do type variables have a multiplicity? -- Removed globalbinding in exchange for LetBound with zero Ue (closed top-level let bound) -- Might no longer make sense to merge with IdScope at all |