Add INLINABLE pragmas in Template Haskell
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Lib.hs
index 9c40718..909573c 100644 (file)
@@ -74,6 +74,14 @@ infixP :: PatQ -> Name -> PatQ -> PatQ
 infixP p1 n p2 = do p1' <- p1
                     p2' <- p2
                     return (InfixP p1' n p2')
+uInfixP :: PatQ -> Name -> PatQ -> PatQ
+uInfixP p1 n p2 = do p1' <- p1
+                     p2' <- p2
+                     return (UInfixP p1' n p2')
+parensP :: PatQ -> PatQ
+parensP p = do p' <- p
+               return (ParensP p')
+
 tildeP :: PatQ -> PatQ
 tildeP p = do p' <- p
               return (TildeP p')
@@ -201,6 +209,13 @@ litE c = return (LitE c)
 appE :: ExpQ -> ExpQ -> ExpQ
 appE x y = do { a <- x; b <- y; return (AppE a b)}
 
+parensE :: ExpQ -> ExpQ
+parensE x = do { x' <- x; return (ParensE x') }
+
+uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
+                     return (UInfixE x' s' y') }
+
 infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
 infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
                                   return (InfixE (Just a) s' (Just b))}
@@ -340,6 +355,15 @@ forImpD cc s str n ty
  = do ty' <- ty
       return $ ForeignD (ImportF cc s str n ty')
 
+infixLD :: Int -> Name -> DecQ
+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+
+infixRD :: Int -> Name -> DecQ
+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+
+infixND :: Int -> Name -> DecQ
+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+
 pragInlD :: Name -> InlineSpecQ -> DecQ
 pragInlD n ispec 
   = do
@@ -446,8 +470,8 @@ arrowT = return ArrowT
 listT :: TypeQ
 listT = return ListT
 
-literalT :: TyLit -> TypeQ
-literalT l = return (LiteralT l)
+litT :: TyLit -> TypeQ
+litT l = return (LitT l)
 
 tupleT :: Int -> TypeQ
 tupleT i = return (TupleT i)
@@ -461,9 +485,10 @@ sigT t k
       t' <- t
       return $ SigT t' k
 
-isStrict, notStrict :: Q Strict
+isStrict, notStrict, unpacked :: Q Strict
 isStrict = return $ IsStrict
 notStrict = return $ NotStrict
+unpacked = return Unpacked
 
 strictType :: Q Strict -> TypeQ -> StrictTypeQ
 strictType = liftM2 (,)
@@ -474,10 +499,14 @@ varStrictType v st = do (s, t) <- st
 
 -- * Type Literals
 
-numberTL :: Integer -> TyLitQ
-numberTL n = if n >= 0 then return (NumberTL n)
+numTyLit :: Integer -> TyLitQ
+numTyLit n = if n >= 0 then return (NumTyLit n)
                        else fail ("Negative type-level number: " ++ show n)
 
+strTyLit :: String -> TyLitQ
+strTyLit s = return (StrTyLit s)
+
+
 
 -------------------------------------------------------------------------------
 -- *   Kind
@@ -491,9 +520,6 @@ kindedTV = KindedTV
 starK :: Kind
 starK = StarK
 
-natK :: Kind
-natK = NatK
-
 arrowK :: Kind -> Kind -> Kind
 arrowK = ArrowK
 
@@ -507,20 +533,19 @@ stdCall = StdCall
 -------------------------------------------------------------------------------
 -- *   Safety
 
-unsafe, safe, threadsafe, interruptible :: Safety
+unsafe, safe, interruptible :: Safety
 unsafe = Unsafe
 safe = Safe
-threadsafe = Threadsafe
 interruptible = Interruptible
 
 -------------------------------------------------------------------------------
 -- *   InlineSpec
 
-inlineSpecNoPhase :: Bool -> Bool -> InlineSpecQ
+inlineSpecNoPhase :: Inline -> Bool -> InlineSpecQ
 inlineSpecNoPhase inline conlike
   = return $ InlineSpec inline conlike Nothing
 
-inlineSpecPhase :: Bool -> Bool -> Bool -> Int -> InlineSpecQ
+inlineSpecPhase :: Inline -> Bool -> Bool -> Int -> InlineSpecQ
 inlineSpecPhase inline conlike beforeFrom phase
   = return $ InlineSpec inline conlike (Just (beforeFrom, phase))