haskell-src-meta (empty) → 0.0.0
raw patch · 9 files changed
+1867/−0 lines, 9 filesdep +basedep +containersdep +haskell-src-extssetup-changed
Dependencies added: base, containers, haskell-src-exts, packedstring, syb, template-haskell
Files
- LICENSE +168/−0
- Setup.lhs +3/−0
- haskell-src-meta.cabal +28/−0
- src/Language/Haskell/Meta.hs +20/−0
- src/Language/Haskell/Meta/Parse.hs +130/−0
- src/Language/Haskell/Meta/Syntax.hs +19/−0
- src/Language/Haskell/Meta/Syntax/Translate.hs +462/−0
- src/Language/Haskell/Meta/Syntax/Vars.hs +166/−0
- src/Language/Haskell/TH/Instances/Lift.hs +871/−0
+ LICENSE view
@@ -0,0 +1,168 @@+-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++metaquote++Copyright (c) Matt Morrow.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the author may not be used to endorse or promote+ products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++th-lift++Copyright (c) Ian Lynagh.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the author may not be used to endorse or promote+ products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++haskell-src-exts++This library (Haskell Source eXtensions) is derived from code from several+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++The full text of these licenses is reproduced below. All of the+licenses are BSD-style or compatible. ++-----------------------------------------------------------------------------+The haskell-src-exts package itself is distributable under the +modified BSD license:++Copyright (c) 2005, Niklas Broberg+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of its contributors may not be used to endorse or + promote products derived from this software without specific prior + written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------+
+ Setup.lhs view
@@ -0,0 +1,3 @@+> import Distribution.Simple +> main :: IO () +> main = defaultMain
+ haskell-src-meta.cabal view
@@ -0,0 +1,28 @@+name: haskell-src-meta +version: 0.0.0 +cabal-version: >= 1.5 +build-type: Simple +license: BSD3 +license-file: LICENSE +category: Language +author: Matt Morrow +copyright: (c) Matt Morrow +maintainer: Matt Morrow <mjm2002@gmail.com> +stability: experimental +synopsis: Parse source to template-haskell abstract syntax. +description: The translation from haskell-src-exts abstract syntax + to template-haskell abstract syntax isn't 100% complete yet. + +library + build-tools: + build-Depends: base, containers, haskell-src-exts, + packedstring, template-haskell >= 2.3, syb + extensions: CPP, TemplateHaskell + ghc-options: -O2 -fglasgow-exts + ghc-prof-options: + hs-source-dirs: src + exposed-modules: Language.Haskell.Meta, + Language.Haskell.Meta.Syntax, + Language.Haskell.Meta.Syntax.Vars, + Language.Haskell.Meta.Syntax.Translate, + Language.Haskell.TH.Instances.Lift
+ src/Language/Haskell/Meta.hs view
@@ -0,0 +1,20 @@++{- |+ Module : Language.Haskell.Meta+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.Meta (+ module Language.Haskell.Meta.Parse+ , module Language.Haskell.Meta.Syntax+ , module Language.Haskell.TH.Instances.Lift+) where++import Language.Haskell.Meta.Parse+import Language.Haskell.Meta.Syntax+import Language.Haskell.TH.Instances.Lift+
+ src/Language/Haskell/Meta/Parse.hs view
@@ -0,0 +1,130 @@++{- |+ Module : Language.Haskell.Meta.Parse+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.Meta.Parse (+ module Language.Haskell.Meta.Parse+ , module Language.Haskell.Exts.Syntax+ , module Language.Haskell.Exts.Build+ , module Language.Haskell.Exts.Pretty+) where+++import Language.Haskell.TH.Syntax+import Language.Haskell.Meta.Syntax+import Language.Haskell.Exts.Build+import Language.Haskell.Exts.Syntax+import Language.Haskell.Exts.Parser+import Language.Haskell.Exts.Pretty+import Language.Haskell.Exts.ParseMonad+import Language.Haskell.Exts.ParseUtils+++-----------------------------------------------------------------------------++-- * template-haskell++parsePat :: String -> Either String Pat+parsePat = either Left (Right . toPat) . parseHsPat++parseExp :: String -> Either String Exp+parseExp = either Left (Right . toExp) . parseHsExp+++parseDecs :: String -> Either String [Dec]+parseDecs = either Left (Right . fmap toDec) . parseHsDecls+++-----------------------------------------------------------------------------++-- * haskell-src-exts++parseFile :: FilePath -> IO (ParseResult HsModule)+parseFile fp = readFile fp >>= (return . parseFileContentsWithMode (ParseMode fp))+++parseFileContents :: String -> ParseResult HsModule+parseFileContents = parseFileContentsWithMode defaultParseMode+++parseFileContentsWithMode :: ParseMode -> String -> ParseResult HsModule+parseFileContentsWithMode p rawStr = parseModuleWithMode p (unlines $ map f $ lines rawStr)+ where f ('#':_) = ""+ f x = x+++-----------------------------------------------------------------------------+++parseHsModule :: String -> Either String HsModule+parseHsModule s =+ case parseModule s of+ ParseOk m -> Right m+ ParseFailed loc e ->+ let line = srcLine loc - 1+ in Left (unlines [show line,show loc,e])+++parseHsDecls :: String -> Either String [HsDecl]+parseHsDecls s =+ let s' = unlines [pprHsModule (emptyHsModule "Main"), s]+ in case parseModule s' of+ ParseOk m -> Right (moduleDecls m)+ ParseFailed loc e ->+ let line = srcLine loc - 1+ in Left (unlines [show line,show loc,e])+++parseHsExp :: String -> Either String HsExp+parseHsExp s =+ case parseHsDecls ("main =\n" ++ (unlines . fmap (" "++) . lines $ s)) of+ Left err -> Left err+ Right xs ->+ case [ e | HsPatBind _ _ (HsUnGuardedRhs e) _ <- xs] of+ [] -> Left "invalid expression"+ (e:_) -> Right e+++parseHsPat :: String -> Either String HsPat+parseHsPat s =+ case parseHsDecls ("("++(filter (/='\n') s)++")=()") of+ Left err -> Left err+ Right xs ->+ case [ p | HsPatBind _ p _ _ <- xs] of+ [] -> Left "invalid pattern"+ (p:_) -> Right p+++pprHsModule :: HsModule -> String+pprHsModule = prettyPrint+++moduleDecls :: HsModule -> [HsDecl]+moduleDecls (HsModule _ _ _ _ x) = x+++mkModule :: String -> Module+mkModule = Module+++emptySrcLoc :: SrcLoc+emptySrcLoc = (SrcLoc [] 0 0)+++emptyHsModule :: String -> HsModule+emptyHsModule n =+ (HsModule+ emptySrcLoc+ (mkModule n)+ Nothing+ []+ [])+++-----------------------------------------------------------------------------
+ src/Language/Haskell/Meta/Syntax.hs view
@@ -0,0 +1,19 @@++{- |+ Module : Language.Haskell.Meta.Syntax+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.Meta.Syntax (+ module Language.Haskell.Meta.Syntax.Vars+ , module Language.Haskell.Meta.Syntax.Translate+) where++import Language.Haskell.Meta.Syntax.Vars+import Language.Haskell.Meta.Syntax.Translate++
+ src/Language/Haskell/Meta/Syntax/Translate.hs view
@@ -0,0 +1,462 @@+{-# LANGUAGE TemplateHaskell #-}++{- |+ Module : Language.Haskell.Meta.Syntax.Translate+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.Meta.Syntax.Translate (+ module Language.Haskell.Meta.Syntax.Translate+) where++import Data.Typeable+import Data.Generics+import Data.List (foldl')+import Language.Haskell.TH.Syntax+import Language.Haskell.Exts.Syntax++-----------------------------------------------------------------------------+++class ToName a where toName :: a -> Name+class ToLit a where toLit :: a -> Lit+class ToType a where toType :: a -> Type+class ToPat a where toPat :: a -> Pat+class ToExp a where toExp :: a -> Exp+class ToDec a where toDec :: a -> Dec+class ToStmt a where toStmt :: a -> Stmt+class ToLoc a where toLoc :: a -> Loc+++errorMsg :: (Typeable a) => String -> a -> String+errorMsg fun a = concat+ [ fun,": "+ , show . typeRepTyCon . typeOf $ a+ , " not (yet?) implemented"+ ]+++-----------------------------------------------------------------------------+++instance ToExp Lit where+ toExp = LitE+instance (ToExp a) => ToExp [a] where+ toExp = ListE . fmap toExp+instance (ToExp a, ToExp b) => ToExp (a,b) where+ toExp (a,b) = TupE [toExp a, toExp b]+instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where+ toExp (a,b,c) = TupE [toExp a, toExp b, toExp c]+instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where+ toExp (a,b,c,d) = TupE [toExp a, toExp b, toExp c, toExp d]+++instance ToPat Lit where+ toPat = LitP+instance (ToPat a) => ToPat [a] where+ toPat = ListP . fmap toPat+instance (ToPat a, ToPat b) => ToPat (a,b) where+ toPat (a,b) = TupP [toPat a, toPat b]+instance (ToPat a, ToPat b, ToPat c) => ToPat (a,b,c) where+ toPat (a,b,c) = TupP [toPat a, toPat b, toPat c]+instance (ToPat a, ToPat b, ToPat c, ToPat d) => ToPat (a,b,c,d) where+ toPat (a,b,c,d) = TupP [toPat a, toPat b, toPat c, toPat d]+++instance ToLit Char where+ toLit = CharL+instance ToLit String where+ toLit = StringL+instance ToLit Integer where+ toLit = IntegerL+instance ToLit Int where+ toLit = IntegerL . toInteger+instance ToLit Float where+ toLit = RationalL . toRational+instance ToLit Double where+ toLit = RationalL . toRational+++-----------------------------------------------------------------------------+++-- * ToName {String,HsName,Module,HsSpecialCon,HsQName}+++instance ToName String where+ toName = mkName++instance ToName HsName where+ toName (HsIdent s) = toName s+ toName (HsSymbol s) = toName s++instance ToName Module where+ toName (Module s) = toName s+++instance ToName HsSpecialCon where+ toName HsUnitCon = '()+ toName HsListCon = '[]+ toName HsFunCon = ''(->)+ toName (HsTupleCon n)+ | n<2 = '()+ | otherwise =+ let x = maybe [] (++".") (nameModule '())+ in toName . concat $ x : ["(",replicate (n-1) ',',")"]+ toName HsCons = '(:)+++instance ToName HsQName where+ toName (Qual (Module []) n) = toName n+ toName (Qual m n) =+ let m' = show . toName $ m+ n' = show . toName $ n+ in toName . concat $ [m',".",n']+ toName (UnQual n) = toName n+ toName (Special s) = toName s++++-----------------------------------------------------------------------------++-- * ToLit HsLiteral+++instance ToLit HsLiteral where+ toLit (HsChar a) = CharL a+ toLit (HsString a) = StringL a+ toLit (HsInt a) = IntegerL a+ toLit (HsFrac a) = RationalL a+ toLit (HsCharPrim a) = CharL a -- XXX+ toLit (HsStringPrim a) = StringL a -- XXX+ toLit (HsIntPrim a) = IntPrimL a+ toLit (HsFloatPrim a) = FloatPrimL a+ toLit (HsDoublePrim a) = DoublePrimL a+++-----------------------------------------------------------------------------++-- * ToPat HsPat+++instance ToPat HsPat where+ toPat (HsPVar n)+ = VarP (toName n)+ toPat (HsPLit l)+ = LitP (toLit l)+{-+ghci> parseHsPat "-2"+Right (HsPParen (HsPNeg (HsPLit (HsInt 2))))+-}+ toPat (HsPNeg p) = error "toPat: HsPNeg not supported"+ toPat (HsPInfixApp p n q)= InfixP (toPat p) (toName n) (toPat q)+ toPat (HsPApp n ps) = ConP (toName n) (fmap toPat ps)+ toPat (HsPTuple ps) = TupP (fmap toPat ps)+ toPat (HsPList ps) = ListP (fmap toPat ps)+ toPat (HsPParen p) = toPat p+ toPat (HsPRec n pfs) = let toFieldPat (HsPFieldPat n p) = (toName n, toPat p)+ in RecP (toName n) (fmap toFieldPat pfs)+ toPat (HsPAsPat n p) = AsP (toName n) (toPat p)+ toPat (HsPWildCard) = WildP+ toPat (HsPIrrPat p) = TildeP (toPat p)+ toPat (HsPatTypeSig _ p t) = SigP (toPat p) (toType t)+ toPat (HsPRPat rps) = error "toPat: HsRPat not supported"+ toPat (HsPXTag _ _ _ pM p) = error "toPat: HsPXTag not supported"+ toPat (HsPXETag _ _ _ pM) = error "toPat: HsPXETag not supported"+ toPat (HsPXPcdata _) = error "toPat: HsPXPcdata not supported"+ toPat (HsPXPatTag p) = error "toPat: HsPXPatTag not supported"++-----------------------------------------------------------------------------++-- * ToExp HsExp++instance ToExp HsQOp where+ toExp (HsQVarOp n) = VarE (toName n)+ toExp (HsQConOp n) = ConE (toName n)++toFieldExp :: HsFieldUpdate -> FieldExp+toFieldExp (HsFieldUpdate n e) = (toName n, toExp e)++++instance ToExp HsExp where+{-+data HsExp+ = HsVar HsQName+-}+-- | HsIPVar HsIPName+{-+ | HsLet HsBinds HsExp+ | HsDLet [HsIPBind] HsExp+ | HsWith HsExp [HsIPBind]+ | HsCase HsExp [HsAlt]+ | HsDo [HsStmt]+ -- use mfix somehow+ | HsMDo [HsStmt]+-}+ toExp (HsVar n) = VarE (toName n)+ toExp (HsCon n) = ConE (toName n)+ toExp (HsLit l) = LitE (toLit l)+ toExp (HsInfixApp e o f) = InfixE (Just . toExp $ e) (toExp o) (Just . toExp $ f)+ toExp (HsLeftSection e o) = InfixE (Just . toExp $ e) (toExp o) Nothing+ toExp (HsRightSection o f) = InfixE Nothing (toExp o) (Just . toExp $ f)+ toExp (HsApp e f) = AppE (toExp e) (toExp f)+ toExp (HsNegApp e) = AppE (VarE 'negate) (toExp e)+ toExp (HsLambda _ ps e) = LamE (fmap toPat ps) (toExp e)+ toExp (HsLet bs e) = LetE (hsBindsToDecs bs) (toExp e)+ -- toExp (HsWith e bs+ toExp (HsIf a b c) = CondE (toExp a) (toExp b) (toExp c)+ -- toExp (HsCase e xs)+ -- toExp (HsDo ss)+ -- toExp (HsMDo ss)+ toExp (HsTuple xs) = TupE (fmap toExp xs)+ toExp (HsList xs) = ListE (fmap toExp xs)+ toExp (HsParen e) = toExp e+ toExp (HsRecConstr n xs) = RecConE (toName n) (fmap toFieldExp xs)+ toExp (HsRecUpdate e xs) = RecUpdE (toExp e) (fmap toFieldExp xs)+ toExp (HsEnumFrom e) = ArithSeqE $ FromR (toExp e)+ toExp (HsEnumFromTo e f) = ArithSeqE $ FromToR (toExp e) (toExp f)+ toExp (HsEnumFromThen e f) = ArithSeqE $ FromThenR (toExp e) (toExp f)+ toExp (HsEnumFromThenTo e f g) = ArithSeqE $ FromThenToR (toExp e) (toExp f) (toExp g)+ toExp (HsExpTypeSig _ e t) = SigE (toExp e) (toType t)+ -- HsListComp HsExp [HsStmt]+ -- toExp (HsListComp e ss) = CompE + -- NEED: a way to go e -> Stmt+ toExp a@(HsListComp e ss) = error $ errorMsg "toExp" a+{- HsVarQuote HsQName+ | HsTypQuote HsQName+ | HsBracketExp HsBracket+ | HsSpliceExp HsSplice+data HsBracket+ = HsExpBracket HsExp+ | HsPatBracket HsPat+ | HsTypeBracket HsType+ | HsDeclBracket [HsDecl]+data HsSplice = HsIdSplice String | HsParenSplice HsExp -}+ toExp (HsSpliceExp spl) = toExp spl+ toExp e = error $ errorMsg "toExp" e+++instance ToExp HsSplice where+ toExp (HsIdSplice s) = VarE (toName s)+ toExp (HsParenSplice e) = toExp e+++-----------------------------------------------------------------------------++{-+class ToName a where toName :: a -> Name+class ToLit a where toLit :: a -> Lit+class ToType a where toType :: a -> Type+class ToPat a where toPat :: a -> Pat+class ToExp a where toExp :: a -> Exp+class ToDec a where toDec :: a -> Dec+class ToStmt a where toStmt :: a -> Stmt+class ToLoc a where toLoc :: a -> Loc+-}++{-+TODO:+ []++PARTIAL:+ * ToExp HsExp+ * ToStmt HsStmt+ * ToDec HsDecl++DONE:+ * ToLit HsLiteral+ * ToName {..}+ * ToPat HsPat+ * ToLoc SrcLoc+ * ToType HsType++-}+-----------------------------------------------------------------------------++-- * ToLoc SrcLoc++instance ToLoc SrcLoc where+ toLoc (SrcLoc fn l c) =+ Loc fn [] [] (l,c) (-1,-1)++-----------------------------------------------------------------------------++-- * ToType HsType++instance ToName HsTyVarBind where+ toName (HsKindedVar n _) = toName n+ toName (HsUnkindedVar n) = toName n++{- |+TH does't handle+ * unboxed tuples+ * implicit params+ * infix type constructors+ * kind signatures+-}+instance ToType HsType where+ toType (HsTyForall tvbM cxt t) = ForallT (maybe [] (fmap toName) tvbM) (fmap toType cxt) (toType t)+ toType (HsTyFun a b) = toType a .->. toType b+ toType (HsTyTuple _ ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)+ toType (HsTyApp a b) = AppT (toType a) (toType b)+ toType (HsTyVar n) = VarT (toName n)+ toType (HsTyCon qn) = ConT (toName qn)+ toType a@(HsTyPred _) = error $ errorMsg "toType" a++ -- XXX: need to wrap the name in parens!+ toType (HsTyInfix a qn b) = foldAppT (ConT . toName $ qn) (fmap toType [a,b])+ toType (HsTyKind t _) = toType t++(.->.) :: Type -> Type -> Type+a .->. b = AppT (AppT ArrowT a) b++{- |+TH doesn't handle:+ * implicit params+ * equality constraints+-}+instance ToType HsAsst where+ toType (HsClassA n ts) = foldAppT (ConT . toName $ n) (fmap toType ts)+ toType a@(HsIParam _ _) = error $ errorMsg "toType" a+ toType a@(HsEqualP _ _) = error $ errorMsg "toType" a++foldAppT :: Type -> [Type] -> Type+foldAppT t ts = foldl' AppT t ts++-----------------------------------------------------------------------------++-- * ToStmt HsStmt++instance ToStmt HsStmt where+ toStmt (HsGenerator _ p e) = BindS (toPat p) (toExp e)+ toStmt (HsQualifier e) = NoBindS (toExp e)+ toStmt a@(HsLetStmt bnds) = LetS (hsBindsToDecs bnds)+++-----------------------------------------------------------------------------++-- * ToDec HsDecl++-- data HsBinds = HsBDecls [HsDecl] | HsIPBinds [HsIPBind]+hsBindsToDecs :: HsBinds -> [Dec]+hsBindsToDecs (HsBDecls ds) = fmap toDec ds+hsBindsToDecs a@(HsIPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a+-- data HsIPBind = HsIPBind SrcLoc HsIPName HsExp+++hsBangTypeToStrictType :: HsBangType -> (Strict, Type)+hsBangTypeToStrictType (HsBangedTy t) = (IsStrict, toType t)+hsBangTypeToStrictType (HsUnBangedTy t) = (NotStrict, toType t)+++{-+data HsTyVarBind = HsKindedVar HsName HsKind | HsUnkindedVar HsName+data HsConDecl+ = HsConDecl HsName [HsBangType]+ | HsRecDecl HsName [([HsName], HsBangType)]+-}+{-+hsQualConDeclToCon :: HsQualConDecl -> Con+hsQualConDeclToCon (HsQualConDecl _ tvbs cxt condec) =+ case condec of+ HsConDecl n bangs ->+ HsRecDecl n assocs ->+-}++instance ToDec HsDecl where+ toDec (HsTypeDecl _ n ns t) = TySynD (toName n) (fmap toName ns) (toType t)+ toDec a@(HsDataDecl _ dOrN cxt n ns qcds qns) = error $ errorMsg "toDec" a+{-+data HsQualConDecl+ = HsQualConDecl SrcLoc + [HsTyVarBind] HsContext+ HsConDecl+-}+{-+ case dOrN of+ DataType -> DataD+ (fmap toType cxt)+ (toName n)+ (fmap toName ns)+ NewType ->+-}+ toDec a@(HsGDataDecl _ dOrN cxt n ns kM gadtDecs) = error $ errorMsg "toDec" a+ toDec a@(HsTypeFamDecl _ n ns kM) = error $ errorMsg "toDec" a+ toDec a@(HsDataFamDecl _ cxt n ns kM) = error $ errorMsg "toDec" a+ toDec a@(HsTypeInsDecl _ ta tb) = error $ errorMsg "toDec" a+ toDec a@(HsDataInsDecl _ dOrN t qcds qns) = error $ errorMsg "toDec" a+ toDec a@(HsGDataInsDecl _ dOrN t kM gadtDecs) = error $ errorMsg "toDec" a+-- data HsOp = HsVarOp HsName | HsConOp HsName+ toDec a@(HsInfixDecl _ asst i ops) = error $ errorMsg "toDec" a+ toDec a@(HsClassDecl _ cxt n ns funDeps cDecs) = error $ errorMsg "toDec" a+ toDec a@(HsInstDecl _ cxt qn ts instDecs) = error $ errorMsg "toDec" a+ toDec a@(HsDerivDecl _ cxt qn ts) = error $ errorMsg "toDec" a + toDec a@(HsDefaultDecl _ ts) = error $ errorMsg "toDec" a+ toDec a@(HsSpliceDecl _ s) = error $ errorMsg "toDec" a+ toDec a@(HsTypeSig _ ns t) = error $ errorMsg "toDec" a+{- data HsDecl = ... | HsFunBind [HsMatch] | ...+data HsMatch = HsMatch SrcLoc HsName [HsPat] HsRhs HsBinds+data Dec = FunD Name [Clause] | ...+data Clause = Clause [Pat] Body [Dec] -}+ toDec a@(HsFunBind mtchs) = hsMatchesToFunD mtchs+{- ghci> parseExp "let x = 2 in x"+LetE [ValD (VarP x) (NormalB (LitE (IntegerL 2))) []] (VarE x)+ghci> unQ[| let x = 2 in x |]+LetE [ValD (VarP x_0) (NormalB (LitE (IntegerL 2))) []] (VarE x_0) -}+ toDec (HsPatBind _ p rhs bnds) = ValD (toPat p) (hsRhsToBody rhs) (hsBindsToDecs bnds)+ toDec a@(HsForImp _ cconv safe str n t) = error $ errorMsg "toDec" a+ toDec a@(HsForExp _ cconv str n t) = error $ errorMsg "toDec" a++++hsMatchesToFunD :: [HsMatch] -> Dec+hsMatchesToFunD [] = FunD (mkName []) [] -- errorish+hsMatchesToFunD xs@(HsMatch _ n _ _ _:_) = FunD (toName n) (fmap hsMatchToClause xs)+++hsMatchToClause :: HsMatch -> Clause+hsMatchToClause (HsMatch _ _ ps rhs bnds) = Clause+ (fmap toPat ps)+ (hsRhsToBody rhs)+ (hsBindsToDecs bnds)++++-- data HsRhs = HsUnGuardedRhs HsExp | HsGuardedRhs [HsGuardedRhs]+-- data HsGuardedRhs = HsGuardedRhs SrcLoc [HsStmt] HsExp+-- data Body = GuardedB [(Guard, Exp)] | NormalB Exp+-- data Guard = NormalG Exp | PatG [Stmt]+hsRhsToBody :: HsRhs -> Body+hsRhsToBody (HsUnGuardedRhs e) = NormalB (toExp e)+hsRhsToBody (HsGuardedRhss hsgrhs) = let fromGuardedB (GuardedB a) = a+ in GuardedB . concat+ . fmap (fromGuardedB . hsGuardedRhsToBody)+ $ hsgrhs++++hsGuardedRhsToBody :: HsGuardedRhs -> Body+hsGuardedRhsToBody (HsGuardedRhs _ [] e) = NormalB (toExp e)+hsGuardedRhsToBody (HsGuardedRhs _ [s] e) = GuardedB [(hsStmtToGuard s, toExp e)]+hsGuardedRhsToBody (HsGuardedRhs _ ss e) = let ss' = fmap hsStmtToGuard ss+ (pgs,ngs) = unzip [(p,n)+ | (PatG p) <- ss'+ , n@(NormalG _) <- ss']+ e' = toExp e+ patg = PatG (concat pgs)+ in GuardedB $ (patg,e') : zip ngs (repeat e')++++hsStmtToGuard :: HsStmt -> Guard+hsStmtToGuard (HsGenerator _ p e) = PatG [BindS (toPat p) (toExp e)]+hsStmtToGuard (HsQualifier e) = NormalG (toExp e)+hsStmtToGuard a@(HsLetStmt _) = error $ errorMsg "hsStmtToGuardExp" a+++-----------------------------------------------------------------------------
+ src/Language/Haskell/Meta/Syntax/Vars.hs view
@@ -0,0 +1,166 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++{- |+ Module : Language.Haskell.Meta.Syntax.Vars+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.Meta.Syntax.Vars (+ Vars(..)+) where++import Data.Set (Set)+import qualified Data.Set as S+import Language.Haskell.TH.Syntax++-----------------------------------------------------------------------------+++class Vars e v where+ vars :: (Ord v) => e -> Set v+ fvs :: (Ord v) => e -> Set v+ bvs :: (Ord v) => e -> Set v+ vars e = fvs e `S.union` bvs e+ fvs e = vars e `S.difference` bvs e+ bvs e = vars e `S.difference` fvs e+++instance (Vars e v) => Vars [e] v where+ vars = S.unions . fmap vars+ fvs = S.unions . fmap fvs+ bvs = S.unions . fmap bvs+++-----------------------------------------------------------------------------+++instance Vars Pat Name where+ vars (LitP _) = S.empty+ vars (VarP n) = S.singleton n+ vars (TupP ps) = vars ps+ vars (ConP n ps) = n `S.insert` vars ps+ vars (InfixP p n q) = n `S.insert` vars [p,q]+ vars (TildeP p) = vars p+ vars (AsP n p) = n `S.insert` vars p+ vars (WildP) = S.empty+ vars (RecP n pfs) = (n `S.insert`) . vars . fmap snd $ pfs+ vars (ListP ps) = vars ps+ vars (SigP p _) = vars p+ bvs (LitP _) = S.empty+ bvs (VarP n) = S.singleton n+ bvs (TupP ps) = bvs ps+ bvs (ConP _ ps) = bvs ps+ bvs (InfixP p _ q) = bvs [p,q]+ bvs (TildeP p) = bvs p+ bvs (AsP n p) = n `S.insert` bvs p+ bvs (WildP) = S.empty+ bvs (RecP _ pfs) = bvs . fmap snd $ pfs+ bvs (ListP ps) = bvs ps+ bvs (SigP p _) = bvs p+++instance Vars Range Name where+ vars (FromR e) = vars e+ vars (FromThenR e f) = vars [e,f]+ vars (FromToR e f) = vars [e,f]+ vars (FromThenToR e f g) = vars [e,f,g]+ fvs (FromR e) = fvs e+ fvs (FromThenR e f) = fvs [e,f]+ fvs (FromToR e f) = fvs [e,f]+ fvs (FromThenToR e f g) = fvs [e,f,g]+++instance Vars Exp Name where+ vars (LamE ps e) = fvs ps `S.union` vars e+ vars (LetE ds e) = fvs e `S.union` vars ds+ vars e = fvs e+ fvs (VarE n) = S.singleton n+ fvs (ConE n) = S.singleton n+ fvs (LitE _) = S.empty+ fvs (AppE a b) = fvs [a,b]+ fvs (InfixE aM b cM) = fvs (b : concatMap (maybe [] (:[])) [aM,cM])+ fvs (LamE ps e) = fvs e `S.difference` bvs ps+ fvs (TupE es) = fvs es+ fvs (CondE e f g) = fvs [e,f,g]+ fvs (LetE ds e) = (fvs e `S.union` fvs ds) `S.difference` bvs ds+ fvs (CaseE e ms) = fvs e `S.union` fvs ms+ fvs (DoE ss) = fvs ss+ fvs (CompE ss) = fvs ss+ fvs (ArithSeqE r) = fvs r+ fvs (ListE xs) = fvs xs+ fvs (SigE e _) = fvs e+ fvs (RecConE n xs) = (n `S.insert`) . fvs . fmap snd $ xs+ fvs (RecUpdE e xs) = fvs . (e:) . fmap snd $ xs+++instance Vars Match Name where+ fvs (Match p b decs) = (fvs b `S.union` fvs decs)+ `S.difference` (bvs decs `S.union` bvs p)+++instance Vars Dec Name where+ vars (FunD n cs) = n `S.insert` vars cs+ vars (ValD p bdy decs) =+ vars p `S.union` vars bdy `S.union` vars decs+ vars (ClassD _ _ _ _ decs) = vars decs+ vars (InstanceD _ _ decs) = vars decs+ vars _ = S.empty+ bvs (FunD n _) = S.singleton n+ bvs (ValD p _ _) = bvs p+ bvs (ClassD _ _ _ _ decs) = bvs decs+ bvs (InstanceD _ _ decs) = bvs decs+ bvs (SigD n _) = S.singleton n+ bvs _ = S.empty+++-- data Clause = Clause [Pat] Body [Dec]+instance Vars Clause Name where+ vars (Clause ps bdy decs) =+ vars ps `S.union` vars bdy `S.union` vars decs+ fvs (Clause ps bdy decs) =+ fvs bdy `S.difference` (bvs ps `S.union` bvs decs)+++-- data Body = GuardedB [(Guard, Exp)] | NormalB Exp+instance Vars Body Name where+ vars (NormalB e) = vars e+ vars (GuardedB xs) = S.unions+ . fmap (\(g,e) -> vars g `S.union` vars e)+ $ xs+ fvs (NormalB e) = fvs e+ fvs (GuardedB xs) = S.unions+ . fmap (\(g,e) -> fvs e `S.difference` bvs g)+ $ xs+++-- data Guard = NormalG Exp | PatG [Stmt]+instance Vars Guard Name where+ vars (NormalG e) = vars e+ vars (PatG ss) = vars ss+ fvs (NormalG e) = fvs e+ fvs (PatG ss) = fvs ss+ bvs (NormalG e) = bvs e+ bvs (PatG ss) = bvs ss+++-- data Stmt = BindS Pat Exp | LetS [Dec] | NoBindS Exp | ParS [[Stmt]]+instance Vars Stmt Name where+ vars (BindS p e) = vars p `S.union` vars e+ vars (LetS decs) = vars decs+ vars (NoBindS e) = vars e+ vars (ParS sss) = vars . concat $ sss+ fvs (BindS p e) = fvs e `S.difference` bvs p+ fvs (LetS decs) = fvs decs+ fvs (NoBindS e) = fvs e+ fvs (ParS sss) = fvs . concat $ sss+ bvs (BindS p e) = bvs p+ bvs (LetS decs) = bvs decs+ bvs (NoBindS e) = bvs e+ bvs (ParS sss) = bvs . concat $ sss+++-----------------------------------------------------------------------------
+ src/Language/Haskell/TH/Instances/Lift.hs view
@@ -0,0 +1,871 @@+{-# LANGUAGE TemplateHaskell, CPP #-}++{- |+ Module : Language.Haskell.TH.Instances.Lift+ Copyright : (c) Matt Morrow 2008+ License : BSD3+ Maintainer : Matt Morrow <mjm2002@gmail.com>+ Stability : experimental+ Portability : portable (template-haskell)+-}++module Language.Haskell.TH.Instances.Lift () where++import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Ppr+import Data.PackedString+import Data.List(intercalate)+import GHC.Base++instance Lift () where+ lift () = [|()|]++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 609+instance Show Loc where+ show (Loc f p m s e) =+ intercalate " " $+ ("Loc":fmap show [f,p,m]++[show s,show e])++instance Eq Loc where+ (Loc a b c d e) == (Loc v w x y z)+ = and $ [d==y,e==z] +++ (zipWith (==) [a,b,c] [v,w,x])++-- TODO: make this better+instance Ppr Loc where+ ppr = showtextl . show+#endif++instance Ppr Lit where+ ppr l = ppr (LitE l)++-- comic relief from HERA+instance Lift Rational where lift _ = error "Rational.. what are you doing!"++instance Lift Name where+ lift (Name occName nameFlavour) = [| Name occName nameFlavour |]++instance Lift PackedString where+ lift ps = [| packString $(lift $ unpackPS ps) |]++instance Lift NameFlavour where+ lift NameS = [| NameS |]+ lift (NameQ modName) = [| NameQ modName |]+ lift (NameU i) = [| case $( lift (I# i) ) of+ I# i' -> NameU i' |]+ lift (NameL i) = [| case $( lift (I# i) ) of+ I# i' -> NameL i' |]+ lift (NameG nameSpace pkgName modName)+ = [| NameG nameSpace pkgName modName |]++instance Lift NameSpace where+ lift VarName = [| VarName |]+ lift DataName = [| DataName |]+ lift TcClsName = [| TcClsName |]+++instance Lift Dec where+ lift (FunD x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "FunD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (ValD x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "ValD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (DataD x0 x1 x2 x3 x4)+ = appE+ (appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "DataD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3))+ (lift x4)+ lift (NewtypeD x0 x1 x2 x3 x4)+ = appE+ (appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "NewtypeD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3))+ (lift x4)+ lift (TySynD x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "TySynD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (ClassD x0 x1 x2 x3 x4)+ = appE+ (appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "ClassD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3))+ (lift x4)+ lift (InstanceD x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "InstanceD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (SigD x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "SigD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (ForeignD x0)+ = appE+ (conE+ (Name (packString "ForeignD")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)++instance Lift Exp where+ lift (VarE x0)+ = appE+ (conE+ (Name (packString "VarE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ConE x0)+ = appE+ (conE+ (Name (packString "ConE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (LitE x0)+ = appE+ (conE+ (Name (packString "LitE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (AppE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "AppE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (InfixE x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "InfixE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (LamE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "LamE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (TupE x0)+ = appE+ (conE+ (Name (packString "TupE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (CondE x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "CondE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (LetE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "LetE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (CaseE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "CaseE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (DoE x0)+ = appE+ (conE+ (Name (packString "DoE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (CompE x0)+ = appE+ (conE+ (Name (packString "CompE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ArithSeqE x0)+ = appE+ (conE+ (Name (packString "ArithSeqE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ListE x0)+ = appE+ (conE+ (Name (packString "ListE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (SigE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "SigE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (RecConE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "RecConE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (RecUpdE x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "RecUpdE")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift Lit where+ lift (CharL x0)+ = appE+ (conE+ (Name (packString "CharL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (StringL x0)+ = appE+ (conE+ (Name (packString "StringL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (IntegerL x0)+ = appE+ (conE+ (Name (packString "IntegerL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (RationalL x0)+ = appE+ (conE+ (Name (packString "RationalL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (IntPrimL x0)+ = appE+ (conE+ (Name (packString "IntPrimL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 609+ lift (WordPrimL x0)+ = appE+ (conE+ (Name (packString "WordPrimL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+#endif+ lift (FloatPrimL x0)+ = appE+ (conE+ (Name (packString "FloatPrimL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (DoublePrimL x0)+ = appE+ (conE+ (Name (packString "DoublePrimL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)++instance Lift Pat where+ lift (LitP x0)+ = appE+ (conE+ (Name (packString "LitP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (VarP x0)+ = appE+ (conE+ (Name (packString "VarP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (TupP x0)+ = appE+ (conE+ (Name (packString "TupP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ConP x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "ConP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (InfixP x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "InfixP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (TildeP x0)+ = appE+ (conE+ (Name (packString "TildeP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (AsP x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "AsP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (WildP)+ = conE+ (Name (packString "WildP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (RecP x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "RecP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (ListP x0)+ = appE+ (conE+ (Name (packString "ListP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (SigP x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "SigP")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift Body where+ lift (GuardedB x0)+ = appE+ (conE+ (Name (packString "GuardedB")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (NormalB x0)+ = appE+ (conE+ (Name (packString "NormalB")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)++instance Lift Con where+ lift (NormalC x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "NormalC")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (RecC x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "RecC")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (InfixC x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "InfixC")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (ForallC x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "ForallC")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)++instance Lift Clause where+ lift (Clause x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "Clause")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)++instance Lift Guard where+ lift (NormalG x0)+ = appE+ (conE+ (Name (packString "NormalG")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (PatG x0)+ = appE+ (conE+ (Name (packString "PatG")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)++instance Lift Strict where+ lift (IsStrict)+ = conE+ (Name (packString "IsStrict")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (NotStrict)+ = conE+ (Name (packString "NotStrict")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))++instance Lift FunDep where+ lift (FunDep x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "FunDep")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift Foreign where+ lift (ImportF x0 x1 x2 x3 x4)+ = appE+ (appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "ImportF")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3))+ (lift x4)+ lift (ExportF x0 x1 x2 x3)+ = appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "ExportF")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3)++instance Lift Callconv where+ lift (CCall)+ = conE+ (Name (packString "CCall")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (StdCall)+ = conE+ (Name (packString "StdCall")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))++instance Lift Safety where+ lift (Unsafe)+ = conE+ (Name (packString "Unsafe")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (Safe)+ = conE+ (Name (packString "Safe")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (Threadsafe)+ = conE+ (Name (packString "Threadsafe")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))++instance Lift Match where+ lift (Match x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "Match")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)++instance Lift Stmt where+ lift (BindS x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "BindS")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (LetS x0)+ = appE+ (conE+ (Name (packString "LetS")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (NoBindS x0)+ = appE+ (conE+ (Name (packString "NoBindS")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ParS x0)+ = appE+ (conE+ (Name (packString "ParS")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)++instance Lift Range where+ lift (FromR x0)+ = appE+ (conE+ (Name (packString "FromR")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (FromThenR x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "FromThenR")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (FromToR x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "FromToR")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)+ lift (FromThenToR x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "FromThenToR")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)++instance Lift Type where+ lift (ForallT x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "ForallT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (VarT x0)+ = appE+ (conE+ (Name (packString "VarT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ConT x0)+ = appE+ (conE+ (Name (packString "ConT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (TupleT x0)+ = appE+ (conE+ (Name (packString "TupleT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ArrowT)+ = conE+ (Name (packString "ArrowT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (ListT)+ = conE+ (Name (packString "ListT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (AppT x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "AppT")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift Info where+ lift (ClassI x0)+ = appE+ (conE+ (Name (packString "ClassI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (ClassOpI x0 x1 x2 x3)+ = appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "ClassOpI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3)+ lift (TyConI x0)+ = appE+ (conE+ (Name (packString "TyConI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0)+ lift (PrimTyConI x0 x1 x2)+ = appE+ (appE+ (appE+ (conE+ (Name (packString "PrimTyConI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2)+ lift (DataConI x0 x1 x2 x3)+ = appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "DataConI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3)+ lift (VarI x0 x1 x2 x3)+ = appE+ (appE+ (appE+ (appE+ (conE+ (Name (packString "VarI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1))+ (lift x2))+ (lift x3)+ lift (TyVarI x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "TyVarI")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift Fixity where+ lift (Fixity x0 x1)+ = appE+ (appE+ (conE+ (Name (packString "Fixity")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax"))))+ (lift x0))+ (lift x1)++instance Lift FixityDirection where+ lift (InfixL)+ = conE+ (Name (packString "InfixL")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (InfixR)+ = conE+ (Name (packString "InfixR")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))+ lift (InfixN)+ = conE+ (Name (packString "InfixN")+ (NameG DataName (packString "template-haskell")+ (packString "Language.Haskell.TH.Syntax")))