Skip to content
Snippets Groups Projects
Commit 983ce558 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by Marge Bot
Browse files

Use TemplateHaskellQuotes in TH.Syntax to construct Names

parent 275836d2
No related branches found
No related tags found
No related merge requests found
......@@ -6,6 +6,7 @@
Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-}
{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
-----------------------------------------------------------------------------
-- |
......@@ -54,7 +55,7 @@ import Data.Ratio
import GHC.CString ( unpackCString# )
import GHC.Generics ( Generic )
import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..),
TYPE, RuntimeRep(..) )
TYPE, RuntimeRep(..), Multiplicity (..) )
import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# )
import GHC.Ptr ( Ptr, plusPtr )
import GHC.Lexeme ( startsVarSym, startsVarId )
......@@ -65,7 +66,6 @@ import Prelude hiding (Applicative(..))
import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.C.Types
import GHC.Stack
#if __GLASGOW_HASKELL__ >= 901
import GHC.Types ( Levity(..) )
......@@ -1067,8 +1067,7 @@ instance Lift (Fixed.Fixed a) where
ex <- lift x
return (ConE mkFixedName `AppE` ex)
where
mkFixedName =
mkNameG DataName "base" "Data.Fixed" "MkFixed"
mkFixedName = 'Fixed.MkFixed
instance Integral a => Lift (Ratio a) where
liftTyped x = unsafeCodeCoerce (lift x)
......@@ -1139,19 +1138,8 @@ instance Lift ByteArray where
ptr :: ForeignPtr Word8
ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))
-- We can't use a TH quote in this module because we're in the template-haskell
-- package, so we conconct this quite defensive solution to make the correct name
-- which will work if the package name or module name changes in future.
addrToByteArrayName :: Name
addrToByteArrayName = helper
where
helper :: HasCallStack => Name
helper =
case getCallStack ?callStack of
[] -> error "addrToByteArrayName: empty call stack"
(_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"
addrToByteArrayName = 'addrToByteArray
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray (I# len) addr = runST $ ST $
......@@ -1371,23 +1359,24 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
trueName, falseName :: Name
trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True"
falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
trueName = 'True
falseName = 'False
nothingName, justName :: Name
nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing"
justName = mkNameG DataName "base" "GHC.Maybe" "Just"
nothingName = 'Nothing
justName = 'Just
leftName, rightName :: Name
leftName = mkNameG DataName "base" "Data.Either" "Left"
rightName = mkNameG DataName "base" "Data.Either" "Right"
leftName = 'Left
rightName = 'Right
nonemptyName :: Name
nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"
nonemptyName = '(:|)
oneName, manyName :: Name
oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One"
manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"
oneName = 'One
manyName = 'Many
-----------------------------------------------------
--
-- Generic Lift implementations
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment