diff options
| author | nineonine <mail4chemik@gmail.com> | 2019-06-23 22:44:37 -0700 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-07-02 16:18:44 -0400 |
| commit | cef80c0b9edca3d21b5c762f51dfbab4c5857d8a (patch) | |
| tree | 4812abbe6695af023ed25587b0800649ba0254fe /libraries/template-haskell/Language/Haskell/TH/Syntax.hs | |
| parent | 0bed9647c5e6edbfcfed2d7dbd8d25fd8fd2b195 (diff) | |
| download | haskell-cef80c0b9edca3d21b5c762f51dfbab4c5857d8a.tar.gz | |
Fix #15843 by extending Template Haskell AST for tuples to support sections
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Syntax.hs')
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 58 |
1 files changed, 43 insertions, 15 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index dfcdfd5f17..2d79d5a28f 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -846,35 +846,38 @@ instance Lift () where instance (Lift a, Lift b) => Lift (a, b) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b) - = liftM TupE $ sequence [lift a, lift b] + = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b] instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b, c) - = liftM TupE $ sequence [lift a, lift b, lift c] + = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c] instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b, c, d) - = liftM TupE $ sequence [lift a, lift b, lift c, lift d] + = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d] instance (Lift a, Lift b, Lift c, Lift d, Lift e) => Lift (a, b, c, d, e) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b, c, d, e) - = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e] + = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b + , lift c, lift d, lift e ] instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) => Lift (a, b, c, d, e, f) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b, c, d, e, f) - = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f] + = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c + , lift d, lift e, lift f ] instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) => Lift (a, b, c, d, e, f, g) where liftTyped x = unsafeTExpCoerce (lift x) lift (a, b, c, d, e, f, g) - = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g] + = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c + , lift d, lift e, lift f, lift g ] -- | @since 2.16.0.0 instance Lift (# #) where @@ -885,48 +888,53 @@ instance Lift (# #) where instance (Lift a) => Lift (# a #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a #) - = liftM UnboxedTupE $ sequence [lift a] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a] -- | @since 2.16.0.0 instance (Lift a, Lift b) => Lift (# a, b #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b #) - = liftM UnboxedTupE $ sequence [lift a, lift b] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b] -- | @since 2.16.0.0 instance (Lift a, Lift b, Lift c) => Lift (# a, b, c #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b, c #) - = liftM UnboxedTupE $ sequence [lift a, lift b, lift c] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c] -- | @since 2.16.0.0 instance (Lift a, Lift b, Lift c, Lift d) => Lift (# a, b, c, d #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b, c, d #) - = liftM UnboxedTupE $ sequence [lift a, lift b, lift c, lift d] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b + , lift c, lift d ] -- | @since 2.16.0.0 instance (Lift a, Lift b, Lift c, Lift d, Lift e) => Lift (# a, b, c, d, e #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b, c, d, e #) - = liftM UnboxedTupE $ sequence [lift a, lift b, lift c, lift d, lift e] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b + , lift c, lift d, lift e ] -- | @since 2.16.0.0 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) => Lift (# a, b, c, d, e, f #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b, c, d, e, f #) - = liftM UnboxedTupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c + , lift d, lift e, lift f ] -- | @since 2.16.0.0 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) => Lift (# a, b, c, d, e, f, g #) where liftTyped x = unsafeTExpCoerce (lift x) lift (# a, b, c, d, e, f, g #) - = liftM UnboxedTupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g] + = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c + , lift d, lift e, lift f + , lift g ] -- | @since 2.16.0.0 instance (Lift a, Lift b) => Lift (# a | b #) where @@ -1901,8 +1909,28 @@ data Exp -- See "Language.Haskell.TH.Syntax#infix" | LamE [Pat] Exp -- ^ @{ \\ p1 p2 -> e }@ | LamCaseE [Match] -- ^ @{ \\case m1; m2 }@ - | TupE [Exp] -- ^ @{ (e1,e2) } @ - | UnboxedTupE [Exp] -- ^ @{ (\# e1,e2 \#) } @ + | TupE [Maybe Exp] -- ^ @{ (e1,e2) } @ + -- + -- The 'Maybe' is necessary for handling + -- tuple sections. + -- + -- > (1,) + -- + -- translates to + -- + -- > TupE [Just (LitE (IntegerL 1)),Nothing] + + | UnboxedTupE [Maybe Exp] -- ^ @{ (\# e1,e2 \#) } @ + -- + -- The 'Maybe' is necessary for handling + -- tuple sections. + -- + -- > (# 'c', #) + -- + -- translates to + -- + -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing] + | UnboxedSumE Exp SumAlt SumArity -- ^ @{ (\#|e|\#) }@ | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@ | MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@ |