[ unsing now haskell-src-exts
martin.hofmann@uni-bamberg.de**20091203151925] hunk ./igor2.cabal 13
-               haskell98 -any, haskell-src >=1.0, ghc-paths -any, ghc >=6.10,
+               haskell98 -any, haskell-src-exts >=1.3.2, ghc-paths -any, ghc >=6.10,
hunk ./igor2.cabal 49
-other-modules: Data
+other-modules:
hunk ./src/Igor2/Config.hs 59
-    [('(==), ForallT [mkName "a"] [AppT (ConT ''Eq) (mkVarT "a")] 
-             (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))--
---    , '(/=), ForallT [mkName "a"] [AppT (ConT ''Eq) (mkVarT "a")] 
---             (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool)))
-    ,('(<), ForallT [mkName "a"] [AppT (ConT ''Ord) (mkVarT "a")] 
-            (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))
---    ,('(>=), ForallT [mkName "a"] [AppT (ConT ''Ord) (mkVarT "a")] 
---            (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool))))
-    ,('(>), ForallT [mkName "a"] [AppT (ConT ''Ord) (mkVarT "a")] 
-            (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))
---    ,('(<=), ForallT [mkName "a"] [AppT (ConT ''Ord) (mkVarT "a")] 
---            (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool))))
+    [('(==), forallT ["a"] [(''Eq,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
+--    , '(/=), forallT ["a"] [(''Eq,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
+    ,('(<), forallT ["a"] [(''Ord,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
+--    ,('(>=), forallT ["a"] [(''Ord,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
+    ,('(>), forallT ["a"] [(''Ord,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
+--    ,('(<=), forallT ["a"] [(''Ord,"a")] $ arrowT [varT "a", varT "a", conT ''Bool]) 
hunk ./src/Igor2/Data/Rules.hs 13
-    LHS, RHS, hypos2decs, rules2decs,
+    LHS, RHS, hypos2decs,
+    
+    module Syntax.Specification,
+    -- hypos2decs, rules2decs,
hunk ./src/Igor2/Data/Rules.hs 41
-import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..))
hunk ./src/Igor2/Data/Rules.hs 43
-import Syntax.IFTemplateHaskell (pprint)
+
+import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..), Lit(..))
+import Language.Haskell.TH.Ppr (pprint)
hunk ./src/Igor2/Data/Rules.hs 48
+import Syntax.Specification (Equation(..), FunBind(..), mkEq, mkFB, fName)
hunk ./src/Igor2/Data/Rules.hs 59
-mkRule :: ([TExp],TExp) -> Rule
-mkRule = uncurry rule
+mkRule :: Equation -> Rule
+mkRule (UnGuardEq ls rs) = rule ls rs
hunk ./src/Igor2/Data/Rules.hs 71
-    pretty = text.pprint.rule2clause
+    pretty r = pretty $ mkEq (lhs r)(rhs r)
hunk ./src/Igor2/Data/Rules.hs 78
-    typeOf r = mkArrowT $ (map typeOf (lhs r))++[typeOf . rhs $ r]    
+    typeOf r = arrowT $ (map typeOf (lhs r))++[typeOf . rhs $ r]    
hunk ./src/Igor2/Data/Rules.hs 234
-pat2Call :: Name ->[Pat] -> Exp
-pat2Call n ps = foldl1 AppE $ (ConE n):(map pat2Exp ps)    
-    
-pat2Exp :: Pat -> Exp
-pat2Exp (VarP i)        = (VarE i)
-pat2Exp (LitP l)       = (LitE l) 
-pat2Exp (ConP n ps)    = foldl1 AppE $ (ConE n):(map pat2Exp ps)
-pat2Exp (InfixP l n r) = InfixE (Just . pat2Exp $ l)(ConE n)(Just . pat2Exp $ r) 
-pat2Exp (ListP l)      = ListE $ map pat2Exp l
-pat2Exp (TupP ps)      = TupE $ map pat2Exp ps
-pat2Exp p              = error $ "Syntax.IFTemplateHaskell.pat2Exp: Pattern " 
-                              ++ show p 
-                              ++ " cannot be transformed into an Expression!" 
-    
+
hunk ./src/Igor2/Data/Rules.hs 237
-    let funty = mkArrowT $ (++ [resty]) $ map typeOf ps  
+    let funty = arrowT $ (++ [resty]) $ map typeOf ps  
hunk ./src/Igor2/Data/Rules.hs 255
-    dc n (TCondE i t e _)  = any (dc n) [i,t,e]
+--    dc n (TCondE i t e _)  = any (dc n) [i,t,e]
hunk ./src/Igor2/Data/Rules.hs 270
-    cc c ns (TCondE i t e _)  = (c+).sum $ map (cc 0 ns) [i,t,e]
+--    cc c ns (TCondE i t e _)  = (c+).sum $ map (cc 0 ns) [i,t,e]
hunk ./src/Igor2/Data/Rules.hs 278
---tPat2TExp :: TPat -> TExp
---tPat2TExp (TVarP i t) = (TVarE i t)
---tPat2TExp (TLitP l t) = (TLitE l t) 
---tPat2TExp (TConP n ps t) = let ty = mkArrowT ((map typeOf ps) ++ [t])
---                           -- build the arrow type from all args and the target type
---                           in foldTAppE (TConE n ty) (map tPat2TExp ps)
---tPat2TExp (TInfixP l n r t) =
---    TInfixE (tPat2TExp $ l)
---            (TConE n $ mkArrowT [typeOf l, typeOf r, t])
---            (tPat2TExp $ r)            
---            t 
---tPat2TExp (TListP l t) = TListE (map tPat2TExp l) t
---tPat2TExp (TTupP ps t) = TTupE  (map tPat2TExp ps) t
-----tPat2TExp p = error $ "Syntax.IFTemplateHaskell.tPat2TExp: Pattern " ++ show p ++
-----                  " cannot be transformed into an Expression!" 
-
hunk ./src/Igor2/Data/Rules.hs 279
-hypos2decs hs =  map (rearrange.rules2decs) hs
+hypos2decs hs =  map (rules2decs.rearrange) hs
hunk ./src/Igor2/Data/Rules.hs 281
-    rearrange  = (uncurry  ((++) `on` sort)). partition tgtOrBgk
-    tgtOrBgk   = \(FunD n _) -> not $ isPrefixOf "fun" (show n)
+    rearrange = (uncurry  ((++) `on` sort)). partition tgtOrBgk
+    tgtOrBgk  (n,_) =  not . (isPrefixOf "fun") . show $ n
+    fromRule r = mkEq (lhs r)(rhs r) 
+    toFunB (n,rs) = mkFB n (map fromRule (S.toList rs))
hunk ./src/Igor2/Data/Rules.hs 306
-getOneWhich :: (a -> Bool) -> [a] -> Maybe a    
-getOneWhich _ []    = Nothing
-getOneWhich f (x:xs)
-    | f x        = Just x
-    | otherwise  = getOneWhich f xs
+--getOneWhich :: (a -> Bool) -> [a] -> Maybe a    
+--getOneWhich _ []    = Nothing
+--getOneWhich f (x:xs)
+--    | f x        = Just x
+--    | otherwise  = getOneWhich f xs
hunk ./src/Igor2/Data/Rules.hs 342
-rule2clause r = Clause ((map toPat) $ lhs r) (NormalB . fromTExp . rhs $ r) [] 
-            
+rule2clause r = Clause ((map toPat) $ lhs r) (NormalB . toExp . rhs $ r) [] 
+
+                              
+           
+toExp (TVarE n _)         = VarE n
+toExp (TWildE n _)        = VarE (mkName ('?':(show n)))
+toExp (TLitE l _)         = LitE (toLit l)
+toExp (TConE n _)         = ConE n
+toExp (TListE l _)        = ListE (map toExp l)
+toExp (TTupE l _)         = TupE (map toExp l)
+toExp (TAppE a1 a2 _)     = AppE (toExp a1) (toExp a2)                
+toExp (TInfixE e1 e2 e3 _) = 
+    InfixE (Just . toExp $ e1)(toExp e2)(Just . toExp $ e3)
+    
+toLit (Char c)   = CharL c
+toLit (String s) = StringL s
+toLit (Int i)    = IntegerL i
+toLit (Frac r)   = RationalL r
+              
+toPat (TVarE n _)         = VarP n
+toPat (TLitE l _)         = LitP (toLit l)
+toPat (TConE n _)         = ConP n []
+toPat (TListE l _)        = ListP (map toPat l)
+toPat (TTupE l _)         = TupP (map toPat l)
+toPat e@(TAppE a1 a2 _)   = 
+    let ((TConE n _):as) =  unfoldTAppE e
+    in  ConP n (map toPat as)                
+toPat (TInfixE l (TConE n _) r _) = 
+    InfixP (toPat l) n (toPat r)
+toPat e = error $ "Cannot translate to Pat: " ++ (show e) 
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 54
-              let afExp = foldTAppE ((mkTConE afnm) afty)(init . lhs . crul $ cr)
+              let afExp = foldTAppE ((tConE afnm) afty)(init . lhs . crul $ cr)
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 56
-                          (mkTConE 'map (afty ++ atys))
+                          (tConE 'map (afty ++ atys))
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 97
-                let pExp = foldTAppE ((mkTConE afnm) afty) (init . lhs . crul $ cr)
+                let pExp = foldTAppE ((tConE afnm) afty) (init . lhs . crul $ cr)
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 99
-                            (mkTConE 'filter (afty ++ atys))
+                            (tConE 'filter (afty ++ atys))
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 108
-                           in rule (init . lhs $ r)(mkTConE n [ConT ''Bool]))
+                           in rule (init . lhs $ r)(tConE n [ConT ''Bool]))
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 133
-        let afExp = foldTAppE ((mkTConE afnm) afty)(init . lhs . crul $ cr)
+        let afExp = foldTAppE ((tConE afnm) afty)(init . lhs . crul $ cr)
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 135
-                    (mkTConE 'map (afty ++ atys))
+                    (tConE 'map (afty ++ atys))
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 198
-    let afExp = foldTAppE ((mkTConE afnm) afty) ((rmAll usedVarInd) . init . lhs . crul $ cr)
+    let afExp = foldTAppE ((tConE afnm) afty) ((rmAll usedVarInd) . init . lhs . crul $ cr)
hunk ./src/Igor2/RuleDevelopment/UniProp.hs 200
-                    (mkTConE 'foldr (afty ++ atys))
+                    (tConE 'foldr (afty ++ atys))
hunk ./src/Igor2/SynthesisEngine.hs 33
+
hunk ./src/Igor2/SynthesisEngine.hs 42
-startSynthesis :: Context  -> SCR -> [(Name,[([TExp], TExp)])] -> [(Name,[([TExp], TExp)])]
+startSynthesis :: Context  -> SCR -> [FunBind] -> [FunBind]
hunk ./src/Igor2/SynthesisEngine.hs 49
-    toRbs = (map (\(m,es) -> (m, mkRules es)))
+    toRbs = map (\(FunB n es) -> (n, mkRules es))
hunk ./src/Igor2/UI/UIStarter.hs 114
-    
+   
hunk ./src/PrettyPrinter.hs 22
-import Syntax.IFTemplateHaskell
hunk ./src/PrettyPrinter.hs 29
+import Language.Haskell.TH.Syntax (Exp(..), Pat(..), Dec(..), Clause(..), Body(..), Lit(..))
+import Language.Haskell.TH.Ppr (pprint)
hunk ./src/PrettyPrinter.hs 104
-instance Pretty Name where
-    pretty = text.pprint
-    
-instance Pretty Type where
-    pretty = text.pprint
+--instance Pretty Name where
+--    pretty = text.pprint
hunk ./src/PrettyPrinter.hs 107
-instance Pretty Clause where
-    pretty = text.pprint
+--instance Pretty Type where
+--    pretty = text.pprint
+--    
+--instance Pretty Clause where
+--    pretty = text.pprint
hunk ./src/Syntax.hs 8
+    module Syntax.Name,
hunk ./src/Syntax.hs 12
-    module Syntax.IFTemplateHaskell,
+--    module Syntax.IFTemplateHaskell,
hunk ./src/Syntax.hs 21
+import Syntax.Name
hunk ./src/Syntax.hs 25
-import Syntax.IFTemplateHaskell hiding (Name, mkName, Type(..))
+--import Syntax.IFTemplateHaskell hiding (Name, mkName, Type(..))
hunk ./src/Syntax/Builder.hs 5
-     
+    
hunk ./src/Syntax/Builder.hs 16
+import Data.List (groupBy)
+import Data.Function (on)
hunk ./src/Syntax/Builder.hs 19
-import Language.Haskell.Syntax
-import Language.Haskell.Parser
hunk ./src/Syntax/Builder.hs 20
-import Language.Haskell.TH.Syntax hiding (Type(..))
-import qualified Language.Haskell.TH.Syntax as TH (Type(..))
-import Syntax.IFTemplateHaskell hiding (Type(..))
+import qualified Language.Haskell.Exts.Syntax as Hs
+import Language.Haskell.Exts.Parser
+import Language.Haskell.Exts.Extension
+--import qualified Language.Haskell.TH.Syntax as TH (Type(..))
+--import Syntax.IFTemplateHaskell hiding (Type(..))
hunk ./src/Syntax/Builder.hs 33
-import Syntax.Type hiding (mkAppT)
hunk ./src/Syntax/Builder.hs 34
-import Syntax.Expressions hiding (toPat)
---import Syntax.Class.Unifier
+import Syntax.Expressions
+import Syntax.Type
+import Syntax.Name
+import Syntax.Class.Term
hunk ./src/Syntax/Builder.hs 50
-parseSpec s = do 
+parseSpec s = do
hunk ./src/Syntax/Builder.hs 57
-    parse s = do f <- readFile s
-                 case parseModule f of 
+    parse s = do f <- readFile s  
+                 let mode = defaultParseMode{ parseFilename = s
+                                            , extensions=[TypeOperators,TypeFamilies]}
+                 case parseModuleWithMode mode f of 
hunk ./src/Syntax/Builder.hs 64
-                               " with message: " ++ msg  
+                               " with message: " ++ msg  ++
+                               "\nMaybe This is not supported by Igor."
hunk ./src/Syntax/Builder.hs 69
-    isFunBind e = case e of (HsFunBind _ ) -> True; _ -> False
-    moduleDecls (HsModule _ _ _ _ d) = d
+    isFunBind e = case e of (Hs.FunBind _ ) -> True; _ -> False
+    moduleDecls (Hs.Module _ _ _ _ _ _ d) = d
hunk ./src/Syntax/Builder.hs 72
-processBnd ctx d@(HsFunBind _ ) = do
-    let [(FunD n cls)] = toDec d
-    case (clauses2rules (spec_ctx ctx) n cls) of
-        Right rs -> return $ addToBindings [rs] ctx
-        Left msg -> fail  msg
-processBnd ctx _ = do
-    putStrLn $ "processBnd: Skipping something that is not a HsFunBind."
-    return ctx     
+processBnd :: Specification -> Hs.Decl -> IO Specification
+processBnd spc d@(Hs.FunBind ms ) = do
+    toFunBind (spec_ctx spc) ms  >>= return . (flip addToBindings spc)
+processBnd spc d = do
+    putStrLn $ errorMsg "Skipping processBnd: " d
+    return spc     
hunk ./src/Syntax/Builder.hs 79
-updateCtx :: Specification -> HsDecl -> IO Specification
-updateCtx ctx d@(HsTypeDecl _  _ _ _) = 
-    let pSynTy = map (\(TySynD n args t) -> ((mkAppT n args), fixType $ fromTH t) ) $ toDec d
-    in return $ addToTypeSyns pSynTy ctx
-    
-updateCtx ctx (HsDataDecl _ assts tname args condecls derive) = do
+updateCtx :: Specification -> Hs.Decl -> IO Specification
+updateCtx spc d@(Hs.TypeDecl _ n tvb ty) = 
+    let synTy = toType $ mkHsTyApp n tvb
+    in return $ addToTypeSyns [(synTy, toType ty)] spc    
+updateCtx spc (Hs.DataDecl sloc _ assts tname args condecls derive) = do
hunk ./src/Syntax/Builder.hs 88
-        ctorNameTy cd = case cd of 
-            (HsConDecl _ n tys) ->  return ( toName n, ctorty $ map unBang tys);
-             _owise -> fail $ "No records supported!"
+        ctorNameTy (Hs.QualConDecl _ _ _ cd) = case cd of 
+            (Hs.ConDecl n tys) ->  return ( toName n, ctorty $ map unBang tys);
+             _owise -> fail $ noSupport "Record" sloc 
hunk ./src/Syntax/Builder.hs 94
-    let pTysClass = map (\n -> ((mkForallT assts (toType dataty)), (toName n))) derive
+    let toTyClass (n,[]) = return $ (mkForallT assts (toType dataty), (toName n)) 
+        toTyClass (n,_)  = fail $ noSupport "Multi-parameter type classes" sloc
+    tyClasses <- mapM toTyClass derive
hunk ./src/Syntax/Builder.hs 98
-    return $ (addToConstructors pNameTy) . (addToInstances pTysClass) $ ctx
---updateCtx ctx (HsClassDecl sloc _ _ [] _ _) = can never be
-updateCtx ctx (HsClassDecl sloc _ _ (_:_:_) _) =
-    fail $  fail $ "Multi parameter type classes are not supported at: " ++ (show sloc)        
-updateCtx 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)
-        -- extract plain class declarations, i.e. no 'ClsDataFam', 'ClsTyFam', 'ClsTyDef' 
---    clsdecls <- mapM getClsDecl decls 
-    let sigds        = concatMap toDec $ filter isTypeDecl $ decls
-        -- extract type signatures 'SigD's from '[ClassDecl]'
-        isTypeDecl d = case d of (HsTypeSig _ _ _) -> True; _owise -> False
-        assts'       = (mkHsAsst cname anames):assts 
+    return $ (addToConstructors pNameTy) . (addToInstances tyClasses) $ spc
+--updateCtx spc (Hs.ClassDecl sloc _ _ [] _ _) = can never be
+updateCtx spc (Hs.ClassDecl sloc _ _ (_:_:_) _ _) =
+    fail $ noSupport "Multi-parameter type classes" sloc
+updateCtx spc (Hs.ClassDecl sloc _ _ _ [_] _) =
+    fail $ noSupport "Functional Dependencies" sloc
+updateCtx spc (Hs.ClassDecl sloc assts cn as _ ds) = do
+    let cdecls d = 
+         case d of 
+          (Hs.ClsDecl dcl) -> return dcl ;
+           _owise -> fail $ noSupport "Associated data types or type synonyms" sloc 
+        getName (Hs.KindedVar n _) = n 
+        getName (Hs.UnkindedVar n) = n
+        sigds        = concatMap (filter isTypeDecl) (map cdecls ds)
+        -- extract type signatures 'TypeSig'
+        isTypeDecl d = case d of (Hs.TypeSig _ _ _) -> True; _owise -> False
+        assts'       = (mkHsAsst cn (map getName as)):assts 
hunk ./src/Syntax/Builder.hs 117
-        pNameTy     = map (\(SigD n t) -> (n, (mkForallT assts' $ fromTH t))) sigds
+        pNameTy     = concatMap (\(Hs.TypeSig _ ns ty) -> (zip (map toName ns)(cycle [(toType ty)]))) sigds
hunk ./src/Syntax/Builder.hs 119
-        pClssFuns     = [(toName cname,[ n | (SigD n _) <- sigds])]
+        pClssFuns     = [(toName cn,concat [ map toName n | (Hs.TypeSig _ n _) <- sigds])]
hunk ./src/Syntax/Builder.hs 121
-        pClssSupr   = [(toName cname,[ (toName.fst) a | a <- assts])]
-    return $ (addToTypes pNameTy ) . (addToMembers pClssFuns) . (addToClasses pClssSupr) $ ctx 
-
---updateCtx _ (HsInstDecl sloc _ _ [] _) -- can never be 
-updateCtx _ (HsInstDecl sloc _ _ (_:_:_) _) =      
-    fail $ "Multi parameter type classes are not supported at: " ++ (show sloc)
-updateCtx ctx (HsInstDecl sloc assts qname [t] _) = do 
+        pClssSupr   = [(toName cn, concatMap getVarNames (getPreds assts))]
+    return $ (addToTypes pNameTy ) . (addToMembers pClssFuns) . (addToClasses pClssSupr) $ spc
+--updateCtx _ (Hs.InstDecl sloc _ _ [] _) -- can never be 
+updateCtx _ (Hs.InstDecl sloc _ _ (_:_:_) _) =      
+    fail $ noSupport "Multi-parameter type classes" sloc
+updateCtx spc (Hs.InstDecl sloc assts qname [t] _) = do 
hunk ./src/Syntax/Builder.hs 131
-    return $ addToInstances [(ty,n)] ctx   
+    return $ addToInstances [(ty,n)] spc      
+updateCtx spc (Hs.TypeSig _ ns ty) =
+    return $ addToTypes (zip (map toName ns)(cycle [(toType ty)])) spc       
+updateCtx spc (Hs.TypeInsDecl _ _ _) =
+    -- noop
+    return spc
+updateCtx spc d = do
+    putStrLn $ errorMsg "Skipping updateCtx:" d
+    return spc
hunk ./src/Syntax/Builder.hs 141
-updateCtx ctx d@(HsTypeSig _ _ _ ) =
-    let pNmsTys  = map (\(SigD n t) -> (n, fixType $ fromTH t)) $ toDec d  
-    in return $ addToTypes pNmsTys ctx
- 
-updateCtx ctx d@(HsFunBind _ ) = do
-    putStrLn $ "updateCtx: Skipping HsFunBind."
-    return ctx     
-        
---updateCtx e (HsGDataDecl sloc _ _ _ _ _ _ _ ) = do
---    putStrLn $ "...Skipping GDataDecl at Defining " ++ (show sloc)
---    return e    
---updateCtx e (HsTypeFamDecl sloc _ _ _ ) = do
---    putStrLn $ "...Skipping TypeFamDecl at " ++ (show sloc)
---    return e    
---updateCtx e (HsDataFamDecl sloc _ _ _ _ ) = do
---    putStrLn $ "...Skipping DataFamDecl at " ++ (show sloc)
---    return e     
---updateCtx e (HsTypeInsDecl sloc _ _ ) = do
---    putStrLn $ "...Skipping TypeInsDecl at " ++ (show sloc)
---    return e         
---updateCtx e (HsDataInsDecl sloc _ _ _ _ ) = do
---    putStrLn $ "...Skipping DataInsDecl at " ++ (show sloc)
---    return e           
---updateCtx e (HsGDataInsDecl sloc _ _ _ _ _ ) = do
---    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
---    return e            
-updateCtx e (HsInfixDecl sloc _ _ _ ) = do
-    putStrLn $ "...Skipping InfixDecl at " ++ (show sloc)
-    return e      
---updateCtx e (HsDerivDecl sloc _ _ _ ) = do
---    putStrLn $ "...Skipping DerivDecl at " ++ (show sloc)
---    return e               
-updateCtx e (HsDefaultDecl sloc _ ) = do
-    putStrLn $ "...Skipping DefaultDecl at " ++ (show sloc)
-    return e               
---updateCtx e (HsSpliceDecl sloc _ ) = do
---    putStrLn $ "...Skipping SpliceDecl at " ++ (show sloc)
---    return e              
-updateCtx e (HsPatBind sloc _ _ _) = do
-    putStrLn $ "...Skipping PatBind at " ++ (show sloc)
-    return e               
---updateCtx e (HsForImp sloc _ _ _ _ _ ) = do
---    putStrLn $ "...Skipping ForImp at " ++ (show sloc)
---    return e              
---updateCtx e (HsForExp sloc _ _ _ _ ) = do
---    putStrLn $ "...Skipping ForExp at " ++ (show sloc)
---    return e             
---updateCtx e (HsRulePragmaDecl sloc _ ) = do
---    putStrLn $ "...Skipping RulePragmaDecl at " ++ (show sloc)
---    return e                
---updateCtx e (HsDeprPragmaDecl sloc _ ) = do
---    putStrLn $ "...Skipping DeprPragmaDecl at " ++ (show sloc)
---    return e                
---updateCtx e (HsWarnPragmaDecl sloc _ ) = do
---    putStrLn $ "...Skipping GDataInsDecl at " ++ (show sloc)
---    return e                
---updateCtx e (HsInlineSig sloc _ _ _ ) = do
---    putStrLn $ "...Skipping InlineSig at " ++ (show sloc)
---    return e              
---updateCtx e (HsSpecSig sloc _ _ ) = do
---    putStrLn $ "...Skipping SpecSig at " ++ (show sloc)
---    return e             
---updateCtx e (HsSpecInlineSig sloc _ _ _ _ ) = do
---    putStrLn $ "...Skipping SpecInlineSig at " ++ (show sloc)
---    return e               
---updateCtx e (HsInstSig sloc _ _ _ ) = do
---    putStrLn $ "...Skipping InstSig at " ++ (show sloc)
---    return e             
---updateCtx e (HsUnknownDeclPragma sloc _ _ ) = do
---    putStrLn $ "...Skipping UnknownDeclPragma at " ++ (show sloc)
---    return e            
-
---toDec :: HsDecl -> [Dec]
---toDec (HsTypeSig _ ns t) =  [SigD (toName n) (toType t) | n <- ns]
---toDec decs                = [toDec decs] 
-                        -- is a 'FunBind' or 'TySynD' or something is wrong 
-
-mkAppT :: Name -> [Name] -> Type
-mkAppT n ns = foldl AppT (ConT n) (map VarT ns)
-
-mkHsTyApp :: HsName -> [HsName] -> HsType
-mkHsTyApp n as = foldl HsTyApp (HsTyCon $ UnQual n) (map HsTyVar as)
+mkHsTyApp :: Hs.Name -> [Hs.TyVarBind] -> Hs.Type
+mkHsTyApp n as = foldl Hs.TyApp (Hs.TyCon $ Hs.UnQual n) (map mkTyVar as)
+    where 
+    mkTyVar (Hs.KindedVar n _) = Hs.TyVar n
+    mkTyVar (Hs.UnkindedVar n) = Hs.TyVar n 
hunk ./src/Syntax/Builder.hs 147
-mkHsTyFun :: [HsType] -> HsType
-mkHsTyFun = foldr1 HsTyFun
+mkHsTyFun :: [Hs.Type] -> Hs.Type
+mkHsTyFun = foldr1 Hs.TyFun
hunk ./src/Syntax/Builder.hs 150
-mkHsAsst :: HsName -> [HsName] -> HsAsst
-mkHsAsst ctor args = (UnQual ctor, map HsTyVar args)
+mkHsAsst :: Hs.Name -> [Hs.Name] -> Hs.Asst
+mkHsAsst ctor args = Hs.ClassA (Hs.UnQual ctor)( map Hs.TyVar args)
hunk ./src/Syntax/Builder.hs 153
-unBang :: HsBangType -> HsType
+unBang :: Hs.BangType -> Hs.Type
hunk ./src/Syntax/Builder.hs 155
-            (HsBangedTy t) -> t 
-            (HsUnBangedTy t) -> t
+            (Hs.BangedTy t) -> t 
+            (Hs.UnBangedTy t) -> t
hunk ./src/Syntax/Builder.hs 158
-mkForallT :: [HsAsst] -> Type -> Type
+mkForallT :: [Hs.Asst] -> Type -> Type
hunk ./src/Syntax/Builder.hs 160
-    fixType $ ForallT (concatMap getVName assts) (map toType assts) ty
-    where
-    getVName = map (\(HsTyVar n) -> toName n) . snd             
+    fixType $ ForallT [] (getPreds assts) ty             
hunk ./src/Syntax/Builder.hs 169
-class ToTExp t where
-    toTExp   :: (MonadError e m) => Type -> t -> C m TExp
+class ToTExp t     where toTExp   :: (MonadError e m) => Type -> t -> C m TExp
+class ToFunBind d  where toFunBind :: (MonadError e m) => Context -> d -> m [FunBind]
+class ToEquation d where toEquation :: (MonadError e m) => Type -> d -> C m Equation
+class ToName a where toName :: a -> Name
+class ToLit  a where toLit  :: a -> Lit
+class ToType a where toType :: a -> Type
+
+instance ToFunBind [Hs.Match] where
+    toFunBind c ms = mapM (toFunBind c) ms >>= return . concat  >>=
+                      return . (groupBy $ on (==) fName) >>=
+                       return . (map (\fs -> FunB (fName . head $ fs) (concatMap fEqus fs)))
+
+instance ToFunBind Hs.Match where
+    toFunBind c (Hs.Match _ n lhs _ty rhs bs)
+        | emptyBinds bs = let n' = toName n in 
+            case Map.lookup n' (ctx_types c)of
+             (Just ty) -> withC (toEquation ty (lhs,rhs)) c >>= \e -> 
+                            return [FunB n' [e]]
+             Nothing   -> fail $ "No type in Context for '" ++ (show n) ++"'"
+        | otherwise     = fail $ "Binding geroups inside a let ot where clause are not supported."
hunk ./src/Syntax/Builder.hs 190
--- | Propagates a type to a pattern and all its subpatterns. 
---   No type checking is done !!
---class ToTPat t where
---    toTPat   :: Type -> t -> C TPat
+emptyBinds (Hs.BDecls l)  = null l
+emptyBinds (Hs.IPBinds l) = null l
+      
+instance ToEquation ([Hs.Pat],Hs.Rhs) where
+    toEquation ty (lhs,rhs) = do
+        let argty = unArrowT ty
+        ls <- zipWithM toTExp (init argty) lhs
+        case rhs of
+            (Hs.UnGuardedRhs rhs') -> toTExp (last argty) rhs' >>= return . (UnGuardEq ls)
+            (Hs.GuardedRhss rhss) -> mapM (mkRhs (last argty)) rhss >>= return . (GuardedEq ls)
+
+mkRhs ty (Hs.GuardedRhs _ [g] e) = liftM2 (,) (toTExp (conT ''Bool) g) (toTExp ty e)
+mkRhs _ _ = fail "Pattern Guards are not supported!" 
hunk ./src/Syntax/Builder.hs 205
-instance ToTExp Exp where
-    toTExp t (VarE n)          = return $ TVarE n t
-    toTExp t (LitE l)          = return $ TLitE l t
-    toTExp t (ConE n)          = return $ TConE n t
-    toTExp lstty (ListE l)     = do
+instance ToTExp Hs.Exp where
+    toTExp t (Hs.Var n)          = return $ TVarE (toName n) t
+    toTExp t (Hs.Lit l)          = return $ TLitE (toLit l) t
+    toTExp t (Hs.Con n)          = return $ TConE (toName n) t
+    toTExp lstty (Hs.List l)     = do
hunk ./src/Syntax/Builder.hs 213
-    toTExp tupty (TupE l)      = do
+    toTExp tupty (Hs.Tuple l)      = do
hunk ./src/Syntax/Builder.hs 217
-    toTExp t e@(AppE _ _ ) =
-        case unfoldAppE e of
-            ((VarE n):args) -> do -- a function name
-                ty <- getVarType n >>= maybe (fail "Fun not in Context") (specialise t)
+    toTExp t e@(Hs.App _ _ ) =
+        case unfoldApp e of
+            ((Hs.Var n):args) -> do -- a function name
+                let n' = toName n
+                ty <- getVarType n' >>= maybe (fail $ "Fun " ++ (show n') ++ " not in Context") (specialise t)
hunk ./src/Syntax/Builder.hs 224
-                tVarE <- toTExp ty (VarE n)
-                return $ foldTAppE tVarE teargs     
-            ((ConE n):args) -> do
-                ty <- getConType n >>= maybe (fail "Ctor not in Context") (specialise t)
-                tyargs <- return $ unArrowT ty
-                teargs <- zipWithM toTExp tyargs args
-                tConE <- toTExp ty (ConE n)
-                return $ foldTAppE tConE teargs                 
-    toTExp t (InfixE (Just l) (ConE n) (Just r)) = do     
-                ty <- getConType n >>=  maybe (fail "Ctor not in Context") (specialise t)
-                (tya1:tya2:_) <- return $ unArrowT ty
-                a1' <- toTExp tya1 l
-                a2' <- toTExp tya2 r
-                tConE <- toTExp ty (ConE n)
-                return $ TInfixE a1' tConE a2' t       
-    toTExp _ e = fail $ "No Translation defined for " ++ (show e)
---    toTexp TCondE TExp TExp TExp Type
---    toTexp TLamE [TPat] TExp Type
-
+                return $ foldTAppE (TVarE n' ty) teargs     
+            ((Hs.Con n):args) -> do
+                let n' = toName n
+                ty <- getConType n' >>= maybe (fail $ "Ctor " ++ (show n') ++ " not in Context") (specialise t)
+                let tys = unArrowT ty
+                teargs <- zipWithM toTExp tys args
+                return $ foldTAppE (tConE n' tys) teargs                 
+    toTExp t (Hs.InfixApp l qop  r) = do 
+        let n' = toName qop
+        ty <- getConType n' >>= maybe (fail $ "Ctor " ++ (show n') ++ " not in Context") (specialise t)
+        let tys@(ty1:ty2:_) = unArrowT ty
+        l' <- toTExp ty1 l
+        r' <- toTExp ty2 r
+        return $ tInfixE l' (tConE n' tys) r'  
+    toTExp t (Hs.Paren e) = toTExp t e
+    toTExp _ e =  fail $ errorMsg "toTExp" e
hunk ./src/Syntax/Builder.hs 241
-instance ToTExp Pat where
-    toTExp t (LitP l) = return $ TLitE l t
-    toTExp t (VarP n) = return $ TVarE n t
-    toTExp tupty (TupP l) = do
+instance ToTExp Hs.Pat where
+    toTExp t (Hs.PLit l) = return $ TLitE (toLit l) t
+    toTExp t (Hs.PVar n) = return $ TVarE (toName n) t
+    toTExp tupty (Hs.PTuple l) = do
hunk ./src/Syntax/Builder.hs 247
-        return $ TTupE tes tupty
-    toTExp t (ConP n args) = do 
-        ty <- getConType n >>= maybe (fail "Ctor not in Context") (specialise t)
+        return $ tTupE tes
+    toTExp t (Hs.PApp n args) = do 
+        let n' = toName n
+        ty <- getConType n' >>= maybe (fail $ "Ctor " ++ (show n') ++ " not in Context") (specialise t)
hunk ./src/Syntax/Builder.hs 253
-        return $ foldTAppE (mkTConE n tyargs) teargs
-    toTExp lstty (ListP l) = do
+        return $ foldTAppE (tConE n' tyargs) teargs
+    toTExp lstty (Hs.PList l) = do
hunk ./src/Syntax/Builder.hs 258
-    toTExp t (InfixP a1 n a2) = do
-                ty <- getConType n >>= maybe (fail "Ctor not in Context") (specialise t)
-                (tya1:tya2:_) <- return $ unArrowT ty
-                a1' <- toTExp tya1 a1
-                a2' <- toTExp tya2 a2
-                return $ TInfixE a1' (TConE n ty) a2' t     
-    toTExp _ p = fail $ "No Translation defined for " ++ (show p)
-
-
-clauses2rules :: (Monad m) => Context -> Name -> [Clause] -> m (Name, [Equation])
-clauses2rules cxt n cls = 
-    case Map.lookup n (ctx_types cxt)of
-        (Just ty) -> either fail (return . ((,) n)) $ withC (mapM (clause2rule ty) cls) cxt
-        Nothing   -> fail $ "No type in Context for '" ++ (show n) ++"'"
-        
-    where
-    clause2rule ty (Clause ls (NormalB rs) _) = do
-        let argty = unArrowT ty
-        ls' <- zipWithM toTExp (init argty) ls
-        rs' <- toTExp (last argty) rs
-        return (ls', rs')  
-        
-
-     
--- stolen from Language.Haskell.Meta.Syntax.Translate from package haskell.src.meta
------------------------------------------------------------------------------
-
-
-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
+    toTExp t (Hs.PInfixApp l n r) = do
+        let n' = toName n
+        ty <- getConType n' >>= maybe (fail $ "Ctor " ++ (show n') ++ " not in Context") (specialise t)
+        let tys@(ty1:ty2:_) = unArrowT ty
+        l' <- toTExp ty1 l
+        r' <- toTExp ty2 r
+        return $ tInfixE l' (tConE n' tys) r'  
+    toTExp t (Hs.PParen e) = toTExp t e    
+    toTExp _ p = fail $ errorMsg "toTExp" p
hunk ./src/Syntax/Builder.hs 268
+instance ToTExp Hs.Stmt where
+    toTExp ty (Hs.Qualifier e) = toTExp ty e
+    toTExp _ s = fail $ errorMsg "toTExp" s
hunk ./src/Syntax/Builder.hs 272
-errorMsg :: (Typeable a) => String -> a -> String
+errorMsg :: (Show a,Typeable a) => String -> a -> String
hunk ./src/Syntax/Builder.hs 274
-  [ fun,": "
+  [ fun, " ", (show a), ":: "
hunk ./src/Syntax/Builder.hs 278
+  
+noSupport :: (Show a) => String -> a -> String
+noSupport s sloc = "Not supported: " ++ s ++ " at: " ++ (show sloc)
hunk ./src/Syntax/Builder.hs 282
-
------------------------------------------------------------------------------
-
-
-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
+--
+-------------------------------------------------------------------------------
+--
+--
+--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
+--
hunk ./src/Syntax/Builder.hs 325
+instance ToLit Hs.Literal where
+  toLit (Hs.Char a)   = Char a
+  toLit (Hs.String a) = String a
+  toLit (Hs.Int a)    = Int a
+  toLit (Hs.Frac a)   = Frac a
hunk ./src/Syntax/Builder.hs 339
-instance ToName HsName where
-  toName (HsIdent s) -- = toName s
+instance ToName Hs.QName where
+    toName (Hs.Qual (Hs.ModuleName m) n) = toName $ m ++ "." ++ 
+                                                    (show.pretty.toName $ n)
+    toName (Hs.UnQual n)                 = toName n
+    toName (Hs.Special s)                = toName s
+    
+instance ToName Hs.SpecialCon where
+    toName Hs.UnitCon        = '()
+    toName Hs.ListCon        = '[]
+    toName Hs.FunCon         = ''(->)
+    toName Hs.Cons           = '(:)
+    toName (Hs.TupleCon _ n)
+        | n<2                = '()
+        | otherwise          =  toName . concat $ ["(",replicate (n-1) ',',")"]
+    toName s                 = error $ "toName: Symbol " ++ (show s) ++ " is not supported"
+    
+
+instance ToName Hs.Name where
+  toName (Hs.Ident s) -- = toName s
hunk ./src/Syntax/Builder.hs 369
-  toName (HsSymbol s) = toName s
-
-instance ToName HsModule where
-  toName (HsModule _ (Module m) _ _ _) = toName m
-
-
-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 (HsQual (HsModule []) n) = toName n
-  toName (Qual (Module "") n) = toName n
-  toName (Qual (Module 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
-
+  toName (Hs.Symbol s) = toName s
hunk ./src/Syntax/Builder.hs 371
------------------------------------------------------------------------------
-
--- * ToPat HsPat
-
-
-instance ToPat HsPat where
-  toPat (HsPVar n)
-    = VarP (toName n)
-  toPat (HsPLit l)
-    = LitP (toLit l)
-  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)
-
-
------------------------------------------------------------------------------
-
--- * 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)
-  
-{-
-HsInfixApp 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 []))
-
-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 (HsInfixApp e o f)        = toRightAssoc (mkInfix o (toExp f)) e
-    where
-    toRightAssoc done (HsInfixApp 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 (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)
-  -- 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) (toTH $ 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
-  toExp e = error $ errorMsg "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)
-
------------------------------------------------------------------------------
+instance ToName Hs.Module where
+  toName (Hs.Module _ (Hs.ModuleName m) _ _ _ _ _) = toName m
hunk ./src/Syntax/Builder.hs 374
--- * ToType HsType
hunk ./src/Syntax/Builder.hs 376
-{- |
-TH does't handle
-  * unboxed tuples
-  * implicit params
-  * infix type constructors
-  * kind signatures
--}
-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
-
-  -- 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
-
-instance ToType HsQualType where
-   toType (HsQualType cxt t) = fixType $ ForallT [] (fmap toType cxt) (toType t)
+instance ToName Hs.QOp where
+    toName (Hs.QVarOp n) = toName n
+    toName (Hs.QConOp n) = toName n 
hunk ./src/Syntax/Builder.hs 380
+instance ToType Hs.Type where
+  toType (Hs.TyForall Nothing x t) = fixType $ ForallT [] (getPreds x)(toType t)
+  toType a@(Hs.TyForall _ _ _)     = error $ errorMsg "toType" a
+  toType (Hs.TyFun a b)            = toType a .->. toType b
+  toType (Hs.TyTuple _ ts)         = tupT $ fmap toType ts
+  toType (Hs.TyList t)             = listT $ toType t
+  toType (Hs.TyApp a b)            = appT (toType a) (toType b)
+  toType (Hs.TyVar n)              = VarT (toName n)
+  toType (Hs.TyCon n)              = ConT (toName n)
+  toType (Hs.TyParen t)            = toType t
+  toType (Hs.TyKind t _)           = toType t
+  toType (Hs.TyInfix l c r)        = infixT (ConT . toName $ c)(toType l)(toType r)
hunk ./src/Syntax/Builder.hs 396
-{- |
-TH doesn't handle:
-  * implicit params
-  * equality constraints
--}
-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
-
-
-fromTH (TH.ForallT ns cxt t) = ForallT ns (map fromTH cxt)(fromTH t)
-fromTH (TH.VarT n)           = VarT n
-fromTH (TH.ConT n)           = ConT n
-fromTH (TH.TupleT i)         = TupleT i
-fromTH TH.ArrowT             = ArrowT
-fromTH TH.ListT              = ListT
-fromTH (TH.AppT l r)         = AppT (fromTH l)(fromTH r)
-
-toTH (ForallT ns cxt t) = TH.ForallT ns (map toTH cxt)(toTH t)
-toTH (VarT n)           = TH.VarT n
-toTH (ConT n)           = TH.ConT n
-toTH (TupleT i)         = TH.TupleT i
-toTH ArrowT             = TH.ArrowT
-toTH ListT              = TH.ListT
-toTH (AppT l r)         = TH.AppT (toTH l)(toTH r)
-     
------------------------------------------------------------------------------
-
--- * 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 (toDec bnds)
-
-
------------------------------------------------------------------------------
-
--- * ToDec HsDecl
-
--- data HsBinds = HsBDecls [HsDecl] | HsIPBinds [HsIPBind]
---hsBindsToDecs :: HsBinds -> [Dec]
---hsBindsToDecs (HsBDecls ds) = concatMap toDec ds
---hsBindsToDecs a@(HsIPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a
--- data HsIPBind = HsIPBind SrcLoc HsIPName HsExp
-
-
-hsBangTypeToStrictType :: HsBangType -> (Strict, TH.Type)
-hsBangTypeToStrictType (HsBangedTy t)   = (IsStrict, toTH $ toType t)
-hsBangTypeToStrictType (HsUnBangedTy t) = (NotStrict, toTH $ 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) (toTH $ toType t)]
-  toDec a@(HsDataDecl  _ 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 _ _ _ _ _)                     = 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) (toTH $ 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@(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)
-                                                            (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
-
-instance ToDec [HsDecl] where
-    toDec = concatMap toDec
-
-
-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)
-                                                (toDec 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 [(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')
-
-
-
-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
-
+getPreds :: Hs.Context -> TyCxt
+getPreds = concatMap getPred
+    where
+    getPred (Hs.ClassA n ts) = map ((appT (conT (toName n))) . toType) ts
+    getPred p             = error $ errorMsg "toType" p 
hunk ./src/Syntax/Builder.hs 403
-unfoldAppEargs = tail . unfoldAppE
+unfoldAppArgs = tail . unfoldApp
hunk ./src/Syntax/Builder.hs 407
-unfoldAppE :: Exp -> [Exp]
-unfoldAppE e = f [] e
+unfoldApp :: Hs.Exp -> [Hs.Exp]
+unfoldApp e = f [] e
hunk ./src/Syntax/Builder.hs 412
-            (AppE e1@(VarE _) e2) -> e1:e2:done
-            (AppE e1@(ConE _) e2) -> e1:e2:done
-            (AppE e1 e2)       -> f (e2:done) e1
+            (Hs.App e1@(Hs.Var _) e2) -> e1:e2:done
+            (Hs.App e1@(Hs.Con _) e2) -> e1:e2:done
+            (Hs.App e1 e2)       -> f (e2:done) e1
hunk ./src/Syntax/Builder.hs 417
-foldAppE :: [Exp] -> Exp
-foldAppE es = foldl1 AppE es
+foldApp :: [Hs.Exp] -> Hs.Exp
+foldApp es = foldl1 Hs.App es
hunk ./src/Syntax/Class.hs 4
-    Name, mkName, 
hunk ./src/Syntax/Class.hs 16
-import Syntax.IFTemplateHaskell (Name, mkName)
hunk ./src/Syntax/Class/Antiunifier.hs 17
-import Syntax.IFTemplateHaskell
+import Syntax.Name
hunk ./src/Syntax/Class/Antiunifier.hs 20
+--import Syntax.Ppr
+
+import PrettyPrinter
hunk ./src/Syntax/Class/Antiunifier.hs 31
-import PrettyPrinter
hunk ./src/Syntax/Class/Subst.hs 21
-import Syntax.IFTemplateHaskell (Name)
+import Syntax.Name
hunk ./src/Syntax/Class/Term.hs 23
-import Syntax.IFTemplateHaskell
+--import Syntax.Ppr
+import Syntax.Name
hunk ./src/Syntax/Class/Term.hs 31
-import PrettyPrinter
hunk ./src/Syntax/Class/Term.hs 51
-instance Pretty Position where
-	pretty = text.show
+
hunk ./src/Syntax/Class/Term.hs 101
-class (Eq t, Show t, Pretty t) => Term t where
+class (Eq t, Show t) => Term t where
hunk ./src/Syntax/Context.hs 17
-import Syntax.IFTemplateHaskell hiding (Type(..))
hunk ./src/Syntax/Context.hs 18
+import Syntax.Name
hunk ./src/Syntax/Context.hs 20
+--import Syntax.Ppr
hunk ./src/Syntax/Context.hs 100
-    
-instance Pretty Context where
-    pretty ctx = linebreak <$> text "Context: " <$>
-               (indent 2 $ text "Types   : " <$> pretty (ctx_types ctx) <$>
-                           text "Ctors   : " <$> pretty (ctx_ctors ctx) <$>
-                           text "Classes : " <$> pretty (ctx_classes ctx) <$>
-                           text "Members : " <$> pretty (ctx_members ctx) <$>
-                           text "Instancs: " <$> pretty (ctx_instances ctx) <$>
-                           text "Synonyms: " <$> pretty (ctx_typesyns ctx))
-        
-    
+   
hunk ./src/Syntax/Context.hs 112
-    [('(==), (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))
+    [('(==), arrowT [varT "a", varT "a", conT ''Bool])
hunk ./src/Syntax/Context.hs 114
---    , '(/=), (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool)))
-    ,('(<), (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))
---    ,('(>=), (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool))))
-    ,('(>), (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (AppT ArrowT (mkVarT "a")) 
-                    (ConT ''Bool))))
---    ,('(<=), (AppT 
---              (AppT ArrowT (mkVarT "a")) 
---              (AppT (AppT ArrowT (mkVarT "a")) 
---                    (ConT ''Bool))))
+--    , '(/=), arrowT [varT "a", varT "a", conT ''Bool])
+    ,('(<), arrowT [varT "a", varT "a", conT ''Bool])
+--    ,('(>=), arrowT [varT "a", varT "a", conT ''Bool])
+    ,('(>), arrowT [varT "a", varT "a", conT ''Bool])
+--    ,('(<=), arrowT [varT "a", varT "a", conT ''Bool])
hunk ./src/Syntax/Context.hs 122
-    [('(:), (AppT 
-             (AppT ArrowT (mkVarT "a")) 
-             (AppT (AppT ArrowT (AppT ListT (mkVarT "a"))) 
-                   (AppT ListT (mkVarT "a")))))
-    ,('[], (AppT ListT (mkVarT "a")) )
-    ,('True, ConT (''Bool) )
-    ,('False, ConT (''Bool) )
-    ,('Just, (AppT 
-              (AppT ArrowT (mkVarT "a")) 
-              (AppT (ConT ''Maybe) (mkVarT "a"))))
-    ,('Nothing,  (AppT (ConT ''Maybe) (mkVarT "a")))
-    ,('Left, (AppT 
-              (AppT ArrowT (mkVarT "a"))
-              (AppT 
-               (AppT (ConT ''Either) (mkVarT "a")) 
-               (mkVarT "b"))))
-    ,('Right, (AppT 
-               (AppT ArrowT (mkVarT "b"))
-               (AppT 
-                (AppT (ConT ''Either) (mkVarT "a")) 
-                (mkVarT "b"))))
+    [('(:),     arrowT [varT "a", listT (varT "a"), listT (varT "a")])
+    ,('[],      listT (varT "a") )
+    ,('True,    conT ''Bool )
+    ,('False,   conT ''Bool )
+    ,('Just,    arrowT [varT "a", appT (conT ''Maybe) (varT "a")])
+    ,('Nothing, appT (conT ''Maybe) (varT "a") )
+    ,('Left,    arrowT [varT "a", foldAppT (conT ''Either) [varT "a", varT "b"]])
+    ,('Right,   arrowT [varT "b", foldAppT (conT ''Either) [varT "a", varT "b"]])
hunk ./src/Syntax/Context.hs 147
-    [(''Eq, [ ConT ''Bool
-            , ConT ''Int
-             , ForallT [mkName "a"][mkPred ''Eq "a"] $ AppT ListT (mkVarT "a")
-             , ForallT [mkName "a"][mkPred ''Eq "a"] $ AppT (ConT ''Maybe) (mkVarT "a")
+    [(''Eq, [ conT ''Bool
+            , conT ''Int
+            , forallT ["a"][(''Eq,"a")] $ listT (varT "a")
+            , forallT ["a"][(''Eq,"a")] $ appT (conT ''Maybe) (varT "a")
hunk ./src/Syntax/Context.hs 152
-    ,(''Ord, [ ConT ''Bool
-             , ConT ''Int
-             , ForallT [mkName "a"][mkPred ''Ord "a"] $ AppT ListT (mkVarT "a")
-             , ForallT [mkName "a"][mkPred ''Ord "a"] $ AppT (ConT ''Maybe) (mkVarT "a")
+    ,(''Ord, [ conT ''Bool
+             , conT ''Int
+             , forallT ["a"][(''Ord,"a")] $ listT (varT "a")
+             , forallT ["a"][(''Ord,"a")] $ appT (conT ''Maybe) (varT "a")
hunk ./src/Syntax/Expressions.hs 5
-    TExp(..),
-    mkTConE, foldTAppE, unfoldTAppE ,
+    TExp(..), Lit(..),
+    tConE, tAppE, tInfixE, tListE, tTupE, foldTAppE, unfoldTAppE ,
hunk ./src/Syntax/Expressions.hs 8
-    toPat, fromTExp,
+--    toPat, 
+--    fromTExp,
hunk ./src/Syntax/Expressions.hs 15
-import Language.Haskell.TH (Exp(..), Name, mkName, Lit(..))
+--import Language.Haskell.TH (Exp(..),Lit(..))
hunk ./src/Syntax/Expressions.hs 20
-import Syntax.IFTemplateHaskell hiding (Type)
-import qualified Syntax.IFTemplateHaskell as TH (Type(..),Pat(..))
+import Syntax.Name
+--import Syntax.Ppr
hunk ./src/Syntax/Expressions.hs 35
-import PrettyPrinter
+--import PrettyPrinter
hunk ./src/Syntax/Expressions.hs 37
+data Lit = Char Char
+         | String String
+         | Int Integer
+         | Frac Rational    
+    deriving(Eq, Ord, Show)
+         
hunk ./src/Syntax/Expressions.hs 51
-    | TCondE TExp TExp TExp Type
+--    | TCondE TExp TExp TExp Type
hunk ./src/Syntax/Expressions.hs 70
-    
-instance Pretty TExp where
-    pretty e = pretty_ e <+> colon <> colon <+> pretty (typeOf e)    
-
-pretty_ (TVarE n t)         = pretty (VarE n)
-pretty_ (TConE n t)         = pretty (ConE n)
-pretty_ (TLitE l t)         = pretty (LitE l)
-pretty_ (TAppE e1 e2 t)     = pretty_ e1 <+> pretty_ e2
-pretty_ (TInfixE p1 n p2 t) = hsep [ pretty_ p1, pretty_ n, pretty_ p2]
-pretty_ (TTupE es t)        = tupled (map pretty_ es)
-pretty_ (TListE l t)        = list (map pretty_ l)
-pretty_ (TWildE n t)        = red $ pretty (VarE (mkName ('?':(show n))))    
hunk ./src/Syntax/Expressions.hs 79
-    typeOf (TCondE _ _ _  t) = t
+--    typeOf (TCondE _ _ _  t) = t
hunk ./src/Syntax/Expressions.hs 91
-    sizeS (TCondE c t e _)  = sizeS c . sizeS t . sizeS e
+--    sizeS (TCondE c t e _)  = sizeS c . sizeS t . sizeS e
hunk ./src/Syntax/Expressions.hs 130
-    root (TTupE _ _)                        = mkTTupE
+    root (TTupE _ _)                        = tTupE
hunk ./src/Syntax/Expressions.hs 136
-                    expr             -> TInfixE l (TConE '(:) $ mkArrowT [typeOf l, lt, lt]) expr lt
-    root (TCondE e1 e2 e3 t)                = \[e1, e2, e3] -> TCondE e1 e2 e3 t
-    root (TInfixE l c r t)                  = \[l, r] -> mkTInfixE c l r 
+                    expr             -> TInfixE l (TConE '(:) $ arrowT [typeOf l, lt, lt]) expr lt
+--    root (TCondE e1 e2 e3 t)                = \[e1, e2, e3] -> TCondE e1 e2 e3 t
+    root (TInfixE l c r t)                  = \[l, r] -> tInfixE c l r 
hunk ./src/Syntax/Expressions.hs 148
-    subterms (TCondE e1 e2 e3 _)                = [e1, e2, e3]    
+--    subterms (TCondE e1 e2 e3 _)                = [e1, e2, e3]    
hunk ./src/Syntax/Expressions.hs 173
-    
-    
-           
-fromTExp (TVarE n _)         = VarE n
-fromTExp (TWildE n _)        = VarE (mkName ('?':(show n)))
-fromTExp (TLitE n _)         = LitE n
-fromTExp (TConE n _)         = ConE n
-fromTExp (TListE l _)        = ListE (map fromTExp l)
-fromTExp (TTupE l _)         = TupE (map fromTExp l)
-fromTExp (TAppE a1 a2 _)     = AppE (fromTExp a1) (fromTExp a2)                
-fromTExp (TInfixE e1 e2 e3 _) = 
-    InfixE (Just . fromTExp $ e1)(fromTExp e2)(Just . fromTExp $ e3)
-fromTExp (TCondE i t e _)    = CondE (fromTExp i)(fromTExp t)(fromTExp e)
-    
-toPat (TVarE n _)         = TH.VarP n
-toPat (TLitE l _)         = TH.LitP l
-toPat (TConE n _)         = TH.ConP n []
-toPat (TListE l _)        = TH.ListP (map toPat l)
-toPat (TTupE l _)         = TH.TupP (map toPat l)
-toPat e@(TAppE a1 a2 _)   = 
-    let ((TConE n _):as) =  unfoldTAppE e
-    in  TH.ConP n (map toPat as)                
-toPat (TInfixE l (TConE n _) r _) = 
-    TH.InfixP (toPat l) n (toPat r)
-toPat e = error $ "Cannot translate to Pat: " ++ (show e) 
-    
+   
hunk ./src/Syntax/Expressions.hs 208
-foldTAppE et (e:es) = foldTAppE (mkTAppE et e) es
+foldTAppE et (e:es) = foldTAppE (tAppE et e) es
hunk ./src/Syntax/Expressions.hs 213
-mkTAppE f a = TAppE f a (sectionType . typeOf $ f)
+tAppE f a = TAppE f a (sectionType . typeOf $ f)
hunk ./src/Syntax/Expressions.hs 215
-mkTInfixE c l r = let
+tInfixE c l r = let
hunk ./src/Syntax/Expressions.hs 219
-mkTTupE as = TTupE as (mkTupT (map typeOf as))    
+tTupE as = TTupE as (tupT (map typeOf as))    
hunk ./src/Syntax/Expressions.hs 221
-mkTListE []     = error "mkTListE: empty List"
-mkTListE (e:es) = 
+tListE []     = error "mkTListE: empty List"
+tListE (e:es) = 
hunk ./src/Syntax/Expressions.hs 224
-     []            -> TListE [e] (mkListT . typeOf $ e)
+     []            -> TListE [e] (listT . typeOf $ e)
hunk ./src/Syntax/Expressions.hs 226
-     [expr]        -> mkTInfixE (TConE '(:) $ mkArrowT [ typeOf e
-                                                       , (mkListT . typeOf $ e)
-                                                       , (mkListT . typeOf $ e)]
+     [expr]        -> tInfixE (TConE '(:) $ arrowT [ typeOf e
+                                                       , (listT . typeOf $ e)
+                                                       , (listT . typeOf $ e)]
hunk ./src/Syntax/Expressions.hs 230
-     ls            -> TListE (e:ls)(mkListT . typeOf $ e)
+     ls            -> TListE (e:ls)(listT . typeOf $ e)
hunk ./src/Syntax/Expressions.hs 233
-mkTConE n argtys = TConE n (mkArrowT argtys)
+tConE n argtys = TConE n (arrowT argtys)
hunk ./src/Syntax/Expressions.hs 238
-mkTCondE i t e = TCondE i t e (typeOf e)
+--mkTCondE i t e = TCondE i t e (typeOf e)
hunk ./src/Syntax/IFTemplateHaskell.hs 1
-{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell  #-}
-module Syntax.IFTemplateHaskell (
-    
-       
-    isTuple, isNil, isCons,--  Name, mkName,
-    
-    module Language.Haskell.TH,
-    module Language.Haskell.TH.Ppr,
---    module Language.Haskell.TH.Syntax,
-    )where
-
-import Language.Haskell.TH ( Dec (FunD)
-                           , Clause (Clause)
-                           , Body (NormalB)
-                           , Exp (VarE, ConE, LitE, ListE, TupE, InfixE, AppE)
-                           , Pat (VarP, ConP, LitP, ListP, TupP, InfixP) 
---                           , Q(..)
-                           , Lit (..)
-                           , Name, mkName
-                           , Type (ForallT, VarT, ConT, TupleT, ArrowT, ListT, AppT)
---                           , Cxt
-                           ) 
-                           
-import Language.Haskell.TH.Syntax hiding (lift)                     
---import Language.Haskell.TH.Syntaxf (TySynD, SigD, Stmt, Loc, RecP, AsP, WildP
---                           , TildeP, FieldExp, LamE, LetE, CondE, RecConE
---                           , RecUpdE, ArithSeqE, FromR, ArithSeqE, FromToR
---                           , ArithSeqE, FromThenR, ArithSeqE, FromThenToR, SigE
---                           , BindS, NoBindS, LetS, Strict, IsStrict, NotStrict
---                           , ValD, GuardedB, NormalG, Guard, PatG)
-import Language.Haskell.TH.Ppr (pprint,ppr)
-
-
-deriving instance Ord Range
-deriving instance Ord Match
-deriving instance Ord Dec
-deriving instance Ord Type
-deriving instance Ord Lit
-deriving instance Ord Stmt
-deriving instance Ord Foreign
-deriving instance Ord FunDep
-deriving instance Ord Con
-deriving instance Ord Clause
-deriving instance Ord Body
-deriving instance Ord Guard
-deriving instance Ord Strict
-deriving instance Ord Safety
-deriving instance Ord Callconv
-deriving instance Ord Pat
-deriving instance Ord Exp
-
-
-
-isTuple :: Name -> Int -> Bool
-isTuple n i
-    | i == 2  = n == '(,)
-    | i == 3  = n == '(,,)
-    | i == 4  = n == '(,,,)
-    | i == 5  = n == '(,,,,)
-    | i == 6  = n == '(,,,,,)
-    | i == 7  = n == '(,,,,,,)
-    | i == 8  = n == '(,,,,,,,)
-    | i == 9  = n == '(,,,,,,,,)
-    | i == 10  = n == '(,,,,,,,,,)
-    | i == 11  = n == '(,,,,,,,,,,)
-    | i == 12  = n == '(,,,,,,,,,,,)
-    | i == 13  = n == '(,,,,,,,,,,,,)
-    | i == 14  = n == '(,,,,,,,,,,,,,)
-    | i == 15  = n == '(,,,,,,,,,,,,,,)
-    
-isNil :: Name -> Bool
-isNil = (==) '[]
-
-isCons :: Name -> Bool
-isCons = (==) '(:)
-   
-             
+
rmfile ./src/Syntax/IFTemplateHaskell.hs
hunk ./src/Syntax/Specification.hs 9
+import Syntax.Name
hunk ./src/Syntax/Specification.hs 19
-import PrettyPrinter
+--import PrettyPrinter
hunk ./src/Syntax/Specification.hs 24
-type Equation = ([TExp], TExp)
+
+data Equation = UnGuardEq  [TExp] TExp 
+              | GuardedEq  [TExp] [(TExp,TExp)]  
+    deriving(Eq,Ord,Show)
+               
+mkEq  = UnGuardEq
+mkGEq = GuardedEq
+            
+data FunBind  = FunB  Name [Equation]
+    deriving(Eq,Ord,Show)
+
+mkFB = FunB   
+fName (FunB n _ ) = n
+fEqus (FunB _ e ) = e
hunk ./src/Syntax/Specification.hs 55
-getBindings :: [Name] -> Specification -> Either String [(Name, [Equation])]
+getBindings :: [Name] -> Specification -> Either String [FunBind]
hunk ./src/Syntax/Specification.hs 65
-getBinding :: (Monad m) => Specification -> Name -> m (Name, [Equation])
+getBinding :: (Monad m) => Specification -> Name -> m FunBind
hunk ./src/Syntax/Specification.hs 68
-        Just rs -> return (n,rs)
+        Just rs -> return $ FunB n rs
hunk ./src/Syntax/Specification.hs 71
-addToBindings :: [(Name, [Equation])] -> Specification -> Specification
+addToBindings :: [FunBind] -> Specification -> Specification
hunk ./src/Syntax/Specification.hs 74
-    add ctx (n,cs) = 
+    add ctx fb = 
hunk ./src/Syntax/Specification.hs 76
-        in ctx{spec_bindings = Map.insert n cs bindings}
+        in ctx{spec_bindings = Map.insert (fName fb) (fEqus fb) bindings}
hunk ./src/Syntax/Specification.hs 110
-instance Pretty Specification where
-    pretty ctx = linebreak <$> text "Context: " <$>
-               (indent 2 $ text "Bindings: " <$> indent 2 (pretty (spec_bindings ctx)) <$>
-                           text "Types   : " <$> indent 2 (pretty (spec_types ctx)) <$>
-                           text "Ctors   : " <$> indent 2 (pretty (spec_ctors ctx)) <$>
-                           text "Classes : " <$> indent 2 (pretty (spec_classes ctx)) <$>
-                           text "Members : " <$> indent 2 (pretty (spec_members ctx)) <$>
-                           text "Instancs: " <$> indent 2 (pretty (spec_instances ctx)) <$>
-                           text "Synonyms: " <$> indent 2 (pretty (spec_typesyns ctx)))
-        
-    
hunk ./src/Syntax/Type.hs 18
-    Type(..),
+    Type (..),
hunk ./src/Syntax/Type.hs 23
-    mkAppT, mkArrowT, mkVarT, mkListT, mkTupT, mkInfixT, sectionType, 
+    appT, arrowT, varT, conT, forallT, listT, tupT, infixT, sectionType, 
hunk ./src/Syntax/Type.hs 45
-import Syntax.IFTemplateHaskell (isNil, isCons, isTuple,Name, mkName)
-import qualified Language.Haskell.TH.Syntax as TH( Type(..) )
+import Syntax.Name
+--import qualified Language.Haskell.TH.Syntax as TH( Type(..) )
hunk ./src/Syntax/Type.hs 73
-mkPred n v = AppT (ConT n) (mkVarT v)
+mkPred n v = AppT (ConT n) (varT v)
hunk ./src/Syntax/Type.hs 107
-        [] -> error $ "Types.sectionType: no function type " ++ (show . pretty $ t)
-        tl -> mkArrowT tl
+        [] -> error $ "Types.sectionType: no function type " ++ (show t)
+        tl -> arrowT tl
hunk ./src/Syntax/Type.hs 112
-mkVarT = VarT . mkName
+varT = VarT . mkName
+conT = ConT
hunk ./src/Syntax/Type.hs 120
-mkArrowT :: [Type] -> Type
-mkArrowT []  = error "Types.mkArrowT: empty list of types"
-mkArrowT [t] = t
-mkArrowT ts  = foldr1 apArrowT ts
+arrowT :: [Type] -> Type
+arrowT []  = error "Types.mkArrowT: empty list of types"
+arrowT [t] = t
+arrowT ts  = foldr1 apArrowT ts
hunk ./src/Syntax/Type.hs 128
+forallT vs ps t = fixType $ ForallT (map mkName vs)(map (uncurry mkPred) ps) t
hunk ./src/Syntax/Type.hs 131
-mkListT :: Type -> Type
-mkListT = AppT ListT
+listT :: Type -> Type
+listT = AppT ListT
hunk ./src/Syntax/Type.hs 134
-mkTupT :: [Type] -> Type
-mkTupT l = foldAppT (TupleT . length $ l) l
+tupT :: [Type] -> Type
+tupT l = foldAppT (TupleT . length $ l) l
hunk ./src/Syntax/Type.hs 137
-mkInfixT :: Type -> Type -> Type -> Type
-mkInfixT ct at1 at2 = sectionType . sectionType $ ct
+infixT :: Type -> Type -> Type -> Type
+infixT ct at1 at2 = sectionType . sectionType $ ct
hunk ./src/Syntax/Type.hs 141
-mkAppT :: Type -> Type -> Type
-mkAppT (ForallT _ c1 t1)(ForallT _ c2 t2) = quantify (AppT t1 t2) (c1++c2)
-mkAppT  t1              (ForallT _ c t2)  = quantify (AppT t1 t2) c
-mkAppT (ForallT _ c t1)  t2               = quantify (AppT t1 t2) c
-mkAppT  t1               t2               = AppT t1 t2
+appT :: Type -> Type -> Type
+appT (ForallT _ c1 t1)(ForallT _ c2 t2) = quantify (AppT t1 t2) (c1++c2)
+appT  t1              (ForallT _ c t2)  = quantify (AppT t1 t2) c
+appT (ForallT _ c t1)  t2               = quantify (AppT t1 t2) c
+appT  t1               t2               = AppT t1 t2
hunk ./src/Syntax/Type.hs 149
-foldAppT t ts = foldl' mkAppT t ts
+foldAppT t ts = foldl' appT t ts
hunk ./src/Syntax/Type.hs 177
---------------------------------------------------------------------------------
--- PrettyPrinting Types
-
-    
-instance Pretty Type where
-    pretty (ForallT tvars ctxt ty) = 
-            text "forall" <+> hsep (map pretty tvars) <+> text "."
-                          <+> pprCxt ctxt <+> pretty ty
-    pretty ty = pprTyApp (split ty)
-
------------------------------------------
--- PrettyPrinting Au
--- Stolen from Language.Haskell.TH.PPr
-
-pprParendType :: Type -> Doc
-pprParendType (VarT v)   = pretty v
-pprParendType (ConT c)   = pretty c
-pprParendType (TupleT 0) = text "()"
-pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma))
-pprParendType ArrowT     = parens (text "->")
-pprParendType ListT      = text "[]"
-pprParendType other      = parens (pretty other)
-
-pprTyApp :: (Type, [Type]) -> Doc
-pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", pretty arg2]
-pprTyApp (ListT, [arg]) = brackets (pretty arg)
-pprTyApp (TupleT n, args)
- | length args == n = parens (sep (punctuate comma (map pretty args)))
-pprTyApp (fun, []) = pprParendType fun
-pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args)
-
-pprFunArgType :: Type -> Doc    -- Should really use a precedence argument
--- Everything except forall and (->) binds more tightly than (->)
-pprFunArgType ty@(ForallT {})                 = parens (pretty ty)
-pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (pretty ty)
-pprFunArgType ty                              = pretty ty
-
-split :: Type -> (Type, [Type])    -- Split into function and args
-split t = go t []
-    where go (AppT t1 t2) args = go t1 (t2:args)
-          go ty           args = (ty, args)
-          
-pprCxt :: TyCxt -> Doc
-pprCxt []  = empty
-pprCxt [t] = pretty t <+> text "=>"
-pprCxt ts  = parens (hsep $ punctuate comma $ map pretty ts) <+> text "=>"
-
------------------------------------------
hunk ./src/Syntax/Type.hs 204
-    root (AppT _ _)       = \[l,r] -> mkAppT l r
+    root (AppT _ _)       = \[l,r] -> appT l r
hunk ./src/Syntax/Type.hs 220
-  apply s (AppT l r)      = mkAppT (apply s l) (apply s r)  
+  apply s (AppT l r)      = appT (apply s l) (apply s r)  
hunk ./src/Syntax/Type.hs 281
--- TODO : The following functions may not be correct, but it works for now. 
--- they should use Unifieable, but then I have the Context. Maybe I use the 
--- standard context as default
- 
-
-
-   
-
-
-
hunk ./src/Syntax/UnifyExp.hs 17
+import Syntax.Name
hunk ./src/Syntax/UnifyExp.hs 19
+import Syntax.Ppr
hunk ./src/Syntax/UnifyExp.hs 22
-import PrettyPrinter
hunk ./src/Syntax/UnifyTy.hs 19
+import Syntax.Name
hunk ./src/Syntax/UnifyTy.hs 21
+import Syntax.Ppr
hunk ./src/Syntax/UnifyTy.hs 23
-import PrettyPrinter
hunk ./src/Syntax/UnifyTy.hs 189
-    var <- return . (flip quantify cxt)  . mkVarT $ vnm
+    var <- return . (flip quantify cxt)  . varT $ vnm
