Fri Feb 27 14:39:06 WET 2009 hpacheco@di.uminho.pt
* conformity with haskell-src-exts 0.4.8
{
hunk ./DrHylo.cabal 26
- Build-Depends: base >= 4, pointless-haskell, mtl, haskell-src-exts == 0.4.4.1, syb
+ Build-Depends: base >= 4, pointless-haskell, mtl, haskell-src-exts == 0.4.8, syb
hunk ./src/DrHylo.hs 122
-pwpfDecl f d (PatBind loc (PVar (Ident name)) (UnGuardedRhs rhs) (BDecls [])) =
+pwpfDecl f d (PatBind loc (PVar (Ident name)) mtyp (UnGuardedRhs rhs) (BDecls [])) =
hunk ./src/DrHylo.hs 140
- return (PatBind loc (PVar (Ident name)) (UnGuardedRhs rhs') (BDecls []),ob)
+ return (PatBind loc (PVar (Ident name)) mtyp (UnGuardedRhs rhs') (BDecls []),ob)
hunk ./src/FunctorOf.hs 159
- DataDecl loc dn ctx hsName lName lConDecl (nub $ UnQual typeable : derive)
+ DataDecl loc dn ctx hsName lName lConDecl (nub $ (UnQual typeable,[]) : derive)
hunk ./src/FunctorOf.hs 175
- match str (a,b) = Exts.Match mkLoc (Ident str) [a]
+ match str (a,b) = Exts.Match mkLoc (Ident str) [a] Nothing
hunk ./src/FunctorOf.hs 210
-getObservableInst loc cts a = InstDecl loc ctx (UnQual (Ident "Observable")) [a] [InsDecl (FunBind [Exts.Match loc (Ident "observer") [PVar (Ident "x")] (UnGuardedRhs (App (App (Exts.Var (UnQual (Ident "send"))) (Lit (String ""))) (Paren (InfixApp (InfixApp (App (App (App (Exts.Var (UnQual (Ident "omap"))) (Paren (ExpTypeSig loc (Exts.Var (UnQual (Ident "_L"))) a))) (Exts.Var (UnQual (Ident "thk")))) (Paren (App (Exts.Var (UnQual (Ident "out"))) (Exts.Var (UnQual (Ident "x")))))) (QVarOp (UnQual (Symbol ">>="))) (Exts.Var (UnQual (Ident "return")))) (QVarOp (UnQual (Symbol "."))) (Exts.Var (UnQual (Ident "inn"))))))) (BDecls [PatBind loc (PVar (Ident "thk")) (UnGuardedRhs (ExpTypeSig loc (Exts.Var (UnQual (Ident "thunk"))) thunkSig )) (BDecls [])])])]
+getObservableInst loc cts a = InstDecl loc ctx (UnQual (Ident "Observable")) [a] [InsDecl (FunBind [Exts.Match loc (Ident "observer") [PVar (Ident "x")] Nothing (UnGuardedRhs (App (App (Exts.Var (UnQual (Ident "send"))) (Lit (String ""))) (Paren (InfixApp (InfixApp (App (App (App (Exts.Var (UnQual (Ident "omap"))) (Paren (ExpTypeSig loc (Exts.Var (UnQual (Ident "_L"))) a))) (Exts.Var (UnQual (Ident "thk")))) (Paren (App (Exts.Var (UnQual (Ident "out"))) (Exts.Var (UnQual (Ident "x")))))) (QVarOp (UnQual (Symbol ">>="))) (Exts.Var (UnQual (Ident "return")))) (QVarOp (UnQual (Symbol "."))) (Exts.Var (UnQual (Ident "inn"))))))) (BDecls [PatBind loc (PVar (Ident "thk")) Nothing (UnGuardedRhs (ExpTypeSig loc (Exts.Var (UnQual (Ident "thunk"))) thunkSig )) (BDecls [])])])]
hunk ./src/Matching.hs 24
- (UnGuardedRhs newMs) (BDecls [])
- where getName (Match _ name _ _ _) = name
+ Nothing (UnGuardedRhs newMs) (BDecls [])
+ where getName (Match _ name _ _ _ _) = name
hunk ./src/Matching.hs 29
-cas_matches ms@((Match _ _ pats _ _):_)
+cas_matches ms@((Match _ _ pats _ _ _):_)
hunk ./src/Matching.hs 41
-cas_alt (Match l _ pats expRhs (BDecls ds))
+cas_alt (Match l _ pats _ expRhs (BDecls ds))
}
Sat Dec 20 11:40:04 WET 2008 hpacheco@di.uminho.pt
* refined with HLint 0.1
{
hunk ./DrHylo.cabal 2
-Version: 0.0.1
+Version: 0.0.2
hunk ./Sample.hs 4
-comp (f,g) y = f (g y)
+comp (f,g) = f . g
hunk ./Sample.hs 49
-cat (h:t) l = h:(cat t l)
+cat (h:t) l = h : cat t l
hunk ./Sample.hs 55
-inorder (Node x l r) = cat (inorder l) (x:(inorder r))
+inorder (Node x l r) = cat (inorder l) (x : inorder r)
hunk ./lib/Language/Pointfree/Parser.hs 5
+import Control.Monad
hunk ./lib/Language/Pointfree/Parser.hs 38
- = hs2pf e >>= return . Curry
+ = liftM Curry (hs2pf e)
hunk ./lib/Language/Pointfree/Parser.hs 80
- = hs2func e >>= return . Fix
+ = liftM Fix (hs2func e)
hunk ./lib/Language/Pointfree/Parser.hs 84
- = hs2type e >>= return . Const
+ = liftM Const (hs2type e)
hunk ./lib/Language/Pointfree/Pretty.hs 43
- (showsPrec 10 aa . showString (" "++(init sym)++" ") . showsPrec 10 ab)
+ (showsPrec 10 aa . showString (" " ++ init sym ++ " ") . showsPrec 10 ab)
hunk ./lib/Language/Pointfree/Pretty.hs 58
- show (Fix (Const One :++: (Const a :**: Id))) = "["++(show a)++"]"
- show (Fix t) = "Fix ("++(show t)++")"
- show (t :*: u) = "("++(show t)++","++(show u)++")"
- show (t :+: u) = "Either ("++(show t)++") ("++(show u)++")"
- show (t :-> u) = "("++(show t)++" -> "++(show u)++")"
+ show (Fix (Const One :++: (Const a :**: Id))) = "[" ++ show a ++ "]"
+ show (Fix t) = "Fix (" ++ show t ++ ")"
+ show (t :*: u) = "(" ++ show t ++ "," ++ show u ++ ")"
+ show (t :+: u) = "Either (" ++ show t ++ ") (" ++ show u ++ ")"
+ show (t :-> u) = "(" ++ show t ++ " -> " ++ show u ++ ")"
hunk ./lib/Language/Pointfree/Pretty.hs 67
- show (Const t) = "Const ("++(show t)++")"
- show (f :**: g) = "("++(show f)++" :*: "++(show g)++")"
- show (f :++: g) = "("++(show f)++" :+: "++(show g)++")"
+ show (Const t) = "Const (" ++ show t ++ ")"
+ show (f :**: g) = "(" ++ show f ++ " :*: " ++ show g ++ ")"
+ show (f :++: g) = "(" ++ show f ++ " :+: " ++ show g ++ ")"
hunk ./lib/Language/Pointwise/Matching.hs 4
-import Data.Generics hiding (Unit,(:*:),Inl,Inr)
+import Data.Generics hiding (Unit,Inl,Inr)
hunk ./lib/Language/Pointwise/Matching.hs 20
- return (x ++ (show seed))
+ return (x ++ show seed)
hunk ./lib/Language/Pointwise/Matching.hs 33
- guard (null (free e `intersect` concat (map free (map fst l))))
+ guard (null (free e `intersect` concatMap (free . fst) l))
hunk ./lib/Language/Pointwise/Matching.hs 36
- rightmatch = map (nomatch . (Match (Snd e)) . map (pwSnd . fst /\ snd)) aux
+ rightmatch = map (nomatch . Match (Snd e) . map (pwSnd . fst /\ snd)) aux
hunk ./lib/Language/Pointwise/Matching.hs 63
-mygroup f (h:t) = (h : filter (\x -> f x h) t):(mygroup f (filter (\x -> not (f x h)) t))
+mygroup f (h:t) = (h : filter (\x -> f x h) t) : mygroup f (filter (\x -> not (f x h)) t)
hunk ./lib/Language/Pointwise/Parser.hs 7
+import Control.Monad
hunk ./lib/Language/Pointwise/Parser.hs 28
-hs2pw (Exts.Var(UnQual(Ident "undefined"))) = return $ Unit
-hs2pw (Exts.Var(UnQual(Ident "_L"))) = return $ Unit
+hs2pw (Exts.Var(UnQual(Ident "undefined"))) = return Unit
+hs2pw (Exts.Var(UnQual(Ident "_L"))) = return Unit
hunk ./lib/Language/Pointwise/Parser.hs 33
- = hs2pw exp >>= return . In
+ = liftM In (hs2pw exp)
hunk ./lib/Language/Pointwise/Parser.hs 35
- = hs2pw exp >>= return . Out
+ = liftM Out (hs2pw exp)
hunk ./lib/Language/Pointwise/Parser.hs 41
- return $ ((Const ":") :@: t1) :@: t2
+ return $ (Const ":" :@: t1) :@: t2
hunk ./lib/Language/Pointwise/Parser.hs 46
- return $ ((Const ":") :@: e) :@: es
+ return $ (Const ":" :@: e) :@: es
hunk ./lib/Language/Pointwise/Syntax.hs 3
-import Data.Generics hiding (Unit,(:*:),Inl,Inr)
+import Data.Generics hiding (Unit,Inl,Inr)
hunk ./lib/Language/Pointwise/Syntax.hs 68
- let x = concat (concat (map free (e : map snd s)))
+ let x = concat (concatMap free (e : map snd s))
hunk ./lib/Language/Pointwise/Syntax.hs 90
-distr = Lam "x" (Match (Var "x") [(Var "y" :&: (Inl (Var "z")),Inl (Var "y" :&: Var "z")),(Var "y" :&: (Inr (Var "z")),Inr (Var "y" :&: Var "z"))])
+distr = Lam "x" (Match (Var "x") [(Var "y" :&: Inl (Var "z"),Inl (Var "y" :&: Var "z")),(Var "y" :&: Inr (Var "z"),Inr (Var "y" :&: Var "z"))])
hunk ./src/DrHylo.hs 32
-options = [Option ['o'] ["output"] (OptArg outp "FILE") "output FILE",
- Option ['i'] ["input"] (OptArg inp "FILE") "input FILE",
- Option ['f'] ["fix"] (NoArg Fixify) "use fixpoints instead of hylomorphisms",
- Option ['w'] ["pointwise"] (NoArg Pointwise) "do not convert to point-free",
- Option ['O'] ["observable"] (NoArg Observable) "generate observable hylomorphisms"
+options = [Option "o" ["output"] (OptArg outp "FILE") "output FILE",
+ Option "i" ["input"] (OptArg inp "FILE") "input FILE",
+ Option "f" ["fix"] (NoArg Fixify) "use fixpoints instead of hylomorphisms",
+ Option "w" ["pointwise"] (NoArg Pointwise) "do not convert to point-free",
+ Option "O" ["observable"] (NoArg Observable) "generate observable hylomorphisms"
hunk ./src/DrHylo.hs 44
-parseOpts opts = case (getOpt Permute options opts) [_$_]
+parseOpts opts = case getOpt Permute options opts
hunk ./src/DrHylo.hs 73
-parse s = case (parseModule s) [_$_]
+parse s = case parseModule s
hunk ./src/DrHylo.hs 75
- ParseFailed l d -> fail ((show l)++": "++d)
+ ParseFailed l d -> fail (show l ++ ": " ++ d)
hunk ./src/DrHylo.hs 95
- inst cl a b = map (mkInsVar cl) (vars a b)
+ inst cl a = map (mkInsVar cl) . vars a
hunk ./src/DrHylo.hs 111
- decls'' = if (obrequired f) then foldr addTypeableObservableIns decls' obs else decls'
- pragmaNames = if (obrequired f) then ["TypeFamilies,","DeriveDataTypeable"] else ["TypeFamilies"]
+ decls'' = if obrequired f then foldr addTypeableObservableIns decls' obs else decls'
+ pragmaNames = if obrequired f then ["TypeFamilies,","DeriveDataTypeable"] else ["TypeFamilies"]
hunk ./src/DrHylo.hs 126
- pw2 <- return (if (name `elem` free pw1) [_$_]
+ pw2 <- return (if name `elem` free pw1
hunk ./src/DrHylo.hs 130
- (rhs',ob) <- return (if (pwrequired f)
+ (rhs',ob) <- return (if pwrequired f
hunk ./src/DrHylo.hs 132
- else if (not (fixrequired f)) && (derivable pw3)
+ else if not (fixrequired f) && derivable pw3
hunk ./src/DrHylo.hs 137
- hyl = if (obrequired f) then HyloO else Hylo
+ hyl = if obrequired f then HyloO else Hylo
hunk ./src/DrHylo.hs 159
- aux' = aux b \\ (map getImportName imports) [_$_]
- imports' = imports++(map mkImportDecl aux')
+ aux' = aux b \\ map getImportName imports
+ imports' = imports ++ map mkImportDecl aux'
hunk ./src/FunctorOf.hs 17
-import Data.Generics hiding (Unit,(:*:),Inl,Inr)
+import Data.Generics hiding (Unit,Inl,Inr)
hunk ./src/FunctorOf.hs 48
-buildArgs f n = let v = "x"++(show n)
+buildArgs f n = let v = 'x' : show n
hunk ./src/FunctorOf.hs 63
- in Module a b c d e i (newDecls)
+ in Module a b c d e i newDecls
hunk ./src/FunctorOf.hs 72
-gCon arg (ConDecl _ lBangType) = mapM (h arg) lBangType >>= return . foldr1 timesType
+gCon arg (ConDecl _ lBangType) = liftM (foldr1 timesType) (mapM (h arg) lBangType)
hunk ./src/FunctorOf.hs 83
-i arg (TyTuple _ lType) = mapM (ii arg) lType >>= return . foldr1 timesType
-i arg (TyApp hsType1 hsType2) = i arg hsType2 >>= return . appType hsType1
+i arg (TyTuple _ lType) = liftM (foldr1 timesType) (mapM (ii arg) lType)
+i arg (TyApp hsType1 hsType2) = liftM (appType hsType1) (i arg hsType2)
hunk ./src/FunctorOf.hs 95
-genInOut arg l = mapM (g' arg) l >>= return . genPat
+genInOut arg l = liftM genPat (mapM (g' arg) l)
hunk ./src/FunctorOf.hs 186
-opType op a b = TyApp (TyApp (TyVar $ Symbol op) a ) b
+opType op = TyApp . TyApp (TyVar $ Symbol op)
hunk ./src/FunctorOf.hs 206
- modify (\_->((seed,n+1),l))
+ modify (const ((seed,n+1),l))
hunk ./src/Hylos.hs 14
- (f `notElem` free m) && (branch n) && (branch o)
+ (f `notElem` free m) && branch n && branch o
hunk ./src/Hylos.hs 35
- return (x ++ (show seed))
+ return (x ++ show seed)
hunk ./src/Hylos.hs 45
- aux (Var x) = getVar "a" >>= return . Pointfree.Const . Base
+ aux (Var x) = liftM (Pointfree.Const . Base) (getVar "a")
hunk ./src/Hylos.hs 69
- in (Case l (Lam x (Inl f)) (Lam y (Inr g)))
+ in Case l (Lam x (Inl f)) (Lam y (Inr g))
hunk ./src/Hylos.hs 78
- in (f :&: g)
+ in f :&: g
hunk ./src/Hylos.hs 83
- in (f :&: g)
+ in f :&: g
hunk ./src/Hylos.hs 98
- in (Case (Var p) (Lam vl f) (Lam vr g))
+ in Case (Var p) (Lam vl f) (Lam vr g)
hunk ./src/Hylos.hs 105
- in (f :@: g)
+ in f :@: g
hunk ./src/Hylos.hs 108
- in (f :@: g)
+ in f :@: g
hunk ./src/Hylos.hs 111
- in (f :@: g)
+ in f :@: g
hunk ./src/Hylos.hs 114
- in (f :&: g)
+ in f :&: g
hunk ./src/Hylos.hs 117
- in (f :&: g)
+ in f :&: g
hunk ./src/Hylos.hs 120
- in (f :&: g)
+ in f :&: g
hunk ./src/Matching.hs 36
- buildPVars n v = Lambda mkLoc [mkPVar $ v ++ show n] . (buildPVars (n-1) v)
+ buildPVars n v = Lambda mkLoc [mkPVar $ v ++ show n] . buildPVars (n-1) v
}
Tue Dec 9 10:15:17 WET 2008 hpacheco@di.uminho.pt
* Avoid duplicate instance contexts
hunk ./src/FunctorOf.hs 171
- let observableInst = getObservableInst loc consts arg
+ let observableInst = getObservableInst loc (nub consts) arg
Tue Dec 9 04:32:09 WET 2008 hpacheco@di.uminho.pt
* Corrected Observable dependencies
{
hunk ./DrHylo.cabal 26
- Build-Depends: base >= 4, pointless-haskell, mtl, haskell-src-exts >= 0.4.4, syb
+ Build-Depends: base >= 4, pointless-haskell, mtl, haskell-src-exts == 0.4.4.1, syb
hunk ./Sample.hs 51
-data Tree a = Leaf | Node a (Tree a) (Tree a)
+data Tree a = Leaf | Node a (Tree a) (Tree a) deriving Show
hunk ./src/DrHylo.hs 89
-observableTypeSig :: Decl -> Decl
-observableTypeSig (TypeSig loc names t) = TypeSig loc names (aux t)
+addTypeSig :: Decl -> Decl
+addTypeSig (TypeSig loc names t) = TypeSig loc names (aux t)
hunk ./src/DrHylo.hs 92
- aux (TyForall mb ctx (TyFun a b)) = TyForall mb (ctx++obs a b) (TyFun a b)
- aux (TyFun a b) = TyForall Nothing (obs a b) (TyFun a b)
+ aux (TyForall mb ctx (TyFun a b)) = TyForall mb (ctx++inst typeable a b++inst observable a b) (TyFun a b)
+ aux (TyFun a b) = TyForall Nothing (inst typeable a b++inst observable a b) (TyFun a b)
hunk ./src/DrHylo.hs 95
- obs a b = map mkObservableIns (vars a b)
+ inst cl a b = map (mkInsVar cl) (vars a b)
hunk ./src/DrHylo.hs 97
-mkObservableIns :: Name -> Asst
-mkObservableIns n = ClassA (UnQual (Ident "Observable")) [TyVar n]
+mkInsVar :: Name -> Name -> Asst
+mkInsVar cl n = ClassA (UnQual cl) [TyVar n]
hunk ./src/DrHylo.hs 100
-addObservableIns :: String -> [Decl] -> [Decl]
-addObservableIns n [] = []
-addObservableIns n (d:ds) = if (isTypeSig n d) then observableTypeSig d : ds else d : addObservableIns n ds
+addTypeableObservableIns :: String -> [Decl] -> [Decl]
+addTypeableObservableIns n [] = []
+addTypeableObservableIns n (d:ds) | isTypeSig n d = addTypeSig d : addTypeableObservableIns n ds
+ | otherwise = d : addTypeableObservableIns n ds
hunk ./src/DrHylo.hs 108
-pwpfModule f c (Module loc name pragmas warnings exports imports decls) = Module loc name pragmas warnings exports imports decls''
+pwpfModule f c (Module loc name pragmas warnings exports imports decls) = Module loc name pragmas' warnings exports imports decls''
hunk ./src/DrHylo.hs 111
- decls'' = foldr addObservableIns decls' obs
+ decls'' = if (obrequired f) then foldr addTypeableObservableIns decls' obs else decls'
+ pragmaNames = if (obrequired f) then ["TypeFamilies,","DeriveDataTypeable"] else ["TypeFamilies"]
+ pragmas' = LanguagePragma loc (map Ident pragmaNames) : pragmas
hunk ./src/DrHylo.hs 157
- let aux True = ["Generics.Pointless.Combinators", "Generics.Pointless.Functors", "Generics.Pointless.RecursionPatterns", "Debug.Observe","Generics.Pointless.Observe.Functors", "Generics.Pointless.Observe.RecursionPatterns"]
+ let aux True = ["Generics.Pointless.Combinators", "Generics.Pointless.Functors", "Generics.Pointless.RecursionPatterns", "Data.Typeable", "Debug.Observe", "Generics.Pointless.Observe.Functors", "Generics.Pointless.Observe.RecursionPatterns"]
hunk ./src/DrHylo.hs 176
- hsModule2 <- return (pwpfModule flags (getCtx hsModule0) hsModule1)
+ hsModule2 <- return (pwpfModule flags (getCtx hsModule1) hsModule1)
hunk ./src/FunctorOf.hs 6
+ , typeable
+ , observable
hunk ./src/FunctorOf.hs 53
-type St = StateT (String,Int) Maybe
+type St = StateT ((String,Int),[Type]) Maybe
hunk ./src/FunctorOf.hs 62
- map (\x -> evalStateT (getInstances ob x) (seed,0)) decls
- in Module a b c d e i (decls ++ newDecls)
+ map (\x -> evalStateT (getInstances ob x) ((seed,0),[])) decls
+ in Module a b c d e i (newDecls)
+
+addConst t = modify (\(s,l) -> (s,t:l))
hunk ./src/FunctorOf.hs 86
-i arg t@(TyVar hsName) = return $ TyApp (TyCon $ UnQual $ Ident "Const") t
-i arg t@(TyCon hsQName) = return $ TyApp (TyCon $ UnQual $ Ident "Const") t
+i arg t@(TyVar hsName) = addConst t >> (return $ TyApp (TyCon $ UnQual $ Ident "Const") t)
+i arg t@(TyCon hsQName) = addConst t >> (return $ TyApp (TyCon $ UnQual $ Ident "Const") t)
hunk ./src/FunctorOf.hs 150
-getDataDeclFunctor :: Type -> [QualConDecl] -> St Type
-getDataDeclFunctor arg lConDecl = do
+getDataDeclFunctor :: Type -> [QualConDecl] -> St (Type,[Type])
+getDataDeclFunctor arg lConDecl = withStateT (\((s,n),_) -> ((s,n),[])) $ do
hunk ./src/FunctorOf.hs 154
- return functor
+ (_,consts) <- get
+ return (functor,consts)
+
+deriveTypeable :: Decl -> Decl
+deriveTypeable (DataDecl loc dn ctx hsName lName lConDecl derive) =
+ DataDecl loc dn ctx hsName lName lConDecl (nub $ UnQual typeable : derive)
hunk ./src/FunctorOf.hs 166
- functor <- getDataDeclFunctor arg lConDecl
+ (functor,consts) <- getDataDeclFunctor arg lConDecl
hunk ./src/FunctorOf.hs 171
- let observableInst = getObservableInst loc arg
- if ob then return [pfTInst,muInst,observableInst]
- else return [pfTInst,muInst]
+ let observableInst = getObservableInst loc consts arg
+ if ob then return [deriveTypeable d,pfTInst,muInst,observableInst]
+ else return [d,pfTInst,muInst]
hunk ./src/FunctorOf.hs 183
-getInstances _ _ = fail "not a data declaration"
+getInstances _ d = return [d]
hunk ./src/FunctorOf.hs 190
-constNil = TyApp (TyCon $ UnQual $ Ident "Const") (TyCon $ UnQual $ Ident "One")
+constNil = TyApp (TyCon $ UnQual $ Ident "Const") nil
+nil = TyCon $ UnQual $ Ident "One"
hunk ./src/FunctorOf.hs 205
- (seed,n) <- gets id
- modify (\_->(seed,n+1))
+ ((seed,n),l) <- gets id
+ modify (\_->((seed,n+1),l))
hunk ./src/FunctorOf.hs 209
-getObservableInst :: SrcLoc -> Type -> Decl
-getObservableInst loc a = InstDecl loc [ClassA (UnQual (Ident "FunctorO")) [TyApp (TyCon (UnQual (Ident "PF"))) a]] (UnQual (Ident "Observable")) [a] [InsDecl (FunBind [Exts.Match loc (Ident "observer") [PVar (Ident "x")] (UnGuardedRhs (App (App (Exts.Var (UnQual (Ident "send"))) (Lit (String ""))) (Paren (InfixApp (InfixApp (App (App (App (Exts.Var (UnQual (Ident "omap"))) (Paren (ExpTypeSig loc (Exts.Var (UnQual (Ident "_L"))) a))) (Exts.Var (UnQual (Ident "thk")))) (Paren (App (Exts.Var (UnQual (Ident "out"))) (Exts.Var (UnQual (Ident "x")))))) (QVarOp (UnQual (Symbol ">>="))) (Exts.Var (UnQual (Ident "return")))) (QVarOp (UnQual (Symbol "."))) (Exts.Var (UnQual (Ident "inn"))))))) (BDecls [PatBind loc (PVar (Ident "thk")) (UnGuardedRhs (ExpTypeSig loc (Exts.Var (UnQual (Ident "thunk"))) (TyFun a (TyApp (TyCon (UnQual (Ident "ObserverM"))) a)))) (BDecls [])])])]
+getObservableInst :: SrcLoc -> [Type] -> Type -> Decl
+getObservableInst loc cts a = InstDecl loc ctx (UnQual (Ident "Observable")) [a] [InsDecl (FunBind [Exts.Match loc (Ident "observer") [PVar (Ident "x")] (UnGuardedRhs (App (App (Exts.Var (UnQual (Ident "send"))) (Lit (String ""))) (Paren (InfixApp (InfixApp (App (App (App (Exts.Var (UnQual (Ident "omap"))) (Paren (ExpTypeSig loc (Exts.Var (UnQual (Ident "_L"))) a))) (Exts.Var (UnQual (Ident "thk")))) (Paren (App (Exts.Var (UnQual (Ident "out"))) (Exts.Var (UnQual (Ident "x")))))) (QVarOp (UnQual (Symbol ">>="))) (Exts.Var (UnQual (Ident "return")))) (QVarOp (UnQual (Symbol "."))) (Exts.Var (UnQual (Ident "inn"))))))) (BDecls [PatBind loc (PVar (Ident "thk")) (UnGuardedRhs (ExpTypeSig loc (Exts.Var (UnQual (Ident "thunk"))) thunkSig )) (BDecls [])])])]
+ where ctx = foldr (\c b -> mkIns typeable c : mkIns observable c : b) [] cts
+ thunkSig = TyForall Nothing ctx $ TyFun a (TyApp (TyCon (UnQual (Ident "ObserverM"))) a)
hunk ./src/FunctorOf.hs 214
+typeable :: Name
+typeable = Ident "Typeable"
+observable :: Name
+observable = Ident "Observable"
hunk ./src/FunctorOf.hs 219
+mkIns :: Name -> Type -> Asst
+mkIns cl t = ClassA (UnQual cl) [t]
}
Mon Dec 8 11:19:47 WET 2008 jpm@cs.uu.nl
* Bringing up to conformity with haskell-src-exts-0.4.4.1
{
hunk ./src/DrHylo.hs 107
-pwpfModule f c (Module loc name warnings exports imports decls) = Module loc name warnings exports imports decls''
+pwpfModule f c (Module loc name pragmas warnings exports imports decls) = Module loc name pragmas warnings exports imports decls''
hunk ./src/DrHylo.hs 153
-handleImports b (Module loc name warnings exports imports decls) =
+handleImports b (Module loc name pragmas warnings exports imports decls) =
hunk ./src/DrHylo.hs 158
- in Module loc name warnings exports imports' decls
+ in Module loc name pragmas warnings exports imports' decls
hunk ./src/FunctorOf.hs 28
-getCtx (Module _ _ _ _ _ decls)
+getCtx (Module _ _ _ _ _ _ decls)
hunk ./src/FunctorOf.hs 57
-functorOfInst ob (Module a b c d i decls)
+functorOfInst ob (Module a b c d e i decls)
hunk ./src/FunctorOf.hs 61
- in Module a b c d i (decls ++ newDecls)
+ in Module a b c d e i (decls ++ newDecls)
hunk ./src/Matching.hs 12
-casificate (Module a b c d i decls) =
+casificate (Module a b c d e i decls) =
hunk ./src/Matching.hs 15
- in Module a b c d i newDecls
+ in Module a b c d e i newDecls
}