From a3a73a28e7bbfb808c75473dc4909a2963fdf590 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 4 May 2024 08:57:01 -0400 Subject: [PATCH] Introduce `DLamCasesE`, deprecate `DLamE`/`DCaseE` This patch deprecates the `DLamE` and `DCaseE` data constructors of `DExp` in favor of a new `DLamCasesE` data constructor, which represents `\cases` expressions. Moreover, `th-desugar` now desugars all lambda, `case`, `\case`, and `\cases` expressions to `DLamCasesE`. There are several reasons why this is desirable, but an especially important motivation for switching is to support desugaring expressions that use embedded type patterns (see #204) or invisible type patterns (see #205) in lambda, `case`, `\case`, and `\cases` expressions. This is a pretty big change, even by `th-desugar` standards. As such, I have made an effort to avoid some of the more extreme breaking changes for now. For example, I have refrained from removing `DLamE` and `DCaseE` outright, instead converting them to deprecated pattern synonyms. I have also introduced combinators such as `dLamE` and `dCaseE`, which construct lambda-like and `case`-like expressions in terms of `DLamCasesE`. For the full details on how to migrate your code over to use `DLamCaseE`, see the new `doc/LambdaCaseMigration.md` document. This patch: * Fixes #210 (by replacing `DLamE`/`DCaseE` with `DLamCasesE`) * Fixes #204 (by supporting higher-order uses of embedded type patterns) * Fixes #205 (for supporting higher-order uses of invisible type patterns) This also adds regression tests for #204 and #205. --- CHANGES.md | 30 ++- Language/Haskell/TH/Desugar.hs | 8 +- Language/Haskell/TH/Desugar/AST.hs | 165 +++++++++++++-- Language/Haskell/TH/Desugar/Core.hs | 276 ++++++++++++++++++------- Language/Haskell/TH/Desugar/Match.hs | 64 +++--- Language/Haskell/TH/Desugar/Sweeten.hs | 60 +++++- README.md | 90 -------- Test/Run.hs | 8 + Test/Splices.hs | 57 +++++ docs/LambdaCaseMigration.md | 256 +++++++++++++++++++++++ 10 files changed, 799 insertions(+), 215 deletions(-) create mode 100644 docs/LambdaCaseMigration.md diff --git a/CHANGES.md b/CHANGES.md index 071bca1..362c03c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,9 +3,33 @@ Version 1.18 [????.??.??] ------------------------- -* The `dsMatches` function now requires a `MatchContext` argument, which - determines what kind of "`Non-exhaustive patterns in ...`" error it raises - when reaching a fallthrough case for non-exhaustive matches. +* The `DLamE` and `DCaseE` data constructors (as well as the related + `mkDLamEFromDPats` function) are now deprecated in favor of the new + `DLamCasesE` data constructor. `DLamE`, `DCaseE`, and `mkDLamEFromDPats` will + be removed in a future release of `th-desugar`, so users are encouraged to + migrate. For more details on how to migrate your code, see [this + document](https://github.com/goldfirere/th-desugar/blob/master/docs/LambdaCaseMigration.md). +* The type of the `dsMatches` function has changed: + + ```diff + -dsMatches :: DsMonad q => Name -> [Match] -> q [DMatch] + -dsMatches :: DsMonad q => MatchContext -> [Match] -> q [DMatch] + ``` + + In particular: + + * `dsMatches` function no longer includes a `Name` argument for the + variable being scrutinized, as the new approach that `th-desugar` uses to + desugar `Match`es no longer requires this. + * `dsMatches` now requires a `MatchContext` argument, which + determines what kind of "`Non-exhaustive patterns in ...`" error it raises + when reaching a fallthrough case for non-exhaustive matches. +* Add a `maybeDCasesE :: MatchContext -> [DExp] -> [DClause] -> DExp` function. + `maybeDCasesE` is similar to `maybeDCaseE` except that it matches on multiple + expressions (using `\\cases`) instead of matching on a single expression. +* Add support for desugaring higher-order uses of embedded type patterns (e.g., + `\(type a) (x :: a) -> x :: a`) and invisible type patterns (e.g., + `\ @a (x :: a) -> x :: a`). Version 1.17 [2024.05.12] ------------------------- diff --git a/Language/Haskell/TH/Desugar.hs b/Language/Haskell/TH/Desugar.hs index 9ead275..64833a9 100644 --- a/Language/Haskell/TH/Desugar.hs +++ b/Language/Haskell/TH/Desugar.hs @@ -24,7 +24,8 @@ rae@cs.brynmawr.edu module Language.Haskell.TH.Desugar ( -- * Desugared data types - DExp(..), DLetDec(..), NamespaceSpecifier(..), DPat(..), + DExp(..), pattern DLamE, pattern DCaseE, + DLetDec(..), NamespaceSpecifier(..), DPat(..), DType(..), DForallTelescope(..), DKind, DCxt, DPred, DTyVarBndr(..), DTyVarBndrSpec, DTyVarBndrUnit, Specificity(..), DTyVarBndrVis, @@ -100,7 +101,8 @@ module Language.Haskell.TH.Desugar ( getDataD, dataConNameToDataName, dataConNameToCon, nameOccursIn, allNamesIn, flattenDValD, getRecordSelectors, mkTypeName, mkDataName, newUniqueName, - mkTupleDExp, mkTupleDPat, maybeDLetE, maybeDCaseE, mkDLamEFromDPats, + mkTupleDExp, mkTupleDPat, maybeDLetE, maybeDCaseE, maybeDCasesE, + dCaseE, dCasesE, dLamE, dLamCaseE, mkDLamEFromDPats, tupleNameDegree_maybe, unboxedSumNameDegree_maybe, unboxedTupleNameDegree_maybe, isTypeKindName, typeKindName, bindIP, @@ -234,7 +236,7 @@ flattenDValD (DValD pat exp) = do y <- newUniqueName "y" let pat' = wildify name y pat match = DMatch pat' (DVarE y) - cas = DCaseE (DVarE x) [match] + cas = dCaseE (DVarE x) [match] return $ DValD (DVarP name) cas wildify name y p = diff --git a/Language/Haskell/TH/Desugar/AST.hs b/Language/Haskell/TH/Desugar/AST.hs index a3a03b0..c9a5f1d 100644 --- a/Language/Haskell/TH/Desugar/AST.hs +++ b/Language/Haskell/TH/Desugar/AST.hs @@ -6,7 +6,7 @@ Defines the desugared Template Haskell AST. The desugared types and constructors are prefixed with a D. -} -{-# LANGUAGE CPP, DeriveDataTypeable, DeriveTraversable, DeriveGeneric, DeriveLift #-} +{-# LANGUAGE CPP, DeriveDataTypeable, DeriveTraversable, DeriveGeneric, DeriveLift, PatternSynonyms, ViewPatterns #-} module Language.Haskell.TH.Desugar.AST where @@ -30,8 +30,24 @@ data DExp = DVarE Name | DLitE Lit | DAppE DExp DExp | DAppTypeE DExp DType - | DLamE [Name] DExp - | DCaseE DExp [DMatch] + -- | A @\\cases@ expression. In the spirit of making 'DExp' minimal, + -- @th-desugar@ will desugar lambda expressions, @case@ expressions, + -- @\\case@ expressions, and @\\cases@ expressions to 'DLamCasesE'. + -- (See also the 'dLamE', 'dCaseE', and 'dLamCaseE' functions for + -- constructing these expressions in terms of 'DLamCasesE'.) + -- + -- A 'DLamCasesE' value should obey the following invariants: + -- + -- * Each 'DClause' should have exactly the same number of visible + -- arguments in its list of 'DPat's. + -- + -- * If the list of 'DClause's is empty, then the overall expression + -- should have exactly one argument. Note that this is a + -- difference in behavior from how @\\cases@ expressions work, as + -- @\\cases@ is required to have at least one clause. For this + -- reason, @th-desugar@ will sweeten @DLamCasesE []@ to + -- @\\case{}@. + | DLamCasesE [DClause] | DLetE [DLetDec] DExp | DSigE DExp DType | DStaticE DExp @@ -40,6 +56,112 @@ data DExp = DVarE Name | DTypeE DType deriving (Eq, Show, Data, Generic, Lift) +-- | A 'DLamCasesE' value with exactly one 'DClause' where all 'DPat's are +-- 'DVarP's. This pattern synonym is provided for backwards compatibility with +-- older versions of @th-desugar@ in which 'DLamE' was a data constructor of +-- 'DExp'. This pattern synonym is deprecated and will be removed in a future +-- release of @th-desugar@. +pattern DLamE :: [Name] -> DExp -> DExp +pattern DLamE vars rhs <- (dLamE_maybe -> Just (vars, rhs)) + where + DLamE vars rhs = DLamCasesE [DClause (map DVarP vars) rhs] +{-# DEPRECATED DLamE "Use `dLamE` or `DLamCasesE` instead." #-} + +-- | Return @'Just' (pats, rhs)@ if the supplied 'DExp' is a 'DLamCasesE' value +-- with exactly one 'DClause' where all 'DPat's are 'DVarP's, where @pats@ is +-- the list of 'DVarP' 'Name's and @rhs@ is the expression on the right-hand +-- side of the 'DClause'. Otherwise, return 'Nothing'. +dLamE_maybe :: DExp -> Maybe ([Name], DExp) +dLamE_maybe (DLamCasesE [DClause pats rhs]) = do + vars <- traverse dVarP_maybe pats + Just (vars, rhs) +dLamE_maybe _ = Nothing + +-- | Return @'Just' var@ if the supplied 'DPat' is a 'DVarP' value, where @var@ +-- is the 'DVarP' 'Name'. Otherwise, return 'Nothing'. +dVarP_maybe :: DPat -> Maybe Name +dVarP_maybe (DVarP n) = Just n +dVarP_maybe _ = Nothing + +-- | An application of a 'DLamCasesE' to some argument, where each 'DClause' in +-- the 'DLamCasesE' value has exactly one 'DPat'. This pattern synonym is +-- provided for backwards compatibility with older versions of @th-desugar@ in +-- which 'DCaseE' was a data constructor of 'DExp'. This pattern synonym is +-- deprecated and will be removed in a future release of @th-desugar@. +pattern DCaseE :: DExp -> [DMatch] -> DExp +pattern DCaseE scrut matches <- (dCaseE_maybe -> Just (scrut, matches)) + where + DCaseE scrut matches = DAppE (dLamCaseE matches) scrut +{-# DEPRECATED DCaseE "Use `dCaseE` or `DLamCasesE` instead." #-} + +-- | Return @'Just' (scrut, matches)@ if the supplied 'DExp' is a 'DLamCasesE' +-- value applied to some argument, where each 'DClause' in the 'DLamCasesE' +-- value has exactly one 'DPat'. Otherwise, return 'Nothing'. +dCaseE_maybe :: DExp -> Maybe (DExp, [DMatch]) +dCaseE_maybe (DAppE (DLamCasesE clauses) scrut) = do + matches <- traverse dMatch_maybe clauses + Just (scrut, matches) +dCaseE_maybe _ = Nothing + +-- | Construct a 'DExp' value that is equivalent to writing a @case@ expression. +-- Under the hood, this uses @\\cases@ ('DLamCasesE'). For instance, given this +-- code: +-- +-- @ +-- case scrut of +-- pat_1 -> rhs_1 +-- ... +-- pat_n -> rhs_n +-- @ +-- +-- The following @\\cases@ expression will be created under the hood: +-- +-- @ +-- (\\cases +-- pat_1 -> rhs_1 +-- ... +-- pat_n -> rhs_n) scrut +-- @ +dCaseE :: DExp -> [DMatch] -> DExp +dCaseE scrut matches = DAppE (dLamCaseE matches) scrut + +-- | Construct a 'DExp' value that is equivalent to writing a lambda expression. +-- Under the hood, this uses @\\cases@ ('DLamCasesE'). For instance, given this +-- code: +-- +-- @ +-- \\var_1 ... var_n -> rhs +-- @ +-- +-- The following @\\cases@ expression will be created under the hood: +-- +-- @ +-- \\cases var_1 ... var_n -> rhs +-- @ +dLamE :: [DPat] -> DExp -> DExp +dLamE pats rhs = DLamCasesE [DClause pats rhs] + +-- | Construct a 'DExp' value that is equivalent to writing a @\\case@ +-- expression. Under the hood, this uses @\\cases@ ('DLamCasesE'). For instance, +-- given this code: +-- +-- @ +-- \\case +-- pat_1 -> rhs_1 +-- ... +-- pat_n -> rhs_n +-- @ +-- +-- The following @\\cases@ expression will be created under the hood: +-- +-- @ +-- \\cases +-- pat_1 -> rhs_1 +-- ... +-- pat_n -> rhs_n +-- @ +dLamCaseE :: [DMatch] -> DExp +dLamCaseE = DLamCasesE . map dMatchToDClause -- | Corresponds to TH's @Pat@ type. data DPat = DLitP Lit @@ -49,19 +171,7 @@ data DPat = DLitP Lit | DBangP DPat | DSigP DPat DType | DWildP - -- | Note that @th-desugar@ only has partial support for desugaring - -- embedded type patterns. In particular, @th-desugar@ supports - -- desugaring embedded type patterns in function clauses, but not - -- in lambda expressions, @\\case@ expressions, or @\\cases@ - -- expressions. See the \"Known limitations\" section of the - -- @th-desugar@ @README@ for more details. | DTypeP DType - -- | Note that @th-desugar@ only has partial support for desugaring - -- invisible type patterns. In particular, @th-desugar@ supports - -- desugaring invisible type patterns in function clauses, but not - -- in lambda expressions or @\\cases@ expressions. See the \"Known - -- limitations\" section of the @th-desugar@ @README@ for more - -- details. | DInvisP DType deriving (Eq, Show, Data, Generic, Lift) @@ -115,6 +225,18 @@ type DTyVarBndrUnit = DTyVarBndr () type DTyVarBndrVis = DTyVarBndr BndrVis -- | Corresponds to TH's @Match@ type. +-- +-- Note that while @Match@ appears in the TH AST, 'DMatch' does not appear +-- directly in the @th-desugar@ AST. This is because TH's 'Match' is used in +-- lambda (@LamE@) and @case@ (@CaseE@) expressions, but @th-desugar@ does not +-- have counterparts to @LamE@ and @CaseE@ in the 'DExp' data type. Instead, +-- 'DExp' only has a @\\cases@ ('DLamCasesE') construct, which uses 'DClause' +-- instead of 'DMatch'. +-- +-- As such, 'DMatch' only plays a \"vestigial\" role in @th-desugar@ for +-- constructing 'DLamCasesE' values that look like lambda or @case@ expressions. +-- For example, 'DMatch' appears in the type signatures for 'dLamE' and +-- 'dCaseE', which convert the supplied 'DMatch'es to 'DClause's under the hood. data DMatch = DMatch DPat DExp deriving (Eq, Show, Data, Generic, Lift) @@ -122,6 +244,19 @@ data DMatch = DMatch DPat DExp data DClause = DClause [DPat] DExp deriving (Eq, Show, Data, Generic, Lift) +-- | Convert a 'DMatch' to a 'DClause', where the 'DClause' contains a single +-- pattern taken from the 'DMatch'. +dMatchToDClause :: DMatch -> DClause +dMatchToDClause (DMatch pat rhs) = DClause [pat] rhs + +-- | Return @'Just' match@ if the supplied 'DClause' has exactly one 'DPat', +-- where @match@ matches on that 'DPat'. Otherwise, return 'Nothing'. +dMatch_maybe :: DClause -> Maybe DMatch +dMatch_maybe (DClause pats rhs) = + case pats of + [pat] -> Just (DMatch pat rhs) + _ -> Nothing + -- | Declarations as used in a @let@ statement. data DLetDec = DFunD Name [DClause] | DValD DPat DExp diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs index 9527438..e650eb6 100644 --- a/Language/Haskell/TH/Desugar/Core.hs +++ b/Language/Haskell/TH/Desugar/Core.hs @@ -73,7 +73,7 @@ dsExp (InfixE Nothing op (Just rhs)) = do lhsName <- newUniqueName "lhs" op' <- dsExp op rhs' <- dsExp rhs - return $ DLamE [lhsName] (foldl DAppE op' [DVarE lhsName, rhs']) + return $ dLamE [DVarP lhsName] (foldl DAppE op' [DVarE lhsName, rhs']) dsExp (InfixE (Just lhs) op (Just rhs)) = DAppE <$> (DAppE <$> dsExp op <*> dsExp lhs) <*> dsExp rhs dsExp (UInfixE _ _ _) = @@ -82,11 +82,10 @@ dsExp (ParensE exp) = dsExp exp dsExp (LamE pats exp) = do exp' <- dsExp exp (pats', exp'') <- dsPatsOverExp pats exp' - mkDLamEFromDPats pats' exp'' + return $ dLamE pats' exp'' dsExp (LamCaseE matches) = do - x <- newUniqueName "x" - matches' <- dsMatches (LamCaseAlt LamCase) x matches - return $ DLamE [x] (DCaseE (DVarE x) matches') + matches' <- dsMatches (LamCaseAlt LamCase) matches + return $ dLamCaseE matches' dsExp (TupE exps) = dsTup tupleDataName exps dsExp (UnboxedTupE exps) = dsTup unboxedTupleDataName exps dsExp (CondE e1 e2 e3) = @@ -106,17 +105,10 @@ dsExp (LetE decs exp) = do (decs', ip_binder) <- dsLetDecs decs exp' <- dsExp exp return $ DLetE decs' $ ip_binder exp' - -- the following special case avoids creating a new "let" when it's not - -- necessary. See #34. -dsExp (CaseE (VarE scrutinee) matches) = do - matches' <- dsMatches CaseAlt scrutinee matches - return $ DCaseE (DVarE scrutinee) matches' dsExp (CaseE exp matches) = do - scrutinee <- newUniqueName "scrutinee" exp' <- dsExp exp - matches' <- dsMatches CaseAlt scrutinee matches - return $ DLetE [DValD (DVarP scrutinee) exp'] $ - DCaseE (DVarE scrutinee) matches' + matches' <- dsMatches CaseAlt matches + return $ dCaseE exp' matches' #if __GLASGOW_HASKELL__ >= 900 dsExp (DoE mb_mod stmts) = dsDoStmts mb_mod stmts #else @@ -182,7 +174,7 @@ dsExp (RecUpdE exp field_exps) = do let all_matches | length filtered_cons == length cons = matches | otherwise = matches ++ [error_match] - return $ DCaseE exp' all_matches + return $ dCaseE exp' all_matches where extract_first_arg :: DsMonad q => Type -> q Type extract_first_arg (AppT (AppT ArrowT arg) _) = return arg @@ -252,15 +244,7 @@ dsExp (ProjectionE fields) = comp acc f = DVarE '(.) `DAppE` mkGetFieldProj f `DAppE` acc #endif #if __GLASGOW_HASKELL__ >= 903 -dsExp (LamCasesE clauses) = do - clauses' <- dsClauses (LamCaseAlt LamCases) clauses - numArgs <- - case clauses' of - (DClause pats _:_) -> return $ length pats - [] -> fail "\\cases expression must have at least one alternative" - args <- replicateM numArgs (newUniqueName "x") - return $ DLamE args $ DCaseE (mkUnboxedTupleDExp (map DVarE args)) - (map dClauseToUnboxedTupleMatch clauses') +dsExp (LamCasesE clauses) = DLamCasesE <$> dsClauses (LamCaseAlt LamCases) clauses #endif #if __GLASGOW_HASKELL__ >= 907 dsExp (TypedBracketE exp) = DTypedBracketE <$> dsExp exp @@ -307,10 +291,10 @@ ds_tup tuple_data_name mb_exps = do section_exps <- mapM ds_section_exp mb_exps let section_vars = lefts section_exps tup_body = mk_tup_body section_exps - if null section_vars - then return tup_body -- If this isn't a tuple section, - -- don't create a lambda. - else mkDLamEFromDPats (map DVarP section_vars) tup_body + pure $ + if null section_vars + then tup_body -- If this isn't a tuple section, don't create a lambda. + else dLamE (map DVarP section_vars) tup_body where -- If dealing with an empty field in a tuple section (Nothing), create a -- unique name and return Left. These names will be used to construct the @@ -331,47 +315,53 @@ ds_tup tuple_data_name mb_exps = do apply_tup_body f (Left n) = f `DAppE` DVarE n apply_tup_body f (Right e) = f `DAppE` e --- | Convert a list of 'DPat' arguments and a 'DExp' body into a 'DLamE'. This --- is needed since 'DLamE' takes a list of 'Name's for its bound variables --- instead of 'DPat's, so some reorganization is needed. +-- | Construct a 'DExp' value that is equivalent to writing a lambda expression. +-- Under the hood, this uses @\\cases@ ('DLamCasesE'). +-- +-- @'mkDLamEFromDPats' pats exp@ is equivalent to writing +-- @pure ('dLamE' pats exp)@. As such, 'mkDLamEFromDPats' is deprecated in favor +-- of 'dLamE', and 'mkDLamEFromDPats' will be removed in a future @th-desugar@ +-- release. mkDLamEFromDPats :: Quasi q => [DPat] -> DExp -> q DExp -mkDLamEFromDPats pats exp - | Just names <- mapM stripDVarP_maybe pats - = return $ DLamE names exp - | otherwise - = do arg_names <- replicateM (length pats) (newUniqueName "arg") - let scrutinee = mkUnboxedTupleDExp (map DVarE arg_names) - match = DMatch (mkUnboxedTupleDPat pats) exp - return $ DLamE arg_names (DCaseE scrutinee [match]) - where - stripDVarP_maybe :: DPat -> Maybe Name - stripDVarP_maybe (DVarP n) = Just n - stripDVarP_maybe _ = Nothing +mkDLamEFromDPats pats exp = pure $ dLamE pats exp +{-# DEPRECATED mkDLamEFromDPats "Use `dLamE` or `DLamCasesE` instead." #-} #if __GLASGOW_HASKELL__ >= 902 mkGetFieldProj :: String -> DExp mkGetFieldProj field = DVarE 'getField `DAppTypeE` DLitT (StrTyLit field) #endif --- | Desugar a list of matches for a @case@ statement +-- | Desugar a list of matches for a @case@ or @\\case@ expression. dsMatches :: DsMonad q => MatchContext -- ^ The context in which the matches arise - -> Name -- ^ Name of the scrutinee, which must be a bare var - -> [Match] -- ^ Matches of the @case@ statement + -> [Match] -- ^ Matches of the @case@ or @\\case@ expression -> q [DMatch] -dsMatches mc scr = go +dsMatches _ [] = pure [] +-- Include a special case for guard-less matches to make the desugared output +-- a little nicer. See Note [Desugaring clauses compactly (when possible)]. +dsMatches mc (Match pat (NormalB exp) where_decs : rest) = do + rest' <- dsMatches mc rest + exp' <- dsExp exp + (where_decs', ip_binder) <- dsLetDecs where_decs + let exp_with_wheres = maybeDLetE where_decs' (ip_binder exp') + (pats', exp'') <- dsPatOverExp pat exp_with_wheres + pure $ DMatch pats' exp'' : rest' +dsMatches mc matches@(Match _ _ _ : _) = do + scrutinee_name <- newUniqueName "scrutinee" + let scrutinee = DVarE scrutinee_name + matches' <- foldrM (ds_match scrutinee) [] matches + pure [DMatch (DVarP scrutinee_name) (dCaseE scrutinee matches')] where - go :: DsMonad q => [Match] -> q [DMatch] - go [] = return [] - go (Match pat body where_decs : rest) = do - rest' <- go rest - let failure = maybeDCaseE mc (DVarE scr) rest' - exp' <- dsBody body where_decs failure - (pat', exp'') <- dsPatOverExp pat exp' + ds_match :: DsMonad q => DExp -> Match -> [DMatch] -> q [DMatch] + ds_match scrutinee (Match pat body where_decs) failure_matches = do + let failure_exp = maybeDCaseE mc scrutinee failure_matches + exp <- dsBody body where_decs failure_exp + (pat', exp') <- dsPatOverExp pat exp uni_pattern <- isUniversalPattern pat' -- incomplete attempt at #6 + let match = DMatch pat' exp' if uni_pattern - then return [DMatch pat' exp''] - else return (DMatch pat' exp'' : rest') + then return [match] + else return (match : failure_matches) -- | Desugar a @Body@ dsBody :: DsMonad q @@ -388,6 +378,39 @@ dsBody (GuardedB guarded_exps) decs failure = do guarded_exp' <- dsGuards guarded_exps failure return $ maybeDLetE decs' $ ip_binder guarded_exp' +-- | Construct a 'DExp' value that is equivalent to writing a @case@ expression +-- that scrutinizes multiple values at once. Under the hood, this uses +-- @\\cases@ ('DLamCasesE'). For instance, given this code: +-- +-- @ +-- case (scrut_1, ..., scrut_n) of +-- (pat_1_1, ..., pat_1_n) -> rhs_1 +-- ... +-- (pat_m_1, ..., pat_m_n) -> rhs_n +-- @ +-- +-- The following @\\cases@ expression will be created under the hood: +-- +-- @ +-- (\\cases +-- pat_1_1 ... pat_1_n -> rhs_1 +-- ... +-- pat_m_1 ... pat_m_n -> rhs_n) scrut_1 ... scrut_n +-- @ +-- +-- In other words, this creates a 'DLamCasesE' value and then applies it to +-- argument values. +-- +-- Preconditions: +-- +-- * If the list of 'DClause's is non-empty, then the number of patterns in each +-- 'DClause' must be equal to the number of 'DExp' arguments. +-- +-- * If the list of 'DClause's is empty, then there must be exactly one 'DExp' +-- argument. +dCasesE :: [DExp] -> [DClause] -> DExp +dCasesE scruts clauses = applyDExp (DLamCasesE clauses) scruts + -- | If decs is non-empty, delcare them in a let: maybeDLetE :: [DLetDec] -> DExp -> DExp maybeDLetE [] exp = exp @@ -396,7 +419,16 @@ maybeDLetE decs exp = DLetE decs exp -- | If matches is non-empty, make a case statement; otherwise make an error statement maybeDCaseE :: MatchContext -> DExp -> [DMatch] -> DExp maybeDCaseE mc _ [] = mkErrorMatchExpr mc -maybeDCaseE _ scrut matches = DCaseE scrut matches +maybeDCaseE _ scrut matches = dCaseE scrut matches + +-- | If the list of clauses is non-empty, make a @\\cases@ expression and apply +-- it using the expressions as arguments. Otherwise, make an error statement. +-- +-- Precondition: if the list of 'DClause's is non-empty, then the number of +-- patterns in each 'DClause' must be equal to the number of 'DExp' arguments. +maybeDCasesE :: MatchContext -> [DExp] -> [DClause] -> DExp +maybeDCasesE mc _ [] = mkErrorMatchExpr mc +maybeDCasesE _ scruts clauses = dCasesE scruts clauses -- | Desugar guarded expressions dsGuards :: DsMonad q @@ -422,7 +454,7 @@ dsGuardStmts (BindS pat exp : rest) success failure = do success' <- dsGuardStmts rest success failure (pat', success'') <- dsPatOverExp pat success' exp' <- dsExp exp - return $ DCaseE exp' [DMatch pat' success'', DMatch DWildP failure] + return $ dCaseE exp' [DMatch pat' success'', DMatch DWildP failure] dsGuardStmts (LetS decs : rest) success failure = do (decs', ip_binder) <- dsLetDecs decs success' <- dsGuardStmts rest success failure @@ -440,7 +472,7 @@ dsGuardStmts [NoBindS exp] success _failure dsGuardStmts (NoBindS exp : rest) success failure = do exp' <- dsExp exp success' <- dsGuardStmts rest success failure - return $ DCaseE exp' [ DMatch (DConP 'True [] []) success' + return $ dCaseE exp' [ DMatch (DConP 'True [] []) success' , DMatch (DConP 'False [] []) failure ] dsGuardStmts (ParS _ : _) _ _ = impossible "Parallel comprehension in a pattern guard." #if __GLASGOW_HASKELL__ >= 807 @@ -489,7 +521,7 @@ dsComp (NoBindS exp : rest) = do dsComp (ParS stmtss : rest) = do (pat, exp) <- dsParComp stmtss rest' <- dsComp rest - DAppE (DAppE (DVarE '(>>=)) exp) <$> mkDLamEFromDPats [pat] rest' + return $ DAppE (DAppE (DVarE '(>>=)) exp) (dLamE [pat] rest') #if __GLASGOW_HASKELL__ >= 807 dsComp (RecS {} : _) = fail "th-desugar currently does not support RecursiveDo" #endif @@ -506,15 +538,14 @@ dsBindS :: forall q. DsMonad q dsBindS mb_mod bind_arg_exp success_pat success_exp ctxt = do bind_arg_exp' <- dsExp bind_arg_exp (success_pat', success_exp') <- dsPatOverExp success_pat success_exp - is_univ_pat <- isUniversalPattern success_pat' + is_univ_pat <- isUniversalPattern success_pat' -- incomplete attempt at #6 let bind_into = DAppE (DAppE (DVarE bind_name) bind_arg_exp') if is_univ_pat - then bind_into <$> mkDLamEFromDPats [success_pat'] success_exp' - else do arg_name <- newUniqueName "arg" - fail_name <- mk_fail_name - return $ bind_into $ DLamE [arg_name] $ DCaseE (DVarE arg_name) - [ DMatch success_pat' success_exp' - , DMatch DWildP $ + then return $ bind_into $ dLamE [success_pat'] success_exp' + else do fail_name <- mk_fail_name + return $ bind_into $ DLamCasesE + [ DClause [success_pat'] success_exp' + , DClause [DWildP] $ DVarE fail_name `DAppE` DLitE (StringL $ "Pattern match failure in " ++ ctxt) ] @@ -1109,8 +1140,9 @@ dsClauses :: DsMonad q -> [Clause] -- ^ Clauses to desugar -> q [DClause] dsClauses _ [] = return [] +-- Include a special case for guard-less clauses to make the desugared output +-- a little nicer. See Note [Desugaring clauses compactly (when possible)]. dsClauses mc (Clause pats (NormalB exp) where_decs : rest) = do - -- this case is necessary to maintain the roundtrip property. rest' <- dsClauses mc rest exp' <- dsExp exp (where_decs', ip_binder) <- dsLetDecs where_decs @@ -1119,21 +1151,21 @@ dsClauses mc (Clause pats (NormalB exp) where_decs : rest) = do return $ DClause pats' exp'' : rest' dsClauses mc clauses@(Clause outer_pats _ _ : _) = do arg_names <- replicateM (length outer_pats) (newUniqueName "arg") - let scrutinee = mkUnboxedTupleDExp (map DVarE arg_names) - clause <- DClause (map DVarP arg_names) <$> - (DCaseE scrutinee <$> foldrM (clause_to_dmatch scrutinee) [] clauses) - return [clause] + let scrutinees = map DVarE arg_names + clauses' <- foldrM (ds_clause scrutinees) [] clauses + pure [DClause (map DVarP arg_names) (dCasesE scrutinees clauses')] where - clause_to_dmatch :: DsMonad q => DExp -> Clause -> [DMatch] -> q [DMatch] - clause_to_dmatch scrutinee (Clause pats body where_decs) failure_matches = do - let failure_exp = maybeDCaseE mc scrutinee failure_matches + ds_clause :: DsMonad q => [DExp] -> Clause -> [DClause] -> q [DClause] + ds_clause scrutinees (Clause pats body where_decs) failure_clauses = do + let failure_exp = maybeDCasesE mc scrutinees failure_clauses exp <- dsBody body where_decs failure_exp (pats', exp') <- dsPatsOverExp pats exp + -- incomplete attempt at #6 uni_pats <- fmap getAll $ concatMapM (fmap All . isUniversalPattern) pats' - let match = DMatch (mkUnboxedTupleDPat pats') exp' + let clause = DClause pats' exp' if uni_pats - then return [match] - else return (match : failure_matches) + then return [clause] + else return (clause : failure_clauses) -- | The context of a pattern match. This is used to produce -- @Non-exhaustive patterns in...@ messages that are tailored to specific @@ -1180,6 +1212,94 @@ mkErrorMatchExpr mc = pp_lam_case_variant LamCase = "\\case" pp_lam_case_variant LamCases = "\\cases" +{- +Note [Desugaring clauses compactly (when possible)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In the general case, th-desugar's approach to desugaring clauses with guards +requires binding an extra variable. For example, consider this code: + + \case + A x | x == "hello" -> x + B y -> y + _ -> "" + +As part of desugaring, th-desugar will get rid of the guards by rewriting the +code to something that looks closer to this: + + \scrutinee -> + case scrutinee of + A x -> + if x == "hello" + then x + else case scrutinee of + B y -> y + _ -> "" + B y -> y + _ -> "" + +(The fully desugared output would then translate the lambda and `case` +expressions to `\cases` expressions, but let's put that aside for now. We'll +come back to this in a bit.) + +Note the `scrutinee` argument, which is now explicitly named. Binding the +argument to a name is important because we need to further match on it when the +`x == "hello"` guard fails to match. + +This approach gets the job done, but it does add a some amount of extra +clutter. We take steps to avoid this clutter where possible. Consider this +simpler example: + + \case + A x -> x + B y -> y + _ -> "" + +If we were to desugar this example using the same approach as above, we'd end +up with something like this: + + \scrutinee -> + case scrutinee of + A x -> x + B y -> y + _ -> "" + +Recall that th-desugar will desugar lambda and `case` expressions to `\cases` +exprressions. As such, the fully desugared output would be: + + \cases + scrutinee -> + (\cases + A x -> x + B y -> y + _ -> "") scrutinee + +This would technically work, but we would lose something along the way. By +using this approach, we would transform something with a single `\case` +expression to something with multiple `\cases` expressions. Moreover, the +original expression never needed to give a name to the `scrutinee` variable, so +it would be strange for the desugared output to require this extra clutter. + +Luckily, we can avoid the clutter by observing that the `scrutinee` variable +can be eta-contracted away. More generally, if a set of clauses does not use +any guards, then we don't bother explicitly binding a variable like +`scrutinee`, as we never need to use it outside of the initial matching. This +means that we can desugar the simpler example above to: + + \cases + (A x) -> x + (B y) -> y + _ -> "" + +Ahh. Much nicer. + +Of course, the flip side is that we /do/ need the extra `scrutinee` clutter +when desugaring clauses involving guards. Personally, I'm not too bothered by +this, as th-desugar's approach to desugaring guards already has various +limitations (see the "Known limitations" section of the th-desugar README). As +such, I'm not inclined to invest more effort into fixing this unless someone +explicitly asks for it. +-} + -- | Desugar a type dsType :: DsMonad q => Type -> q DType #if __GLASGOW_HASKELL__ >= 900 diff --git a/Language/Haskell/TH/Desugar/Match.hs b/Language/Haskell/TH/Desugar/Match.hs index 45b6f44..b098e67 100644 --- a/Language/Haskell/TH/Desugar/Match.hs +++ b/Language/Haskell/TH/Desugar/Match.hs @@ -40,18 +40,17 @@ import Language.Haskell.TH.Desugar.Reify -- a 'DLitPa', or a 'DWildPa'. scExp :: DsMonad q => DExp -> q DExp scExp (DAppE e1 e2) = DAppE <$> scExp e1 <*> scExp e2 -scExp (DLamE names exp) = DLamE names <$> scExp exp -scExp (DCaseE scrut matches) - | DVarE name <- scrut - = simplCaseExp [name] clauses - | otherwise - = do scrut_name <- newUniqueName "scrut" - case_exp <- simplCaseExp [scrut_name] clauses - return $ DLetE [DValD (DVarP scrut_name) scrut] case_exp - where - clauses = map match_to_clause matches - match_to_clause (DMatch pat exp) = DClause [pat] exp - +scExp (DLamCasesE clauses) = do + -- Per the Haddocks for DLamCasesE, an empty list of clauses indicates that + -- the overall `\cases` expression takes one argument. Otherwise, we look at + -- the first clause to see how many arguments the expression takes, as each + -- clause is required to have the same number of patterns. + let num_args = + case clauses of + [] -> 1 + DClause pats _ : _ -> length pats + clause' <- scClauses num_args clauses + pure $ DLamCasesE [clause'] scExp (DLetE decs body) = DLetE <$> mapM scLetDec decs <*> scExp body scExp (DSigE exp ty) = DSigE <$> scExp exp <*> pure ty scExp (DAppTypeE exp ty) = DAppTypeE <$> scExp exp <*> pure ty @@ -65,18 +64,35 @@ scExp e@(DTypeE {}) = return e -- | Like 'scExp', but for a 'DLetDec'. scLetDec :: DsMonad q => DLetDec -> q DLetDec -scLetDec (DFunD name clauses@(DClause pats1 _ : _)) = do - arg_names <- mapM (const (newUniqueName "_arg")) pats1 - clauses' <- mapM sc_clause_rhs clauses - case_exp <- simplCaseExp arg_names clauses' - return $ DFunD name [DClause (map DVarP arg_names) case_exp] - where - sc_clause_rhs (DClause pats exp) = DClause pats <$> scExp exp +scLetDec (DFunD name clauses) = do + -- `DFunD`s are expected to have a non-empty list of clauses where each clause + -- has a number of patterns equal to the number of arguments. + let num_args = + case clauses of + [] -> error $ "The `" ++ nameBase name ++ + "` function has no clauses -- should never happen" + DClause pats _ : _ -> length pats + clause' <- scClauses num_args clauses + pure $ DFunD name [clause'] scLetDec (DValD pat exp) = DValD pat <$> scExp exp scLetDec (DPragmaD prag) = DPragmaD <$> scLetPragma prag scLetDec dec@(DSigD {}) = return dec scLetDec dec@(DInfixD {}) = return dec -scLetDec dec@(DFunD _ []) = return dec + +-- | Convert a list of 'DClause's into a single 'DClause', where the right-hand +-- side of the output 'DClause' matches on all of the patterns of the input +-- 'DClause's without using nested pattern matching. +scClauses :: + DsMonad q + => Int -- ^ The number of arguments in each 'DClause'. + -> [DClause] -> q DClause +scClauses num_args clauses = do + arg_names <- replicateM num_args (newUniqueName "_arg") + clauses' <- mapM sc_clause_rhs clauses + case_exp <- simplCaseExp arg_names clauses' + pure $ DClause (map DVarP arg_names) case_exp + where + sc_clause_rhs (DClause pats exp) = DClause pats <$> scExp exp scLetPragma :: DsMonad q => DPragma -> q DPragma scLetPragma = topEverywhereM scExp -- Only topEverywhereM because scExp already recurses on its own @@ -227,7 +243,7 @@ mkSelectorDecs pat name -> q DExp mk_projection tup_name i = do var_name <- newUniqueName "proj" - return $ DCaseE (DVarE tup_name) [DMatch (DConP (tupleDataName tuple_size) [] (mk_tuple_pats var_name i)) + return $ dCaseE (DVarE tup_name) [DMatch (DConP (tupleDataName tuple_size) [] (mk_tuple_pats var_name i)) (DVarE var_name)] mk_tuple_pats :: Name -- of the projected element @@ -332,7 +348,7 @@ mkDataConCase var case_alts = do all_ctors <- get_all_ctors (alt_con $ NE.head case_alts) return $ \fail -> let matches = fmap (mk_alt fail) case_alt_list in - DCaseE (DVarE var) (matches ++ mk_default all_ctors fail) + dCaseE (DVarE var) (matches ++ mk_default all_ctors fail) where case_alt_list = NE.toList case_alts @@ -361,7 +377,7 @@ mkDataConCase var case_alts = do matchEmpty :: DsMonad q => Name -> q [MatchResult] matchEmpty var = return [mk_seq] where - mk_seq fail = DCaseE (DVarE var) [DMatch DWildP fail] + mk_seq fail = dCaseE (DVarE var) [DMatch DWildP fail] matchLiterals :: DsMonad q => NonEmpty Name -> NonEmpty (NonEmpty EquationInfo) -> q MatchResult matchLiterals (var:|vars) sub_groups @@ -383,7 +399,7 @@ mkCoPrimCaseMatchResult :: Name -- Scrutinee mkCoPrimCaseMatchResult var match_alts = mk_case where mk_case fail = let alts = NE.toList $ fmap (mk_alt fail) match_alts in - DCaseE (DVarE var) (alts ++ [DMatch DWildP fail]) + dCaseE (DVarE var) (alts ++ [DMatch DWildP fail]) mk_alt fail (lit, body_fn) = DMatch (DLitP lit) (body_fn fail) diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs index d368eb5..ba2d5e0 100644 --- a/Language/Haskell/TH/Desugar/Sweeten.hs +++ b/Language/Haskell/TH/Desugar/Sweeten.hs @@ -51,8 +51,6 @@ expToTH (DVarE n) = VarE n expToTH (DConE n) = ConE n expToTH (DLitE l) = LitE l expToTH (DAppE e1 e2) = AppE (expToTH e1) (expToTH e2) -expToTH (DLamE names exp) = LamE (map VarP names) (expToTH exp) -expToTH (DCaseE exp matches) = CaseE (expToTH exp) (map matchToTH matches) expToTH (DLetE decs exp) = LetE (map letDecToTH decs) (expToTH exp) expToTH (DSigE exp ty) = SigE (expToTH exp) (typeToTH ty) expToTH (DStaticE exp) = StaticE (expToTH exp) @@ -63,6 +61,64 @@ expToTH (DAppTypeE exp ty) = AppTypeE (expToTH exp) (typeToTH ty) -- type applications, we will simply drop the applied type. expToTH (DAppTypeE exp _) = expToTH exp #endif +expToTH (DLamCasesE clauses) + -- In the source language, `\cases` expressions must have at least one clause. + -- As such, we adopt the convention that a DLamCasesE value with no clauses + -- shall sweeten to a `\case{}` expression. Unlike `\cases`, it is legal for + -- `\case` to have no clauses, and `\case{}` is assumed to have a single + -- argument. + | null clauses + = LamCaseE [] +#if __GLASGOW_HASKELL__ >= 904 + -- If building with GHC 9.4 or later, sweetening a DLamCasesE value is as + -- simple as using LamCasesE... + | otherwise + = LamCasesE (map clauseToTH clauses) +#else + -- ...but if we are building with a pre-9.4 version of GHC, we do not have + -- access to LamCasesE, making our life harder. We want to have at least + -- /some/ support for sweetening DLamCasesE values, since we desugar simpler + -- language constructs like lambda, `case`, and `\case` expressions to + -- DLamCasesE, and we'd like to be able to sweeten them back. + -- + -- Therefore, we add special treatment for DLamCasesE values that look simpler + -- language constructs and sweeten these back to LamE, LamCaseE, etc. If we + -- encounter anything more complicated, we give up and raise an error. + + -- Special case: if a DLamCasesE value has exactly one clause, we can sweeten + -- the DLamCasesE value as though it were a lambda expression (LamE). + | [DClause pats exp] <- clauses + = LamE (map patToTH pats) (expToTH exp) + -- Special case: if a DLamCasesE value's clauses each have exactly one + -- pattern, we can sweeten the DLamCasesE value as though it were a `\case` + -- expression (LamCaseE). + | Just matches <- traverse dMatch_maybe clauses + = LamCaseE (map matchToTH matches) + -- NB: You might wonder why there is not another special case that returns + -- CaseE for things that look like `case` expressions. This is because the + -- special case for LamCaseE above already suffices. Note that we desugar + -- `case` expressions to code that looks like this: + -- + -- (\cases + -- pat_1 -> rhs_1 + -- ... + -- pat_n -> rhs_n) scrut + -- + -- That is, a value that looks like `DAppE (DLamCasesE ...) scrut`. Each + -- clause in the DLamCasesE value has exactly one pattern, however. Therefore, + -- because of the special treatment for LamCaseE above, this code would + -- sweeten to `AppE (LamCaseE ...) scrut`. + + -- If we lack a special case for the DLamCasesE value, then we raise an error. + | otherwise + = error $ unlines + [ "Non-trivial \\cases expressions supported only in GHC 9.4+." + , "Here, \"non-trivial\" means that the \\cases expression cannot easily" + , "be rewritten to a lambda, case, or \\case expression without" + , "significantly rewriting the expression. Either rewrite the expression" + , "yourself or upgrade to a later version of GHC." + ] +#endif #if __GLASGOW_HASKELL__ >= 907 expToTH (DTypedBracketE exp) = TypedBracketE (expToTH exp) expToTH (DTypedSpliceE exp) = TypedSpliceE (expToTH exp) diff --git a/README.md b/README.md index d8fadca..ca052ca 100644 --- a/README.md +++ b/README.md @@ -145,96 +145,6 @@ way that linear types interact with Template Haskell, which sometimes make it impossible to tell whether a reified function type is linear or not. See, for instance, [GHC#18378](https://gitlab.haskell.org/ghc/ghc/-/issues/18378). -## Limited support for embedded types in patterns - -In GHC 9.10 or later, the `RequiredTypeArguments` language extension allows one -to write definitions with embedded types in patterns, e.g., - -```hs -idv :: forall a -> a -> a -idv (type a) = id @a -``` - -`th-desugar` supports writing patterns like `(type a)` via the `DTypeP` data -constructor of `DPat`. Be warned, however, that `th-desugar` only supports -desugaring `DTypeP` in the clauses of function declarations, such as the -declaration of `idv` above. As a result, `th-desugar` does not support -desugaring `DTypeP` in any other position, including: - -* Lambda expressions. For example, the following is not supported: - - ```hs - idv2 :: forall a -> a -> a - idv2 = \(type a) -> id @a - ``` -* `\case` expressions. For example, the following is not supported: - - ```hs - idv3 :: forall a -> a -> a - idv3 = \case - (type a) -> id @a - ``` -* `\cases` expressions. For example, the following is not supported: - - ```hs - idv4 :: forall a -> a -> a - idv4 = \cases - (type a) x -> x :: a - ``` - -Note that all of the example above use an explicit `type` keyword, but the same -considerations apply for embedded type patterns that do not use the `type` -keyword. That is, `th-desugar` supports desugaring the following: - -```hs -idv' :: forall a -> a -> a -idv' a = id @a -``` - -But `th-desugar` does not support desugaring any of the following: - -```hs -idv2' :: forall a -> a -> a -idv2' = \a -> id @a - -idv3' :: forall a -> a -> a -idv3' = \case - a -> id @a - -idv4' :: forall a -> a -> a -idv4' = \cases - a x -> x :: a -``` - -As a workaround, one can convert uses of lambdas and `LambdaCase` to function -declarations, which are fully supported. See also [this `th-desugar` -issue](https://github.com/goldfirere/th-desugar/issues/210), which proposes a -different approach to desugaring that would allow all of the examples above to -be accepted. - -## Limited support for invisible type patterns - -In GHC 9.10 or later, the `TypeAbstractions` language extension allows one to -write definitions with invisible type patterns, e.g., - -```hs -f :: a -> a -f @a = id @a -``` - -`th-desugar` supports writing patterns like `@a` via the `DInvisP` data -constructor of `DPat`. Be warned, however, that `th-desugar` only supports -desugaring `DInvisP` in the clauses of function declarations, such as the -declaration of `f` above. As a result, `th-desugar` does not support desugaring -`DInvisP` in any other position, such as lambda expressions or `\cases` -expressions. - -Ultimately, this limitation has the same underlying cause as `th-desugar`'s -limitations surrounding embedded types in patterns (see the "Limited support -for embedded types in patterns" section above). As a result, the same -workaround applies: convert uses of lambdas and `LambdaCase` to function -declarations, which are fully supported. - ## Limitations of support for desugaring guards `th-desugar` supports guards in the sense that it will desugar guards to diff --git a/Test/Run.hs b/Test/Run.hs index b9a52e7..194fe42 100644 --- a/Test/Run.hs +++ b/Test/Run.hs @@ -193,6 +193,14 @@ tests = test [ "sections" ~: $test1_sections @=? $(dsSplice test1_sections) , "embedded_types_keyword" ~: $test59_embedded_types_keyword @=? $(dsSplice test59_embedded_types_keyword) , "embedded_types_no_keyword" ~: $test60_embedded_types_no_keyword @=? $(dsSplice test60_embedded_types_no_keyword) , "invis_type_pat" ~: $test61_invis_type_pat @=? $(dsSplice test61_invis_type_pat) + , "embedded_types_lambda_keyword" ~: $test62_embedded_types_lambda_keyword @=? $(dsSplice test62_embedded_types_lambda_keyword) + , "embedded_types_case_keyword" ~: $test63_embedded_types_case_keyword @=? $(dsSplice test63_embedded_types_case_keyword) + , "embedded_types_cases_keyword" ~: $test64_embedded_types_cases_keyword @=? $(dsSplice test64_embedded_types_cases_keyword) + , "embedded_types_lambda_no_keyword" ~: $test65_embedded_types_lambda_no_keyword @=? $(dsSplice test65_embedded_types_lambda_no_keyword) + , "embedded_types_case_no_keyword" ~: $test66_embedded_types_case_no_keyword @=? $(dsSplice test66_embedded_types_case_no_keyword) + , "embedded_types_cases_no_keyword" ~: $test67_embedded_types_cases_no_keyword @=? $(dsSplice test67_embedded_types_cases_no_keyword) + , "invis_type_pat_lambda" ~: $test68_invis_type_pat_lambda @=? $(dsSplice test68_invis_type_pat_lambda) + , "invis_type_pat_cases" ~: $test69_invis_type_pat_cases @=? $(dsSplice test69_invis_type_pat_cases) #endif ] diff --git a/Test/Splices.hs b/Test/Splices.hs index 81f3adf..3fa25f3 100644 --- a/Test/Splices.hs +++ b/Test/Splices.hs @@ -413,6 +413,55 @@ test61_invis_type_pat = f @a = id @a in f @Bool True |] + +test62_embedded_types_lambda_keyword = + [| let idv :: forall a -> a -> a + idv = \(type a) (x :: a) -> x :: a + + in idv (type Bool) True |] + +test63_embedded_types_case_keyword = + [| let idv :: forall a -> a -> a + idv = \case + (type a) -> id @a + + in idv (type Bool) True |] + +test64_embedded_types_cases_keyword = + [| let idv :: forall a -> a -> a + idv = \cases + (type a) (x :: a) -> x :: a + + in idv (type Bool) True |] + +test65_embedded_types_lambda_no_keyword = + [| let idv :: forall a -> a -> a + idv = \a (x :: a) -> x :: a + + in idv Bool True |] + +test66_embedded_types_case_no_keyword = + [| let idv :: forall a -> a -> a + idv = \case + a -> id @a + + in idv Bool True |] + +test67_embedded_types_cases_no_keyword = + [| let idv :: forall a -> a -> a + idv = \cases + a (x :: a) -> x :: a + + in idv Bool True |] + +aux :: (forall a. a -> a) -> (forall a. a -> a) +aux f x = f x + +test68_invis_type_pat_lambda = + [| aux (\ @a (x :: a) -> x :: a) @Bool True |] + +test69_invis_type_pat_cases = + [| aux (\cases @a (x :: a) -> x :: a) @Bool True |] #endif type family TFExpand x @@ -884,5 +933,13 @@ test_exprs = [ test1_sections , test59_embedded_types_keyword , test60_embedded_types_no_keyword , test61_invis_type_pat + , test62_embedded_types_lambda_keyword + , test63_embedded_types_case_keyword + , test64_embedded_types_cases_keyword + , test65_embedded_types_lambda_no_keyword + , test66_embedded_types_case_no_keyword + , test67_embedded_types_cases_no_keyword + , test68_invis_type_pat_lambda + , test69_invis_type_pat_cases #endif ] diff --git a/docs/LambdaCaseMigration.md b/docs/LambdaCaseMigration.md new file mode 100644 index 0000000..4d4eeef --- /dev/null +++ b/docs/LambdaCaseMigration.md @@ -0,0 +1,256 @@ +# Migrating from `DLamE`/`DCaseE` to `DLamCasesE` + +In `th-desugar-1.18`, the `DLamE` data constructor (for lambda expressions) and +`DCaseE` data constructor (for `case` expressions) are deprecated in favor of +the new `DLamCasesE` data constructor (for `\cases` expressions). This document +describes how one should migrate their code in anticipation of `DLamE` and +`DCaseE` being removed in a future `th-desugar`. + +## What changed + +The `DLamE` and `DCaseE` data constructors have been removed in favor of +`DLamCasesE`: + +```diff + data DExp + = ... +- | DLamE [Name] DExp +- | DCaseE DExp [DMatch] ++ | DLamCasesE [DClause] + | ... +``` + +That is, [`\cases` +expressions](https://downloads.haskell.org/ghc/9.10.1/docs/users_guide/exts/lambda_case.html) +(enabled by the `LambdaCase` language extension when using GHC 9.4 or later) +not only serves the role of `\cases`, but also the role of lambda expressions, +`case` expressions, and `\case` expressions, and `th-desugar` will desugar all +of these expressions to `DLamCasesE`. Note that `DLamCasesE` has the convention +that an empty list of `DClause`s implies a single argument, so `\case{}` will +desugar to `DLamCasesE []`. + +This is a pretty large breaking change (even by `th-desugar` standards, so we +have made some effort to keep existing code involving `DLamE` and `DCaseE` +working until users have a chance to migrate. As such, `DLamE` and `DCaseE` +have been converted to pattern synonyms, although using these pattern synonyms +will incur deprecation warnings. + +Some related changes that were brought on as a result of all this: + +* The `mkDLamEFromDPats` function (which plays a similar role to `DLamE`) has + also been deprecated. +* The `dsMatches` function no longer includes a `Name` argument for the variable + being scrutinized, as this variable is not guaranteed to exist. + +## Why did this change? + +_(If you don't care about the motivations behind this change, feel free to skip +directly to the "Migrating your code" section below.)_ + +In previous versions of the library, `th-desugar` would desugar lambda +expressions, `\case` expressions, and `\cases` expressions to code that binds +arguments with a lambda and scrutinizes them using a `case` expression +involving a tuple. That is, given this code: + +```hs +\(Identity x) (Identity y) -> x + y +``` + +`th-desugar` would desugar this to: + +```hs +\arg1 arg2 -> + case (arg1, arg2) of + (Identity x, Identity y) -> x + y +``` + +This worked well enough, although it does require packing arguments into an +intermediate tuple. This was somewhat annoying (and potentially wasteful if GHC +did not optimize away the intermediate tuple), but not annoying enough to +invest in an alternative... + +...that is, until recently. GHC 9.10 introduced two new language constructs: + +* Embedded type patterns (e.g., `\(type a) (x :: a) -> x :: a`), enabled with + the use of the + [`RequiredTypeArguments`](https://downloads.haskell.org/ghc/9.10.1/docs/users_guide/exts/required_type_arguments.html) + extension. +* Invisible type patterns (e.g., `\ @a (x :: a) -> x :: a`), enabled with the + use of the + [`TypeAbstractions`](https://downloads.haskell.org/ghc/9.10.1/docs/users_guide/exts/type_abstractions.html) + extension with GHC 9.10 or later. + +The important aspects of these language extensions are that they allow binding +types in patterns, and moreover, these types can only be used in certain +places. For example, GHC will reject code like `(type a, x)`. This is at odds +with the intermediate-tuple approach that `th-desugar` used previously, since +this means that given code like this: + +```hs +\(type a) (x :: a) -> x :: a +``` + +A naïve attempt at desugaring the code would result in this: + +```hs +\arg1 arg2 -> + case (arg1, arg2) of + (type a, x :: a) -> x :: a +``` + +But as mentioned above, GHC will reject this code! This proved quite +troublesome, and it would be non-trivial to adapt the intermediate-tuple +approach to allow these sorts of patterns (see the discussion on +[issue #204](https://github.com/goldfirere/th-desugar/issues/204) for more details). + +Thankfully, there is a much more elegant solution that `th-desugar` can adopt: +desugar lambda, `case`, and `\case` expressions to `\cases`. This is because +embedded type patterns and invisible type patterns _can_ appear in the clauses +of a `\cases` expression, which allows `th-desugar` to support them without +needing special treatment. For example, given this code: + +```hs +\(type a) (x :: a) -> x :: a +``` + +`th-desugar` will now desugar it to: + +```hs +\cases (type a) (x :: a) -> x :: a +``` + +GHC will accept this code without issue. What's more, there is no longer a need +for any intermediate tuples, as `\cases` can scrutinize multiple arguments +without ever needing tuples. + +An secondary benefit of this change is that the `DExp` data type is more +minimal. Rather than having separate constructs for binding names (`DLamE`) and +scrutinizing expressions (`DCaseE`), there is now a single construct +(`DLamCasesE`) that does both. + +## Migrating your code + +All uses of `DLamE` and `DCaseE` (which are now deprecated) should be migrated +over to `DLamCasesE` in anticipation of `DLamE`/`DCaseE` being removed in a +future GHC release. To make this process easier, `th-desugar` offers some +useful combinators for constructing `DLamCasesE` values that look like lambda +expressions, `case` expressions, or `\case` expressions: + +* `dLamE :: [DPat] -> DExp -> DExp`: a lambda expression +* `dCaseE :: DExp -> [DMatch] -> DExp`: a `case` expression +* `dCasesE :: [DExp] -> [DClause] -> DExp`: a `case` expression that scrutinizes + multiple arguments +* `dLamCaseE :: [DMatch] -> DExp`: a `\case` expression + +If you use `DLamE` or `DCaseE` in an expression position, `dLamE` and `dCaseE` +offer nearly drop-in replacements. We say _nearly_ drop-in because the type of +`dLamE` is more general: it accepts a list of `DPat`s instead of a list of +`Name`s. As such, `DLamE vars rhs` can be converted to `dLamE (map DVarP names) +rhs`. + +Note that as a result of all these changes, the `DMatch` data type is no longer +used directly in the `th-desugar` AST (only `DClause` is). Nevertheless, we +still keep `DMatch` around as it is a useful data type for the `dCaseE` and +`dLamCaseE` functions. + +In addition to the changes above, you may need to make the following changes: + +* Because the `mkDLamEFromDPats` function has been deprecated in favor of + `dLamE`, any uses of `mkDLamEFromDPats pats rhs` should be replaced with + `pure (dLamE pats rhs)`, which is an equivalent way of writing it. +* If you are using `dsMatches`, you will need to remove the `Name` argument, + which represents a variable being scrutinized. The new approach that + `th-desugar` uses to desugar `Match`es no longer requires this. + +### Support for pre-9.4 versions of GHC + +`\cases` is only available when using GHC 9.4 or later. As such, there is only +limited support for sweetening `DLamCasesE` values back to `template-haskell` +`Exp`s when using pre-9.4 versions of GHC. On these versions of GHC, +`th-desugar` recognizes the following special cases when sweetening +`DLamCasesE`: + +* `DLamCasesE []` will be sweetened to `LamCaseE []`. +* `DLamCasesE [DClause pats rhs]` will be sweented to `LamE pats' rhs'` (where + `pats'` and `rhs'` are the sweetened versions of `pats` and `rhs`, + respectively). +* `DLamCasesE clauses` will be sweetened to `LamCaseE clauses'` (where + `clauses'` is the sweetened version of `clauses`) when each clause in + `clauses` has exactly one pattern. + +If none of these cases apply, then `th-desugar` will raise an error when +sweetening the `DLamCasesE` value—at that point, your only course of action is +to rewrite the `DLamCasesE` value to something else or to upgrade GHC versions. +These special cases ensure that all lambda expressions, `case` expressions, and +`\case` expressions will successfully round-trip through a cycle of desugaring +and sweetening. That is, the only time that sweetening would error is if you +are desugaring a `\cases` expression that cannot trivially be rewritten to a +lambda, `case`, or `\case` expression. + +### Anti-patterns to watch out for + +Replacing `DLamE` and `DCaseE` expressions with `dLamE` and `dCase`, +respectively, will likely suffice to make your code work. That being said, it +may result in code that is unnecessarily verbose. For example, it was somewhat +common in previous `th-desugar` versions to write code that looks like this: + +```hs +-- \name -> case name of pat -> rhs +DLamE [name] (DCaseE (DVarE name) (DMatch pat rhs)) +``` + +A simple way to fix this code would be to instead write: + +```hs +dLamE [DVarP name] (dCaseE (DVarE name) (DMatch pat rhs)) +``` + +However, `th-desugar` would desugar this to: + +```hs +\cases name -> (\cases pat -> rhs) name +``` + +Note that there are _two_ `\cases` expressions. This often wasteful, however, +as there is usually no need to bind `name` at all! Instead, if `name` does not +appear in `pat` or `rhs`, you can rewrite the code above as: + +```hs +dLamCaseE (DMatch pat rhs) +``` + +`th-desugar` will desugar this code to: + +```hs +\cases pat -> rhs +``` + +Which is much more concise. + +A similar anti-pattern arises when binding multiple variables and scrutinizing +them as part of a tuple expression: + +```hs +-- \name1 name2 -> case (name1, name2) of (pat1, pat2) -> rhs +DLamE [name1, name2] (DCaseE (mkTupleDExp [DVarE name1, DVarE name2]) (DMatch (mkTupleDPat [DVarP pat1, DVarP pat2]) rhs)) +``` + +Once again, there is no need to explicitly bind `name1` or `name2` (assuming +that neither name appears in `pat` or `rhs`). The expression above can be more concisely +written as: + +```hs +-- \cases pat1 pat2 -> rhs +DLamCasesE [DClause [DVarP pat1, DVarP pat2] rhs] +``` + +One of the advantages of using `\cases` as a primitive construct for pattern +matching is that we can avoid many uses of intermediate tuples like what is +seen above. You might as well take advantage of this! + +### Example to follow + +If you'd like to see an example of how to migrate a large library to work with +these changes, then +[singletons#595](https://github.com/goldfirere/singletons/pull/595) may be +useful.