[removed dependency from haskell-src-exts
martin.hofmann@uni-bamberg.de**20090619101344
 also deleted the the-hard-way-imported module haskell-src-meta
] hunk ./igor2.cabal 13
-               ghc-paths -any, haskell-src >=1.0, haskell-src-exts >=0.4,
+               ghc-paths -any, haskell-src >=1.0,
hunk ./src/Context/ContextBuilder.hs 16
-import Language.Haskell.Meta.Parse
-import qualified Data.Typeable as T
-import Data.Generics
-import Language.Haskell.Exts.Parser (ParseResult(..))
-import qualified Language.Haskell.Exts.Syntax as Hs
+import qualified Data.Typeable as T (typeOf)
+import Data.Generics (typeRepTyCon, Typeable(..))
+import Language.Haskell.Syntax
+import Language.Haskell.Parser
hunk ./src/Context/ContextBuilder.hs 50
-    noFunBind (Hs.FunBind _ ) = False
+    moduleDecls (HsModule _ _ _ _ d) = d
+    noFunBind (HsFunBind _ ) = False
hunk ./src/Context/ContextBuilder.hs 53
-    parse s = do rs <- parseFile s
-                 case rs of 
+    parse s = do f <- readFile s
+                 case parseModule f of 
hunk ./src/Context/ContextBuilder.hs 61
-buildCtx :: ModuleCtx -> Hs.Decl -> IO ModuleCtx
-buildCtx ctx d@(Hs.TypeDecl _  _ _ _) = 
+buildCtx :: ModuleCtx -> HsDecl -> IO ModuleCtx
+buildCtx ctx d@(HsTypeDecl _  _ _ _) = 
hunk ./src/Context/ContextBuilder.hs 66
-buildCtx ctx (Hs.DataDecl _ _ assts tname args condecls derive) = do
+buildCtx ctx (HsDataDecl _ assts tname args condecls derive) = do
hunk ./src/Context/ContextBuilder.hs 72
-            (Hs.QualConDecl _ _ _ (Hs.ConDecl n tys)) ->  return ( toName n, ctorty $ map unBang tys);
+            (HsConDecl _ n tys) ->  return ( toName n, ctorty $ map unBang tys);
hunk ./src/Context/ContextBuilder.hs 77
-    let pTysClass = map (\(n,_) ->  ((mkForallT assts (toType dataty)), (toName n))) derive
+    let pTysClass = map (\n -> ((mkForallT assts (toType dataty)), (toName n))) derive
hunk ./src/Context/ContextBuilder.hs 80
---buildCtx ctx (Hs.ClassDecl sloc _ _ [] _ _) = can never be
-buildCtx ctx (Hs.ClassDecl sloc _ _ (_:_:_) _ _) =
+--buildCtx ctx (HsClassDecl sloc _ _ [] _ _) = can never be
+buildCtx ctx (HsClassDecl sloc _ _ (_:_:_) _) =
hunk ./src/Context/ContextBuilder.hs 83
-buildCtx ctx (Hs.ClassDecl sloc assts cname anames _ decls) = do
-    let getClsDecl d = case d of 
-                        (Hs.ClsDecl dcl) -> return dcl ;
-                        _owise -> fail $ "Only plain vanilla class declarations are supported! " ++ (show sloc)
+buildCtx ctx (HsClassDecl sloc assts cname anames decls) = do
+--    let getClsDecl d = case d of 
+--                        (HsClsDecl dcl) -> return dcl ;
+--                        _owise -> fail $ "Only plain vanilla class declarations are supported! " ++ (show sloc)
hunk ./src/Context/ContextBuilder.hs 88
-    clsdecls <- mapM getClsDecl decls 
-    let sigds        = concatMap toDec $ filter isTypeDecl $ clsdecls
+--    clsdecls <- mapM getClsDecl decls 
+    let sigds        = concatMap toDec $ filter isTypeDecl $ decls
hunk ./src/Context/ContextBuilder.hs 91
-        isTypeDecl d = case d of (Hs.TypeSig _ _ _) -> True; _owise -> False
+        isTypeDecl d = case d of (HsTypeSig _ _ _) -> True; _owise -> False
hunk ./src/Context/ContextBuilder.hs 99
-        pClssSupr   = [(toName cname,[ toName n | (Hs.ClassA n _vars) <- assts])]
+        pClssSupr   = [(toName cname,[ (toName.fst) a | a <- assts])]
hunk ./src/Context/ContextBuilder.hs 102
---buildCtx _ (Hs.InstDecl sloc _ _ [] _) -- can never be 
-buildCtx _ (Hs.InstDecl sloc _ _ (_:_:_) _) =      
+--buildCtx _ (HsInstDecl sloc _ _ [] _) -- can never be 
+buildCtx _ (HsInstDecl sloc _ _ (_:_:_) _) =      
hunk ./src/Context/ContextBuilder.hs 105
-buildCtx ctx (Hs.InstDecl sloc assts qname [t] _) = do 
+buildCtx ctx (HsInstDecl sloc assts qname [t] _) = do 
hunk ./src/Context/ContextBuilder.hs 112
-buildCtx ctx d@(Hs.TypeSig _ _ _ ) =
+buildCtx ctx d@(HsTypeSig _ _ _ ) =
hunk ./src/Context/ContextBuilder.hs 116
-buildCtx ctx d@(Hs.FunBind _ ) = do 
+buildCtx ctx d@(HsFunBind _ ) = do 
hunk ./src/Context/ContextBuilder.hs 122
-buildCtx e (Hs.GDataDecl sloc _ _ _ _ _ _ _ ) = do
-    putStrLn $ "...Skipping GDataDecl at Defining " ++ (show sloc)
-    return e    
-buildCtx e (Hs.TypeFamDecl sloc _ _ _ ) = do
-    putStrLn $ "...Skipping TypeFamDecl at " ++ (show sloc)
-    return e    
-buildCtx e (Hs.DataFamDecl sloc _ _ _ _ ) = do
-    putStrLn $ "...Skipping DataFamDecl at " ++ (show sloc)
-    return e     
-buildCtx e (Hs.TypeInsDecl sloc _ _ ) = do
-    putStrLn $ "...Skipping TypeInsDecl at " ++ (show sloc)
-    return e         
-buildCtx e (Hs.DataInsDecl sloc _ _ _ _ ) = do
-    putStrLn $ "...Skipping DataInsDecl at " ++ (show sloc)
-    return e           
-buildCtx e (Hs.GDataInsDecl sloc _ _ _ _ _ ) = do
-    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
-    return e            
-buildCtx e (Hs.InfixDecl sloc _ _ _ ) = do
+--buildCtx e (HsGDataDecl sloc _ _ _ _ _ _ _ ) = do
+--    putStrLn $ "...Skipping GDataDecl at Defining " ++ (show sloc)
+--    return e    
+--buildCtx e (HsTypeFamDecl sloc _ _ _ ) = do
+--    putStrLn $ "...Skipping TypeFamDecl at " ++ (show sloc)
+--    return e    
+--buildCtx e (HsDataFamDecl sloc _ _ _ _ ) = do
+--    putStrLn $ "...Skipping DataFamDecl at " ++ (show sloc)
+--    return e     
+--buildCtx e (HsTypeInsDecl sloc _ _ ) = do
+--    putStrLn $ "...Skipping TypeInsDecl at " ++ (show sloc)
+--    return e         
+--buildCtx e (HsDataInsDecl sloc _ _ _ _ ) = do
+--    putStrLn $ "...Skipping DataInsDecl at " ++ (show sloc)
+--    return e           
+--buildCtx e (HsGDataInsDecl sloc _ _ _ _ _ ) = do
+--    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
+--    return e            
+buildCtx e (HsInfixDecl sloc _ _ _ ) = do
hunk ./src/Context/ContextBuilder.hs 143
-buildCtx e (Hs.DerivDecl sloc _ _ _ ) = do
-    putStrLn $ "...Skipping DerivDecl at " ++ (show sloc)
-    return e               
-buildCtx e (Hs.DefaultDecl sloc _ ) = do
+--buildCtx e (HsDerivDecl sloc _ _ _ ) = do
+--    putStrLn $ "...Skipping DerivDecl at " ++ (show sloc)
+--    return e               
+buildCtx e (HsDefaultDecl sloc _ ) = do
hunk ./src/Context/ContextBuilder.hs 149
-buildCtx e (Hs.SpliceDecl sloc _ ) = do
-    putStrLn $ "...Skipping SpliceDecl at " ++ (show sloc)
-    return e              
-buildCtx e (Hs.PatBind sloc _ _ _ _ ) = do
+--buildCtx e (HsSpliceDecl sloc _ ) = do
+--    putStrLn $ "...Skipping SpliceDecl at " ++ (show sloc)
+--    return e              
+buildCtx e (HsPatBind sloc _ _ _) = do
hunk ./src/Context/ContextBuilder.hs 155
-buildCtx e (Hs.ForImp sloc _ _ _ _ _ ) = do
-    putStrLn $ "...Skipping ForImp at " ++ (show sloc)
-    return e              
-buildCtx e (Hs.ForExp sloc _ _ _ _ ) = do
-    putStrLn $ "...Skipping ForExp at " ++ (show sloc)
-    return e             
-buildCtx e (Hs.RulePragmaDecl sloc _ ) = do
-    putStrLn $ "...Skipping RulePragmaDecl at " ++ (show sloc)
-    return e                
-buildCtx e (Hs.DeprPragmaDecl sloc _ ) = do
-    putStrLn $ "...Skipping DeprPragmaDecl at " ++ (show sloc)
-    return e                
-buildCtx e (Hs.WarnPragmaDecl sloc _ ) = do
-    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
-    return e                
-buildCtx e (Hs.InlineSig sloc _ _ _ ) = do
-    putStrLn $ "...Skipping InlineSig at " ++ (show sloc)
-    return e              
-buildCtx e (Hs.SpecSig sloc _ _ ) = do
-    putStrLn $ "...Skipping SpecSig at " ++ (show sloc)
-    return e             
-buildCtx e (Hs.SpecInlineSig sloc _ _ _ _ ) = do
-    putStrLn $ "...Skipping SpecInlineSig at " ++ (show sloc)
-    return e               
-buildCtx e (Hs.InstSig sloc _ _ _ ) = do
-    putStrLn $ "...Skipping InstSig at " ++ (show sloc)
-    return e             
-buildCtx e (Hs.UnknownDeclPragma sloc _ _ ) = do
-    putStrLn $ "...Skipping UnknownDeclPragma at " ++ (show sloc)
-    return e            
+--buildCtx e (HsForImp sloc _ _ _ _ _ ) = do
+--    putStrLn $ "...Skipping ForImp at " ++ (show sloc)
+--    return e              
+--buildCtx e (HsForExp sloc _ _ _ _ ) = do
+--    putStrLn $ "...Skipping ForExp at " ++ (show sloc)
+--    return e             
+--buildCtx e (HsRulePragmaDecl sloc _ ) = do
+--    putStrLn $ "...Skipping RulePragmaDecl at " ++ (show sloc)
+--    return e                
+--buildCtx e (HsDeprPragmaDecl sloc _ ) = do
+--    putStrLn $ "...Skipping DeprPragmaDecl at " ++ (show sloc)
+--    return e                
+--buildCtx e (HsWarnPragmaDecl sloc _ ) = do
+--    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
+--    return e                
+--buildCtx e (HsInlineSig sloc _ _ _ ) = do
+--    putStrLn $ "...Skipping InlineSig at " ++ (show sloc)
+--    return e              
+--buildCtx e (HsSpecSig sloc _ _ ) = do
+--    putStrLn $ "...Skipping SpecSig at " ++ (show sloc)
+--    return e             
+--buildCtx e (HsSpecInlineSig sloc _ _ _ _ ) = do
+--    putStrLn $ "...Skipping SpecInlineSig at " ++ (show sloc)
+--    return e               
+--buildCtx e (HsInstSig sloc _ _ _ ) = do
+--    putStrLn $ "...Skipping InstSig at " ++ (show sloc)
+--    return e             
+--buildCtx e (HsUnknownDeclPragma sloc _ _ ) = do
+--    putStrLn $ "...Skipping UnknownDeclPragma at " ++ (show sloc)
+--    return e            
hunk ./src/Context/ContextBuilder.hs 186
---toDec :: Hs.Decl -> [Dec]
---toDec (Hs.TypeSig _ ns t) =  [SigD (toName n) (toType t) | n <- ns]
+--toDec :: HsDecl -> [Dec]
+--toDec (HsTypeSig _ ns t) =  [SigD (toName n) (toType t) | n <- ns]
hunk ./src/Context/ContextBuilder.hs 194
-mkHsTyApp :: Hs.Name -> [Hs.Name] -> Hs.Type
-mkHsTyApp n as = foldl Hs.TyApp (Hs.TyCon $ Hs.UnQual n) (map Hs.TyVar as)
+mkHsTyApp :: HsName -> [HsName] -> HsType
+mkHsTyApp n as = foldl HsTyApp (HsTyCon $ UnQual n) (map HsTyVar as)
hunk ./src/Context/ContextBuilder.hs 197
-mkHsTyFun :: [Hs.Type] -> Hs.Type
-mkHsTyFun = foldr1 Hs.TyFun
+mkHsTyFun :: [HsType] -> HsType
+mkHsTyFun = foldr1 HsTyFun
hunk ./src/Context/ContextBuilder.hs 200
-mkHsAsst :: Hs.Name -> [Hs.Name] -> Hs.Asst
-mkHsAsst ctor args = Hs.ClassA (Hs.UnQual ctor) (map Hs.TyVar args)
+mkHsAsst :: HsName -> [HsName] -> HsAsst
+mkHsAsst ctor args = (UnQual ctor, map HsTyVar args)
hunk ./src/Context/ContextBuilder.hs 203
-unBang :: Hs.BangType -> Hs.Type
+unBang :: HsBangType -> HsType
hunk ./src/Context/ContextBuilder.hs 205
-            (Hs.BangedTy t) -> t 
-            (Hs.UnBangedTy t) -> t
-            (Hs.UnpackedTy t) -> t
+            (HsBangedTy t) -> t 
+            (HsUnBangedTy t) -> t
hunk ./src/Context/ContextBuilder.hs 208
-mkForallT :: [Hs.Asst] -> Type -> Type
+mkForallT :: [HsAsst] -> Type -> Type
hunk ./src/Context/ContextBuilder.hs 212
-    getVName (Hs.ClassA _ tys) = map (\(Hs.TyVar n) -> toName n) tys             
+    getVName = map (\(HsTyVar n) -> toName n) . snd             
hunk ./src/Context/ContextBuilder.hs 437
-instance ToName Hs.Name where
-  toName (Hs.Ident s) -- = toName s
+instance ToName HsName where
+  toName (HsIdent s) -- = toName s
hunk ./src/Context/ContextBuilder.hs 450
-  toName (Hs.Symbol s) = toName s
+  toName (HsSymbol s) = toName s
hunk ./src/Context/ContextBuilder.hs 452
-instance ToName Hs.Module where
-  toName (Hs.Module _ (Hs.ModuleName s) _ _ _ _ _) = toName s
+instance ToName HsModule where
+  toName (HsModule _ (Module m) _ _ _) = toName m
hunk ./src/Context/ContextBuilder.hs 456
-instance ToName Hs.SpecialCon where
-  toName Hs.UnitCon = '()
-  toName Hs.ListCon = '[]
-  toName Hs.FunCon  = ''(->)
-  toName (Hs.TupleCon n)
+instance ToName HsSpecialCon where
+  toName HsUnitCon = '()
+  toName HsListCon = '[]
+  toName HsFunCon  = ''(->)
+  toName (HsTupleCon n)
hunk ./src/Context/ContextBuilder.hs 465
-  toName Hs.Cons    = '(:)
+  toName HsCons    = '(:)
hunk ./src/Context/ContextBuilder.hs 468
-instance ToName Hs.QName where
---  toName (Hs.Qual (Hs.Module []) n) = toName n
-  toName (Hs.Qual (Hs.ModuleName []) n) = toName n
-  toName (Hs.Qual (Hs.ModuleName m) n) =
+instance ToName HsQName where
+--  toName (HsQual (HsModule []) n) = toName n
+  toName (Qual (Module "") n) = toName n
+  toName (Qual (Module m) n) =
hunk ./src/Context/ContextBuilder.hs 475
-  toName (Hs.UnQual n) = toName n
-  toName (Hs.Special s) = toName s
+  toName (UnQual n) = toName n
+  toName (Special s) = toName s
hunk ./src/Context/ContextBuilder.hs 485
-instance ToLit Hs.Literal where
-  toLit (Hs.Char a) = CharL a
-  toLit (Hs.String a) = StringL a
-  toLit (Hs.Int a) = IntegerL a
-  toLit (Hs.Frac a) = RationalL a
-  toLit (Hs.PrimChar a) = CharL a      -- XXX
-  toLit (Hs.PrimString a) = StringL a  -- XXX
-  toLit (Hs.PrimInt a) = IntPrimL a
-  toLit (Hs.PrimFloat a) = FloatPrimL a
-  toLit (Hs.PrimDouble a) = DoublePrimL a
+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
hunk ./src/Context/ContextBuilder.hs 502
-instance ToPat Hs.Pat where
-  toPat (Hs.PVar n)
+instance ToPat HsPat where
+  toPat (HsPVar n)
hunk ./src/Context/ContextBuilder.hs 505
-  toPat (Hs.PLit l)
+  toPat (HsPLit l)
hunk ./src/Context/ContextBuilder.hs 507
-{-
-ghci> parseHsPat "-2"
-Right (HsPParen (HsPNeg (HsPLit (HsInt 2))))
--}
-  toPat (Hs.PNeg p) = error "toPat: HsPNeg not supported"
-  toPat (Hs.PInfixApp p n q)= InfixP (toPat p) (toName n) (toPat q)
-  toPat (Hs.PApp n ps) = ConP (toName n) (fmap toPat ps)
-  toPat (Hs.PTuple ps) = TupP (fmap toPat ps)
-  toPat (Hs.PList ps) = ListP (fmap toPat ps)
-  toPat (Hs.PParen p) = toPat p
-  toPat (Hs.PRec n pfs) = let toFieldPat (Hs.PFieldPat n p) = (toName n, toPat p)
+  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)
hunk ./src/Context/ContextBuilder.hs 515
-  toPat (Hs.PAsPat n p) = AsP (toName n) (toPat p)
-  toPat (Hs.PWildCard) = WildP
-  toPat (Hs.PIrrPat p) = TildeP (toPat p)
-  toPat (Hs.PatTypeSig _ p t) = SigP (toPat p) (toType t)
-  toPat (Hs.PRPat rps) = error "toPat: HsRPat not supported"
-  toPat (Hs.PXTag _ _ _ pM p) = error "toPat: HsPXTag not supported"
-  toPat (Hs.PXETag _ _ _ pM) = error "toPat: HsPXETag not supported"
-  toPat (Hs.PXPcdata _) = error "toPat: HsPXPcdata not supported"
-  toPat (Hs.PXPatTag p) = error "toPat: HsPXPatTag not supported"
+  toPat (HsPAsPat n p) = AsP (toName n) (toPat p)
+  toPat (HsPWildCard) = WildP
+  toPat (HsPIrrPat p) = TildeP (toPat p)
+
hunk ./src/Context/ContextBuilder.hs 524
-instance ToExp Hs.QOp where
-  toExp (Hs.QVarOp n) = VarE (toName n)
-  toExp (Hs.QConOp n) = ConE (toName n)
+instance ToExp HsQOp where
+  toExp (HsQVarOp n) = VarE (toName n)
+  toExp (HsQConOp n) = ConE (toName n)
hunk ./src/Context/ContextBuilder.hs 528
-toFieldExp :: Hs.FieldUpdate -> FieldExp
-toFieldExp (Hs.FieldUpdate n e) = (toName n, toExp e)
+toFieldExp :: HsFieldUpdate -> FieldExp
+toFieldExp (HsFieldUpdate n e) = (toName n, toExp e)
hunk ./src/Context/ContextBuilder.hs 533
-instance ToExp Hs.Exp where
+instance ToExp HsExp where
hunk ./src/Context/ContextBuilder.hs 548
-  toExp (Hs.Var n)                 = VarE (toName n)
-  toExp (Hs.Con n)                 = ConE (toName n)
-  toExp (Hs.Lit l)                 = LitE (toLit l)
+  toExp (HsVar n)                 = VarE (toName n)
+  toExp (HsCon n)                 = ConE (toName n)
+  toExp (HsLit l)                 = LitE (toLit l)
hunk ./src/Context/ContextBuilder.hs 553
-Hs.InfixApp is left assocative
+HsInfixApp is left assocative
hunk ./src/Context/ContextBuilder.hs 560
-  toExp (Hs.InfixApp e o f)        = toRightAssoc (mkInfix o (toExp f)) e
+  toExp (HsInfixApp e o f)        = toRightAssoc (mkInfix o (toExp f)) e
hunk ./src/Context/ContextBuilder.hs 562
-    toRightAssoc done (Hs.InfixApp e o f) = toRightAssoc (mkInfix o (done . toExp $ f) ) e
+    toRightAssoc done (HsInfixApp e o f) = toRightAssoc (mkInfix o (done . toExp $ f) ) e
hunk ./src/Context/ContextBuilder.hs 566
-  toExp (Hs.LeftSection e o)       = InfixE (Just . toExp $ e) (toExp o) Nothing
-  toExp (Hs.RightSection o f)      = InfixE Nothing (toExp o) (Just . toExp $ f)
-  toExp (Hs.App e f)               = AppE (toExp e) (toExp f)
-  toExp (Hs.NegApp e)              = AppE (VarE 'negate) (toExp e)
-  toExp (Hs.Lambda _ ps e)         = LamE (fmap toPat ps) (toExp e)
-  toExp (Hs.Let bs e)              = LetE (hsBindsToDecs bs) (toExp e)
+  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 (toDec bs) (toExp e)
hunk ./src/Context/ContextBuilder.hs 573
-  toExp (Hs.If a b c)              = CondE (toExp a) (toExp b) (toExp c)
+  toExp (HsIf a b c)              = CondE (toExp a) (toExp b) (toExp c)
hunk ./src/Context/ContextBuilder.hs 577
-  toExp (Hs.Tuple xs)              = TupE (fmap toExp xs)
-  toExp (Hs.List xs)               = ListE (fmap toExp xs)
-  toExp (Hs.Paren e)               = toExp e
-  toExp (Hs.RecConstr n xs)        = RecConE (toName n) (fmap toFieldExp xs)
-  toExp (Hs.RecUpdate e xs)        = RecUpdE (toExp e) (fmap toFieldExp xs)
-  toExp (Hs.EnumFrom e)            = ArithSeqE $ FromR (toExp e)
-  toExp (Hs.EnumFromTo e f)        = ArithSeqE $ FromToR (toExp e) (toExp f)
-  toExp (Hs.EnumFromThen e f)      = ArithSeqE $ FromThenR (toExp e) (toExp f)
-  toExp (Hs.EnumFromThenTo e f g)  = ArithSeqE $ FromThenToR (toExp e) (toExp f) (toExp g)
-  toExp (Hs.ExpTypeSig _ e t)      = SigE (toExp e) (toType t)
+  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)
hunk ./src/Context/ContextBuilder.hs 590
-  toExp a@(Hs.ListComp 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 (Hs.SpliceExp spl) = toExp spl
+  toExp a@(HsListComp e ss)       = error $ errorMsg "toExp" a
hunk ./src/Context/ContextBuilder.hs 594
-instance ToExp Hs.Splice where
-  toExp (Hs.IdSplice s) = VarE (toName s)
-  toExp (Hs.ParenSplice e) = toExp e
-
hunk ./src/Context/ContextBuilder.hs 629
-instance ToLoc Hs.SrcLoc where
-  toLoc (Hs.SrcLoc fn l c) =
+instance ToLoc SrcLoc where
+  toLoc (SrcLoc fn l c) =
hunk ./src/Context/ContextBuilder.hs 637
-instance ToName Hs.TyVarBind where
-  toName (Hs.KindedVar n _) = toName n
-  toName (Hs.UnkindedVar n) = toName n
hunk ./src/Context/ContextBuilder.hs 645
-instance ToType Hs.Type where
-  toType (Hs.TyForall tvbM cxt t) = fixType $ ForallT (maybe [] (fmap toName) tvbM) (fmap toType cxt) (toType t)
-  toType (Hs.TyFun a b) = toType a .->. toType b
-  toType (Hs.TyTuple _ ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)
-  toType (Hs.TyApp a b) = fixType $ AppT (toType a) (toType b)
-  toType (Hs.TyVar n) = VarT (toName n)
-  toType (Hs.TyCon qn) = ConT (toName qn)
-  toType a@(Hs.TyPred _) = error $ errorMsg "toType" a
+instance ToType HsType where
+  toType (HsTyFun a b) = toType a .->. toType b
+  toType (HsTyTuple ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)
+  toType (HsTyApp a b) = fixType $ AppT (toType a) (toType b)
+  toType (HsTyVar n) = VarT (toName n)
+  toType (HsTyCon qn) = ConT (toName qn)
+--  toType a@(HsTyPred _) = error $ errorMsg "toType" a
hunk ./src/Context/ContextBuilder.hs 654
-  toType (Hs.TyInfix a qn b) = foldAppT (ConT . toName $ qn) (fmap toType [a,b])
-  toType (Hs.TyKind t _) = toType t
+--  toType (HsTyInfix a qn b) = foldAppT (ConT . toName $ qn) (fmap toType [a,b])
+--  toType (HsTyKind t _) = toType t
+
+instance ToType HsQualType where
+   toType (HsQualType cxt t) = fixType $ ForallT [] (fmap toType cxt) (toType t)
+
hunk ./src/Context/ContextBuilder.hs 669
-instance ToType Hs.Asst where
-  toType (Hs.ClassA n ts) = foldAppT (ConT . toName $ n) (fmap toType ts)
-  toType a@(Hs.IParam _ _) = error $ errorMsg "toType" a
-  toType a@(Hs.EqualP _ _) = error $ errorMsg "toType" a
+instance ToType HsAsst where
+  toType (n,ts) = foldAppT (ConT . toName $ n) (fmap toType ts)
+--  toType a@(HsIParam _ _) = error $ errorMsg "toType" a
+--  toType a@(HsEqualP _ _) = error $ errorMsg "toType" a
hunk ./src/Context/ContextBuilder.hs 681
-instance ToStmt Hs.Stmt where
-  toStmt (Hs.Generator _ p e)  = BindS (toPat p) (toExp e)
-  toStmt (Hs.Qualifier e)      = NoBindS (toExp e)
-  toStmt a@(Hs.LetStmt bnds)   = LetS (hsBindsToDecs bnds)
+instance ToStmt HsStmt where
+  toStmt (HsGenerator _ p e)  = BindS (toPat p) (toExp e)
+  toStmt (HsQualifier e)      = NoBindS (toExp e)
+  toStmt a@(HsLetStmt bnds)   = LetS (toDec bnds)
hunk ./src/Context/ContextBuilder.hs 692
-hsBindsToDecs :: Hs.Binds -> [Dec]
-hsBindsToDecs (Hs.BDecls ds) = concatMap toDec ds
-hsBindsToDecs a@(Hs.IPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a
+--hsBindsToDecs :: HsBinds -> [Dec]
+--hsBindsToDecs (HsBDecls ds) = concatMap toDec ds
+--hsBindsToDecs a@(HsIPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a
hunk ./src/Context/ContextBuilder.hs 698
-hsBangTypeToStrictType :: Hs.BangType -> (Strict, Type)
-hsBangTypeToStrictType (Hs.BangedTy t)   = (IsStrict, toType t)
-hsBangTypeToStrictType (Hs.UnBangedTy t) = (NotStrict, toType t)
+hsBangTypeToStrictType :: HsBangType -> (Strict, Type)
+hsBangTypeToStrictType (HsBangedTy t)   = (IsStrict, toType t)
+hsBangTypeToStrictType (HsUnBangedTy t) = (NotStrict, toType t)
hunk ./src/Context/ContextBuilder.hs 717
-instance ToDec Hs.Decl where
-  toDec (Hs.TypeDecl _ n ns t) = [TySynD (toName n) (fmap toName ns) (toType t)]
-  toDec a@(Hs.DataDecl  _ dOrN cxt n ns qcds qns) = error $ errorMsg "toDec" a
+instance ToDec HsDecl where
+  toDec (HsTypeDecl _ n ns t) = [TySynD (toName n) (fmap toName ns) (toType t)]
+  toDec a@(HsDataDecl  _ cxt n ns qcds qns) = error $ errorMsg "toDec" a
hunk ./src/Context/ContextBuilder.hs 734
-  toDec a@(Hs.GDataDecl _ dOrN cxt n ns kM gadtDecs _) = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeFamDecl _ n ns kM)                   = error $ errorMsg "toDec" a
-  toDec a@(Hs.DataFamDecl _ cxt n ns kM)               = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeInsDecl _ ta tb)                     = error $ errorMsg "toDec" a
-  toDec a@(Hs.DataInsDecl _ dOrN t qcds qns)           = error $ errorMsg "toDec" a
-  toDec a@(Hs.GDataInsDecl _ dOrN t kM gadtDecs _)     = error $ errorMsg "toDec" a
+--  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
hunk ./src/Context/ContextBuilder.hs 741
-  toDec a@(Hs.InfixDecl _ asst i ops)                  = error $ errorMsg "toDec" a
-  toDec a@(Hs.ClassDecl _ cxt n ns funDeps cDecs)      = error $ errorMsg "toDec" a
-  toDec a@(Hs.InstDecl _ cxt qn ts instDecs)           = error $ errorMsg "toDec" a
-  toDec a@(Hs.DerivDecl _ cxt qn ts)                   = error $ errorMsg "toDec" a  
-  toDec a@(Hs.DefaultDecl _ ts)                        = error $ errorMsg "toDec" a
-  toDec a@(Hs.SpliceDecl _ s)                          = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeSig _ ns t)                          = [SigD (toName n) (toType t) | n <- ns]
+  toDec a@(HsInfixDecl _ asst i ops)                  = error $ errorMsg "toDec" a
+  toDec a@(HsClassDecl _ _ _ _ _)                     = 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)                          = [SigD (toName n) (toType t) | n <- ns]
hunk ./src/Context/ContextBuilder.hs 752
-  toDec a@(Hs.FunBind mtchs)                           = [hsMatchesToFunD mtchs]
+  toDec a@(HsFunBind mtchs)                           = [hsMatchesToFunD mtchs]
hunk ./src/Context/ContextBuilder.hs 757
-  toDec (Hs.PatBind _ p tM rhs bnds)                   = [ValD ((maybe id
-                                                                      (flip SigP . toType)
-                                                                      tM) (toPat p))
-                                                              (hsRhsToBody rhs)
-                                                              (hsBindsToDecs bnds)]
-  toDec a@(Hs.ForImp _ cconv safe str n t)             = error $ errorMsg "toDec" a
-  toDec a@(Hs.ForExp _ cconv      str n t)             = error $ errorMsg "toDec" a
+  toDec (HsPatBind _ p rhs bnds)                   = [ValD ((toPat p))
+                                                            (hsRhsToBody rhs)
+                                                            (toDec bnds)]
+--  toDec a@(HsForImp _ cconv safe str n t)             = error $ errorMsg "toDec" a
+--  toDec a@(HsForExp _ cconv      str n t)             = error $ errorMsg "toDec" a
hunk ./src/Context/ContextBuilder.hs 763
+instance ToDec [HsDecl] where
+    toDec = concatMap toDec
hunk ./src/Context/ContextBuilder.hs 767
-hsMatchesToFunD :: [Hs.Match] -> Dec
+hsMatchesToFunD :: [HsMatch] -> Dec
hunk ./src/Context/ContextBuilder.hs 769
-hsMatchesToFunD xs@(Hs.Match _ n _ _ _ _:_) = FunD (toName n) (fmap hsMatchToClause xs)
+hsMatchesToFunD xs@(HsMatch _ n _ _ _:_) = FunD (toName n) (fmap hsMatchToClause xs)
hunk ./src/Context/ContextBuilder.hs 772
-hsMatchToClause :: Hs.Match -> Clause
-hsMatchToClause (Hs.Match _ _ ps _ rhs bnds) = Clause
+hsMatchToClause :: HsMatch -> Clause
+hsMatchToClause (HsMatch _ _ ps rhs bnds) = Clause
hunk ./src/Context/ContextBuilder.hs 776
-                                                (hsBindsToDecs bnds)
+                                                (toDec bnds)
hunk ./src/Context/ContextBuilder.hs 784
-hsRhsToBody :: Hs.Rhs -> Body
-hsRhsToBody (Hs.UnGuardedRhs e) = NormalB (toExp e)
-hsRhsToBody (Hs.GuardedRhss hsgrhs) = let fromGuardedB (GuardedB a) = a
+hsRhsToBody :: HsRhs -> Body
+hsRhsToBody (HsUnGuardedRhs e) = NormalB (toExp e)
+hsRhsToBody (HsGuardedRhss hsgrhs) = let fromGuardedB (GuardedB a) = a
hunk ./src/Context/ContextBuilder.hs 793
-hsGuardedRhsToBody :: Hs.GuardedRhs -> Body
-hsGuardedRhsToBody (Hs.GuardedRhs _ [] e)  = NormalB (toExp e)
-hsGuardedRhsToBody (Hs.GuardedRhs _ [s] e) = GuardedB [(hsStmtToGuard s, toExp e)]
-hsGuardedRhsToBody (Hs.GuardedRhs _ 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')
+hsGuardedRhsToBody :: HsGuardedRhs -> Body
+--hsGuardedRhsToBody (HsGuardedRhs _ [] e)  = NormalB (toExp e)
+hsGuardedRhsToBody (HsGuardedRhs _ s e) = GuardedB [(NormalG (toExp 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')
hunk ./src/Context/ContextBuilder.hs 804
-hsStmtToGuard :: Hs.Stmt -> Guard
-hsStmtToGuard (Hs.Generator _ p e) = PatG [BindS (toPat p) (toExp e)]
-hsStmtToGuard (Hs.Qualifier e)     = NormalG (toExp e)
-hsStmtToGuard a@(Hs.LetStmt _)     = error $ errorMsg "hsStmtToGuardExp" a
+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
hunk ./src/Language/Haskell/Meta/Parse.hs 1
-
-{- |
-  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 where
-
-
-import Language.Haskell.TH.Syntax
-import Language.Haskell.Meta.Syntax
-import qualified Language.Haskell.Exts.Syntax as Hs
-import Language.Haskell.Exts.Parser
-import Language.Haskell.Exts.Pretty
-
-
------------------------------------------------------------------------------
-
--- * template-haskell
-
-parsePat :: String -> Either String Pat
-parsePat = either Left (Right . toPat) . parseHsPat
-
-parseExp :: String -> Either String Exp
-parseExp = either Left (Right . toExp) . parseHsExp
-
-parseType :: String -> Either String Type
-parseType = either Left (Right . toType) . parseHsType
-
-parseDecs :: String -> Either String [Dec]
-parseDecs  = either Left (Right . concatMap toDec) . parseHsDecls
-
-
------------------------------------------------------------------------------
-
--- * haskell-src-exts
-
-parseFile :: FilePath -> IO (ParseResult Hs.Module)
-parseFile fp = readFile fp >>= (return . parseFileContentsWithMode (ParseMode fp))
-
-
-parseFileContents :: String -> ParseResult Hs.Module
-parseFileContents = parseFileContentsWithMode defaultParseMode
-
-
-parseFileContentsWithMode :: ParseMode -> String -> ParseResult Hs.Module
-parseFileContentsWithMode p rawStr = parseModuleWithMode p (unlines $ map f $ lines rawStr)
-  where f ('#':_) = ""
-        f x = x
-
-
------------------------------------------------------------------------------
-
-
-parseHsModule :: String -> Either String Hs.Module
-parseHsModule s =
-  case parseModule s of
-    ParseOk m -> Right m
-    ParseFailed loc e ->
-      let line = Hs.srcLine loc - 1
-      in Left (unlines [show line,show loc,e])
-
-
-parseHsDecls :: String -> Either String [Hs.Decl]
-parseHsDecls s =
-  let s' = unlines [pprHsModule (emptyHsModule "Main"), s]
-  in case parseModule s' of
-      ParseOk m -> Right (moduleDecls m)
-      ParseFailed loc e ->
-        let line = Hs.srcLine loc - 1
-        in Left (unlines [show line,show loc,e])
-
-
-parseHsType :: String -> Either String Hs.Type
-parseHsType s =
-  case parseHsDecls ("zomg::\n" ++ (unlines
-                      . fmap ("  "++) . lines $ s ++"\n  =()")) of
-    Left err -> Left err
-    Right xs ->
-      case [ t | Hs.PatBind _ _ (Just t) _ _ <- xs] of
-        []    -> Left "invalid type"
-        (t:_) -> Right t
-
-
-parseHsExp :: String -> Either String Hs.Exp
-parseHsExp s =
-  case parseHsDecls ("main =\n" ++ (unlines . fmap ("  "++) . lines $ s)) of
-    Left err -> Left err
-    Right xs ->
-      case [ e | Hs.PatBind _ _ _ (Hs.UnGuardedRhs e) _ <- xs] of
-        []    -> Left "invalid expression"
-        (e:_) -> Right e
-
-
-parseHsPat :: String -> Either String Hs.Pat
-parseHsPat s =
-  case parseHsDecls ("("++(filter (/='\n') s)++")=()") of
-    Left err -> Left err
-    Right xs ->
-      case [ p | Hs.PatBind _ p _ _ _ <- xs] of
-        []    -> Left "invalid pattern"
-        (p:_) -> Right p
-
-
-pprHsModule :: Hs.Module -> String
-pprHsModule = prettyPrint
-
-
-moduleDecls :: Hs.Module -> [Hs.Decl]
-moduleDecls (Hs.Module _ _ _ _ _ _ x) = x
-
-
--- mkModule :: String -> Hs.Module
--- mkModule s = Hs.Module undefined (Hs.ModuleName s) Nothing [] []
-
-
-emptySrcLoc :: Hs.SrcLoc
-emptySrcLoc = (Hs.SrcLoc [] 0 0)
-
-
-emptyHsModule :: String -> Hs.Module
-emptyHsModule n =
-    (Hs.Module
-        emptySrcLoc
-        (Hs.ModuleName n)
-        []
-        Nothing
-        Nothing
-        []
-        [])
-
-{-
-ghci> :i Module
-data Module
-  = Module SrcLoc
-           ModuleName
-           [OptionPragma]
-           (Maybe WarningText)
-           (Maybe [ExportSpec])
-           [ImportDecl]
-           [Decl]
-        -- Defined in Language.Haskell.Exts.Syntax
-instance Show Module -- Defined in Language.Haskell.Exts.Syntax
--}
-
------------------------------------------------------------------------------
rmfile ./src/Language/Haskell/Meta/Parse.hs
hunk ./src/Language/Haskell/Meta/Syntax/Translate.hs 1
-{-# LANGUAGE TemplateHaskell, TypeSynonymInstances #-}
-
-{- |
-  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', nub)
-import Language.Haskell.TH.Syntax
-import qualified Language.Haskell.Exts.Syntax as Hs
-
-import Syntax.Types ( fixType)
-
------------------------------------------------------------------------------
-
-
-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 Hs.Name where
-  toName (Hs.Ident s) = toName s
-  toName (Hs.Symbol s) = toName s
-
-instance ToName Hs.Module where
-  toName (Hs.Module _ (Hs.ModuleName s) _ _ _ _ _) = toName s
-
-
-instance ToName Hs.SpecialCon where
-  toName Hs.UnitCon = '()
-  toName Hs.ListCon = '[]
-  toName Hs.FunCon  = ''(->)
-  toName (Hs.TupleCon n)
-    | n<2 = '()
-    | otherwise =
-      let x = maybe [] (++".") (nameModule '())
-      in toName . concat $ x : ["(",replicate (n-1) ',',")"]
-  toName Hs.Cons    = '(:)
-
-
-instance ToName Hs.QName where
---  toName (Hs.Qual (Hs.Module []) n) = toName n
-  toName (Hs.Qual (Hs.ModuleName []) n) = toName n
-  toName (Hs.Qual (Hs.ModuleName m) n) =
-    let m' = show . toName $ m
-        n' = show . toName $ n
-    in toName . concat $ [m',".",n']
-  toName (Hs.UnQual n) = toName n
-  toName (Hs.Special s) = toName s
-
-
-
------------------------------------------------------------------------------
-
--- * ToLit HsLiteral
-
-
-instance ToLit Hs.Literal where
-  toLit (Hs.Char a) = CharL a
-  toLit (Hs.String a) = StringL a
-  toLit (Hs.Int a) = IntegerL a
-  toLit (Hs.Frac a) = RationalL a
-  toLit (Hs.PrimChar a) = CharL a      -- XXX
-  toLit (Hs.PrimString a) = StringL a  -- XXX
-  toLit (Hs.PrimInt a) = IntPrimL a
-  toLit (Hs.PrimFloat a) = FloatPrimL a
-  toLit (Hs.PrimDouble a) = DoublePrimL a
-
-
------------------------------------------------------------------------------
-
--- * ToPat HsPat
-
-
-instance ToPat Hs.Pat where
-  toPat (Hs.PVar n)
-    = VarP (toName n)
-  toPat (Hs.PLit l)
-    = LitP (toLit l)
-{-
-ghci> parseHsPat "-2"
-Right (HsPParen (HsPNeg (HsPLit (HsInt 2))))
--}
-  toPat (Hs.PNeg p) = error "toPat: HsPNeg not supported"
-  toPat (Hs.PInfixApp p n q)= InfixP (toPat p) (toName n) (toPat q)
-  toPat (Hs.PApp n ps) = ConP (toName n) (fmap toPat ps)
-  toPat (Hs.PTuple ps) = TupP (fmap toPat ps)
-  toPat (Hs.PList ps) = ListP (fmap toPat ps)
-  toPat (Hs.PParen p) = toPat p
-  toPat (Hs.PRec n pfs) = let toFieldPat (Hs.PFieldPat n p) = (toName n, toPat p)
-                          in RecP (toName n) (fmap toFieldPat pfs)
-  toPat (Hs.PAsPat n p) = AsP (toName n) (toPat p)
-  toPat (Hs.PWildCard) = WildP
-  toPat (Hs.PIrrPat p) = TildeP (toPat p)
-  toPat (Hs.PatTypeSig _ p t) = SigP (toPat p) (toType t)
-  toPat (Hs.PRPat rps) = error "toPat: HsRPat not supported"
-  toPat (Hs.PXTag _ _ _ pM p) = error "toPat: HsPXTag not supported"
-  toPat (Hs.PXETag _ _ _ pM) = error "toPat: HsPXETag not supported"
-  toPat (Hs.PXPcdata _) = error "toPat: HsPXPcdata not supported"
-  toPat (Hs.PXPatTag p) = error "toPat: HsPXPatTag not supported"
-
------------------------------------------------------------------------------
-
--- * ToExp HsExp
-
-instance ToExp Hs.QOp where
-  toExp (Hs.QVarOp n) = VarE (toName n)
-  toExp (Hs.QConOp n) = ConE (toName n)
-
-toFieldExp :: Hs.FieldUpdate -> FieldExp
-toFieldExp (Hs.FieldUpdate n e) = (toName n, toExp e)
-
-
-
-instance ToExp Hs.Exp 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 (Hs.Var n)                 = VarE (toName n)
-  toExp (Hs.Con n)                 = ConE (toName n)
-  toExp (Hs.Lit l)                 = LitE (toLit l)
-  
-{-
-Hs.InfixApp is left assocative
-(InfixApp (InfixApp (InfixApp (Lit (Int 1)) (QConOp (Special Cons)) (Lit (Int 2))) (QConOp (Special Cons)) (Lit (Int 3))) (QConOp (Special Cons)) (List []))
-
-TH.InfixE is right associativ
-InfixE (Just (LitE (IntegerL 1))) (ConE GHC.Types.:) (Just (InfixE (Just (LitE (IntegerL 2))) (ConE GHC.Types.:) (Just (InfixE (Just (LitE (IntegerL 3))) (ConE GHC.Types.:) (Just (ConE GHC.Types.[]))))))
-
--}  
-  toExp (Hs.InfixApp e o f)        = toRightAssoc (mkInfix o (toExp f)) e
-    where
-    toRightAssoc done (Hs.InfixApp e o f) = toRightAssoc (mkInfix o (done . toExp $ f) ) e
-    toRightAssoc done e = done (toExp e)
-    mkInfix = (\o r l  -> InfixE (Just l) (toExp o) (Just r))
-  --InfixE (Just . toExp $ e) (toExp o) (Just . toExp $ f)
-  toExp (Hs.LeftSection e o)       = InfixE (Just . toExp $ e) (toExp o) Nothing
-  toExp (Hs.RightSection o f)      = InfixE Nothing (toExp o) (Just . toExp $ f)
-  toExp (Hs.App e f)               = AppE (toExp e) (toExp f)
-  toExp (Hs.NegApp e)              = AppE (VarE 'negate) (toExp e)
-  toExp (Hs.Lambda _ ps e)         = LamE (fmap toPat ps) (toExp e)
-  toExp (Hs.Let bs e)              = LetE (hsBindsToDecs bs) (toExp e)
-  -- toExp (HsWith e bs
-  toExp (Hs.If a b c)              = CondE (toExp a) (toExp b) (toExp c)
-  -- toExp (HsCase e xs)
-  -- toExp (HsDo ss)
-  -- toExp (HsMDo ss)
-  toExp (Hs.Tuple xs)              = TupE (fmap toExp xs)
-  toExp (Hs.List xs)               = ListE (fmap toExp xs)
-  toExp (Hs.Paren e)               = toExp e
-  toExp (Hs.RecConstr n xs)        = RecConE (toName n) (fmap toFieldExp xs)
-  toExp (Hs.RecUpdate e xs)        = RecUpdE (toExp e) (fmap toFieldExp xs)
-  toExp (Hs.EnumFrom e)            = ArithSeqE $ FromR (toExp e)
-  toExp (Hs.EnumFromTo e f)        = ArithSeqE $ FromToR (toExp e) (toExp f)
-  toExp (Hs.EnumFromThen e f)      = ArithSeqE $ FromThenR (toExp e) (toExp f)
-  toExp (Hs.EnumFromThenTo e f g)  = ArithSeqE $ FromThenToR (toExp e) (toExp f) (toExp g)
-  toExp (Hs.ExpTypeSig _ e t)      = SigE (toExp e) (toType t)
-  --  HsListComp HsExp [HsStmt]
-  -- toExp (HsListComp e ss) = CompE 
-  -- NEED: a way to go e -> Stmt
-  toExp a@(Hs.ListComp 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 (Hs.SpliceExp spl) = toExp spl
-  toExp e = error $ errorMsg "toExp" e
-
-
-instance ToExp Hs.Splice where
-  toExp (Hs.IdSplice s) = VarE (toName s)
-  toExp (Hs.ParenSplice 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 Hs.SrcLoc where
-  toLoc (Hs.SrcLoc fn l c) =
-    Loc fn [] [] (l,c) (-1,-1)
-
------------------------------------------------------------------------------
-
--- * ToType HsType
-
-instance ToName Hs.TyVarBind where
-  toName (Hs.KindedVar n _) = toName n
-  toName (Hs.UnkindedVar n) = toName n
-
-{- |
-TH does't handle
-  * unboxed tuples
-  * implicit params
-  * infix type constructors
-  * kind signatures
--}
-instance ToType Hs.Type where
-  toType (Hs.TyForall tvbM cxt t) = fixType $ ForallT (maybe [] (fmap toName) tvbM) (fmap toType cxt) (toType t)
-  toType (Hs.TyFun a b) = toType a .->. toType b
-  toType (Hs.TyTuple _ ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)
-  toType (Hs.TyApp a b) = fixType $ AppT (toType a) (toType b)
-  toType (Hs.TyVar n) = VarT (toName n)
-  toType (Hs.TyCon qn) = ConT (toName qn)
-  toType a@(Hs.TyPred _) = error $ errorMsg "toType" a
-
-  -- XXX: need to wrap the name in parens!
-  toType (Hs.TyInfix a qn b) = foldAppT (ConT . toName $ qn) (fmap toType [a,b])
-  toType (Hs.TyKind t _) = toType t
-
-(.->.) :: Type -> Type -> Type
-a .->. b = AppT (AppT ArrowT a) b
-
-{- |
-TH doesn't handle:
-  * implicit params
-  * equality constraints
--}
-instance ToType Hs.Asst where
-  toType (Hs.ClassA n ts) = foldAppT (ConT . toName $ n) (fmap toType ts)
-  toType a@(Hs.IParam _ _) = error $ errorMsg "toType" a
-  toType a@(Hs.EqualP _ _) = error $ errorMsg "toType" a
-
-foldAppT :: Type -> [Type] -> Type
-foldAppT t ts = foldl' AppT t ts
-
------------------------------------------------------------------------------
-
--- * ToStmt HsStmt
-
-instance ToStmt Hs.Stmt where
-  toStmt (Hs.Generator _ p e)  = BindS (toPat p) (toExp e)
-  toStmt (Hs.Qualifier e)      = NoBindS (toExp e)
-  toStmt a@(Hs.LetStmt bnds)   = LetS (hsBindsToDecs bnds)
-
-
------------------------------------------------------------------------------
-
--- * ToDec HsDecl
-
--- data HsBinds = HsBDecls [HsDecl] | HsIPBinds [HsIPBind]
-hsBindsToDecs :: Hs.Binds -> [Dec]
-hsBindsToDecs (Hs.BDecls ds) = concatMap toDec ds
-hsBindsToDecs a@(Hs.IPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a
--- data HsIPBind = HsIPBind SrcLoc HsIPName HsExp
-
-
-hsBangTypeToStrictType :: Hs.BangType -> (Strict, Type)
-hsBangTypeToStrictType (Hs.BangedTy t)   = (IsStrict, toType t)
-hsBangTypeToStrictType (Hs.UnBangedTy 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 Hs.Decl where
-  toDec (Hs.TypeDecl _ n ns t) = [TySynD (toName n) (fmap toName ns) (toType t)]
-  toDec a@(Hs.DataDecl  _ 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@(Hs.GDataDecl _ dOrN cxt n ns kM gadtDecs _) = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeFamDecl _ n ns kM)                   = error $ errorMsg "toDec" a
-  toDec a@(Hs.DataFamDecl _ cxt n ns kM)               = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeInsDecl _ ta tb)                     = error $ errorMsg "toDec" a
-  toDec a@(Hs.DataInsDecl _ dOrN t qcds qns)           = error $ errorMsg "toDec" a
-  toDec a@(Hs.GDataInsDecl _ dOrN t kM gadtDecs _)     = error $ errorMsg "toDec" a
--- data HsOp = HsVarOp HsName | HsConOp HsName
-  toDec a@(Hs.InfixDecl _ asst i ops)                  = error $ errorMsg "toDec" a
-  toDec a@(Hs.ClassDecl _ cxt n ns funDeps cDecs)      = error $ errorMsg "toDec" a
-  toDec a@(Hs.InstDecl _ cxt qn ts instDecs)           = error $ errorMsg "toDec" a
-  toDec a@(Hs.DerivDecl _ cxt qn ts)                   = error $ errorMsg "toDec" a  
-  toDec a@(Hs.DefaultDecl _ ts)                        = error $ errorMsg "toDec" a
-  toDec a@(Hs.SpliceDecl _ s)                          = error $ errorMsg "toDec" a
-  toDec a@(Hs.TypeSig _ ns t)                          = [SigD (toName n) (toType t) | n <- ns]
-{- 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@(Hs.FunBind 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 (Hs.PatBind _ p tM rhs bnds)                   = [ValD ((maybe id
-                                                                      (flip SigP . toType)
-                                                                      tM) (toPat p))
-                                                              (hsRhsToBody rhs)
-                                                              (hsBindsToDecs bnds)]
-  toDec a@(Hs.ForImp _ cconv safe str n t)             = error $ errorMsg "toDec" a
-  toDec a@(Hs.ForExp _ cconv      str n t)             = error $ errorMsg "toDec" a
-
-
-
-hsMatchesToFunD :: [Hs.Match] -> Dec
-hsMatchesToFunD [] = FunD (mkName []) []   -- errorish
-hsMatchesToFunD xs@(Hs.Match _ n _ _ _ _:_) = FunD (toName n) (fmap hsMatchToClause xs)
-
-
-hsMatchToClause :: Hs.Match -> Clause
-hsMatchToClause (Hs.Match _ _ 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 :: Hs.Rhs -> Body
-hsRhsToBody (Hs.UnGuardedRhs e) = NormalB (toExp e)
-hsRhsToBody (Hs.GuardedRhss hsgrhs) = let fromGuardedB (GuardedB a) = a
-                                      in GuardedB . concat
-                                          . fmap (fromGuardedB . hsGuardedRhsToBody)
-                                              $ hsgrhs
-
-
-
-hsGuardedRhsToBody :: Hs.GuardedRhs -> Body
-hsGuardedRhsToBody (Hs.GuardedRhs _ [] e)  = NormalB (toExp e)
-hsGuardedRhsToBody (Hs.GuardedRhs _ [s] e) = GuardedB [(hsStmtToGuard s, toExp e)]
-hsGuardedRhsToBody (Hs.GuardedRhs _ 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 :: Hs.Stmt -> Guard
-hsStmtToGuard (Hs.Generator _ p e) = PatG [BindS (toPat p) (toExp e)]
-hsStmtToGuard (Hs.Qualifier e)     = NormalG (toExp e)
-hsStmtToGuard a@(Hs.LetStmt _)     = error $ errorMsg "hsStmtToGuardExp" a
-
-
------------------------------------------------------------------------------
rmfile ./src/Language/Haskell/Meta/Syntax/Translate.hs
hunk ./src/Language/Haskell/Meta/Syntax/Vars.hs 1
-{-# 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
-
-
------------------------------------------------------------------------------
rmfile ./src/Language/Haskell/Meta/Syntax/Vars.hs
rmdir ./src/Language/Haskell/Meta/Syntax
hunk ./src/Language/Haskell/Meta/Syntax.hs 1
-
-{- |
-  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
-
-
rmfile ./src/Language/Haskell/Meta/Syntax.hs
hunk ./src/Language/Haskell/Meta/Utils.hs 1
-{-# LANGUAGE TemplateHaskell, RankNTypes, StandaloneDeriving,
-             FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
-
--- | This module is a staging ground
--- for to-be-organized-and-merged-nicely code.
-
-module Language.Haskell.Meta.Utils where
-
-import Data.Typeable
-import Data.Generics hiding(Fixity)
-import Language.Haskell.Meta
-import System.IO.Unsafe(unsafePerformIO)
-import Language.Haskell.Exts.Pretty(prettyPrint)
-import Language.Haskell.TH.Quote
-import Language.Haskell.TH.Syntax
-import Language.Haskell.TH.Lib
-import Language.Haskell.TH.Ppr
-import Text.PrettyPrint
-import Control.Monad
-
------------------------------------------------------------------------------
-
-
-cleanNames :: (Data a) => a -> a
-cleanNames = everywhere (mkT cleanName)
-  where cleanName :: Name -> Name
-        cleanName n
-          | isNameU n = n
-          | otherwise = (mkName . nameBase) n
-        isNameU :: Name -> Bool
-        isNameU (Name _ (NameU _)) = True
-        isNameU _ = False
-
-
--- | The type passed in must have a @Show@ instance which
---  produces a valid Haskell expression. Returns an empty
---  @String@ if this is not the case. This is not TH-specific,
---  but useful in general.
-pretty :: (Show a) => a -> String
-pretty a = case parseHsExp (show a) of
-            Left _ -> []
-            Right e -> prettyPrint e
-
-
-pp :: (Data a, Ppr a) => a -> String
-pp = pprint . cleanNames
-
-ppDoc :: (Data a, Ppr a) => a -> Doc
-ppDoc = text . pp
-
-
-gpretty :: (Data a) => a -> String
-gpretty = either (const []) prettyPrint . parseHsExp . gshow
-
-
-instance Show ExpQ where show = show . cleanNames . unQ
-instance Show (Q [Dec]) where show = unlines . fmap (show . cleanNames) . unQ
-instance Show DecQ where show = show . cleanNames . unQ
-instance Show TypeQ where show = show . cleanNames . unQ
-instance Show (Q String) where show = unQ
-instance Show (Q Doc) where show = show . unQ
-
-deriving instance Typeable1 Q
-deriving instance Typeable QuasiQuoter
-
-
--- | @unQ = unsafePerformIO . runQ@
-unQ :: Q a -> a
-unQ = unsafePerformIO . runQ
-
-
-nameToRawCodeStr :: Name -> String
-nameToRawCodeStr n =
-  let s = showNameParens n
-  in case nameSpaceOf n of
-      Just VarName -> "'"++s
-      Just DataName -> "'"++s
-      Just TcClsName -> "''"++s
-      _ -> concat ["(mkName \"", filter (/='"') s, "\")"]
-  where showNameParens :: Name -> String
-        showNameParens n =
-          let nb = nameBase n
-          in case nb of
-            (c:_) | isSym c -> concat ["(",nb,")"]
-            _  -> nb
-        isSym :: Char -> Bool
-        isSym = (`elem` "><.\\/!@#$%^&*-+?:|")
-
-
------------------------------------------------------------------------------
-
-
-(|$|) :: ExpQ -> ExpQ -> ExpQ
-infixr 0 |$|
-f |$| x = [|$f $x|]
-
-(|.|) :: ExpQ -> ExpQ -> ExpQ
-infixr 9 |.|
-g |.| f = [|$g . $f|]
-
-(|->|) :: TypeQ -> TypeQ -> TypeQ
-infixr 9 |->|
-a |->| b = appT (appT arrowT a) b
-
-
-
-unForall :: Type -> Type
-unForall (ForallT _ _ t) = t
-unForall t = t
-
-functionT :: [TypeQ] -> TypeQ
-functionT = foldl1 (|->|)
-
-mkVarT :: String -> TypeQ
-mkVarT = varT . mkName
-
-
-
-myNames :: [Name]
-myNames = let xs = fmap (:[]) ['a'..'z']
-              ys = iterate (join (zipWith (++))) xs
-           in fmap mkName (concat ys)
-
-
-renameTs env new acc [] = (reverse acc, env, new)
-renameTs env new acc (t:ts) =
-  let (t',env',new') = renameT env new t
-  in renameTs env' new' (t':acc) ts
-
-renameT :: [(Name, Name)] -> [Name] -> Type -> (Type, [(Name,Name)], [Name])
-renameT env (x:new) (VarT n)
- | Just n' <- lookup n env = (VarT n',env,x:new)
- | otherwise = (VarT x, (n,x):env, new) 
-renameT env new (ConT n) = (ConT ((mkName . nameBase) n), env, new)
-renameT env new t@(TupleT {}) = (t,env,new)
-renameT env new ArrowT = (ArrowT,env,new)
-renameT env new ListT = (ListT,env,new)
-renameT env new (AppT t t') = let (s,env',new') = renameT env new t
-                                  (s',env'',new'') = renameT env' new' t'
-                              in (AppT s s', env'', new'')
-renameT env new (ForallT ns cxt t) =
-  let unVarT (VarT n) = n
-      (ns',env2,new2) = renameTs env new [] (fmap VarT ns)
-      ns'' = fmap unVarT ns'
-      (cxt',env3,new3) = renameTs env2 new2 [] cxt
-      (t',env4,new4) = renameT env3 new3 t
-  in (ForallT ns'' cxt' t', env4, new4)
-
-
-
-applyT :: Type -> Type -> Type
-applyT (ForallT [] _ t) t' = t `AppT` t'
-applyT (ForallT (n:ns) cxt t) t' = ForallT ns cxt (substT [(n,t')] ns t)
-applyT t t' = t `AppT` t'
-
-
-
-substT :: [(Name, Type)] -> [Name] -> Type -> Type
-substT env bnd (ForallT ns _ t) = substT env (ns++bnd) t
-substT env bnd t@(VarT n)
-  | n `elem` bnd = t
-  | otherwise = maybe t id (lookup n env)
-substT env bnd (AppT t t') = AppT (substT env bnd t)
-                                  (substT env bnd t')
-substT _ _ t = t
-
-
-
-
-
--- | Stolen from Igloo's th-lift.
-deriveLift :: Name -> Q Dec
-deriveLift n
- = do i <- reify n
-      case i of
-        TyConI (DataD _ _ vs cons _) ->
-          let ctxt = cxt [conT ''Lift `appT` varT v | v <- vs]
-              typ = foldl appT (conT n) $ map varT vs
-              fun = funD 'lift (map doCons cons)
-          in instanceD ctxt (conT ''Lift `appT` typ) [fun]
-        _ -> error (modName ++ ".deriveLift: unhandled: " ++ pprint i)
-  where modName :: String
-        modName = "Language.Haskell.TH.Utils"
-        doCons :: Con -> Q Clause
-        doCons (NormalC c sts) = do
-          let ns = zipWith (\_ i -> "x" ++ show i) sts [0..]
-              con = [| conE c |]
-              args = [ [| lift $(varE (mkName n)) |] | n <- ns ]
-              e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con args
-          clause [conP c (map (varP . mkName) ns)] (normalB e) []
-        doCons c = error (modName ++ ".doCons: Unhandled constructor: " ++ pprint c)
-
-
-
--- | Produces pretty code suitable
---  for human consumption.
-deriveLiftPretty :: Name -> Q String
-deriveLiftPretty n = do
-  decs <- deriveLift n
-  case (parseHsDecls . pprint . cleanNames) decs of
-    Left e -> fail ("deriveLiftPretty: error while prettifying code: "++e)
-    Right hsdecs -> return (unlines . fmap prettyPrint $ hsdecs)
-
-
-
-
-splitCon :: Con -> (Name,[Type])
-splitCon c = (conName c, conTypes c)
-
-
-strictTypeTy :: StrictType -> Type
-strictTypeTy (_,t) = t
-
-varStrictTypeTy :: VarStrictType -> Type
-varStrictTypeTy (_,_,t) = t
-
-
-conTypes :: Con -> [Type]
-conTypes (NormalC _ sts) = fmap strictTypeTy sts
-conTypes (RecC    _ vts) = fmap varStrictTypeTy vts
-conTypes (InfixC t _ t') = fmap strictTypeTy [t,t']
-conTypes (ForallC _ _ c) = conTypes c
-
-
-conToConType :: Type -> Con -> Type
-conToConType ofType con = foldr (\a b -> AppT (AppT ArrowT a) b) ofType (conTypes con)
-
-
-
-decCons :: Dec -> [Con]
-decCons (DataD _ _ _ cons _) = cons
-decCons (NewtypeD _ _ _ con _) = [con]
-decCons _ = []
-
-
-decTyVars :: Dec -> [Name]
-decTyVars (DataD _ _ ns _ _) = ns
-decTyVars (NewtypeD _ _ ns _ _) = ns
-decTyVars (TySynD _ ns _) = ns
-decTyVars (ClassD _ _ ns _ _) = ns
-decTyVars _ = []
-
-
-decName :: Dec -> Maybe Name
-decName (FunD n _) = Just n
-decName (DataD _ n _ _ _) = Just n
-decName (NewtypeD _ n _ _ _) = Just n
-decName (TySynD n _ _) = Just n
-decName (ClassD _ n _ _ _) = Just n
-decName (SigD n _) = Just n
-decName (ForeignD fgn) = Just (foreignName fgn)
-decName _ = Nothing
-
-
-foreignName :: Foreign -> Name
-foreignName (ImportF _ _ _ n _) = n
-foreignName (ExportF _ _ n _) = n
-
-
-unwindT :: Type -> [Type]
-unwindT = go
-  where go :: Type -> [Type]
-        go (ForallT _ _ t) = go t
-        go (AppT (AppT ArrowT t) t') = t : go t'
-        go _ = []
-
-
-unwindE :: Exp -> [Exp]
-unwindE = go []
-  where go acc (e `AppE` e') = go (e':acc) e
-        go acc e = e:acc
-
-
--- | The arity of a Type.
-arityT :: Type -> Int
-arityT = go 0
-  where go :: Int -> Type -> Int
-        go n (ForallT _ _ t) = go n t
-        go n (AppT (AppT ArrowT _) t) =
-          let n' = n+1 in n' `seq` go n' t
-        go n _ = n
-
-typeToName :: Type -> Maybe Name
-typeToName t
-  | ConT n <- t = Just n
-  | ArrowT <- t = Just ''(->)
-  | ListT  <- t = Just ''[]
-  | TupleT n <- t = Just $ tupleTypeName n
-  | ForallT _ _ t' <- t = typeToName t'
-  | otherwise = Nothing
-
--- | Randomly useful.
-nameSpaceOf :: Name -> Maybe NameSpace
-nameSpaceOf (Name _ (NameG ns _ _)) = Just ns
-nameSpaceOf _ = Nothing
-
-conName :: Con -> Name
-conName (RecC n _) = n
-conName (NormalC n _) = n
-conName (InfixC _ n _) = n
-conName (ForallC _ _ con) = conName con
-
-recCName :: Con -> Maybe Name
-recCName (RecC n _) = Just n
-recCName _ = Nothing
-
-dataDCons :: Dec -> [Con]
-dataDCons (DataD _ _ _ cons _) = cons
-dataDCons _ = []
-
-fromDataConI :: Info -> Q (Maybe Exp)
-fromDataConI (DataConI dConN ty tyConN fxty) =
-  let n = arityT ty
-  in replicateM n (newName "a")
-      >>= \ns -> return (Just (LamE
-                    [ConP dConN (fmap VarP ns)]
-                    (TupE $ fmap VarE ns)))
-fromDataConI _ = return Nothing
-
-fromTyConI :: Info -> Maybe Dec
-fromTyConI (TyConI dec) = Just dec
-fromTyConI _ = Nothing
-
-
------------------------------------------------------------------------------
-
--- | The strategy for producing QuasiQuoters which
---  this datatype aims to facilitate is as follows.
---  Given a collection of datatypes which make up
---  the to-be-quasiquoted languages AST, make each
---  type in this collection an instance of at least
---  @Show@ and @Lift@. Now, assuming @parsePat@ and
---  @parseExp@, both of type @String -> Q a@ (where @a@
---  is the top level type of the AST), are the pair of
---  functions you wish to use for parsing in pattern and
---  expression context respectively, put them inside
---  a @Quoter@ datatype and pass this to quasify.
-data Quoter a = Quoter
-  { expQ :: (Lift a) => String -> Q a
-  , patQ :: (Show a) => String -> Q a }
-
-quasify :: (Show a, Lift a) => Quoter a -> QuasiQuoter
-quasify q = QuasiQuoter
-              (toExpQ (expQ q))
-              (toPatQ (patQ q))
-
-toExpQ :: (Lift a) => (String -> Q a) -> (String -> ExpQ)
-toExpQ parseQ = (lift =<<) . parseQ
-
-toPatQ :: (Show a) => (String -> Q a) -> (String -> PatQ)
-toPatQ parseQ = (showToPatQ =<<) . parseQ
-
-showToPatQ :: (Show a) => a -> PatQ
-showToPatQ = either fail return . parsePat . show
-
------------------------------------------------------------------------------
-
-eitherQ :: (e -> String) -> Either e a -> Q a
-eitherQ toStr = either (fail . toStr) return
-
------------------------------------------------------------------------------
-
-
-
-
-normalizeT :: (Data a) => a -> a
-normalizeT = everywhere (mkT go)
-  where go :: Type -> Type
-        go (ConT n) | n == ''[] = ListT
-        go (AppT (TupleT 1) t) = t
-        go (ConT n) | n == ''(,) = TupleT 2
-        go (ConT n) | n == ''(,,) = TupleT 3
-        go (ConT n) | n == ''(,,,) = TupleT 4
-        go (ConT n) | n == ''(,,,,) = TupleT 5
-        go (ConT n) | n == ''(,,,,,) = TupleT 6
-        go (ConT n) | n == ''(,,,,,,) = TupleT 7
-        go (ConT n) | n == ''(,,,,,,,) = TupleT 8
-        go (ConT n) | n == ''(,,,,,,,,) = TupleT 9
-        go (ConT n) | n == ''(,,,,,,,,,) = TupleT 10
-        go (ConT n) | n == ''(,,,,,,,,,,) = TupleT 11
-        go (ConT n) | n == ''(,,,,,,,,,,,) = TupleT 12
-        go (ConT n) | n == ''(,,,,,,,,,,,,) = TupleT 13
-        go (ConT n) | n == ''(,,,,,,,,,,,,,) = TupleT 14
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,) = TupleT 15
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,) = TupleT 16
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,) = TupleT 17
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,) = TupleT 18
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,) = TupleT 19
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,) = TupleT 20
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,) = TupleT 21
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,) = TupleT 22
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,) = TupleT 23
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 24
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 25
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 26
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 27
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 28
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 29
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 30
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 31
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 32
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 33
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 34
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 35
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 36
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 37
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 38
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 39
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 40
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 41
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 42
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 43
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 44
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 45
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 46
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 47
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 48
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 49
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 50
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 51
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 52
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 53
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 54
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 55
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 56
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 57
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 58
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 59
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 60
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 61
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 62
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 63
-        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 64
-        go t = t
-
-
-
------------------------------------------------------------------------------
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
rmfile ./src/Language/Haskell/Meta/Utils.hs
rmdir ./src/Language/Haskell/Meta
hunk ./src/Language/Haskell/Meta.hs 1
-
-{- |
-  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
rmfile ./src/Language/Haskell/Meta.hs
rmdir ./src/Language/Haskell
rmdir ./src/Language