[record for Context extended, pretty printing implemented
martin.hofmann@uni-bamberg.de**20090406150414] hunk ./src/Syntax/Translator.hs 9
-import Language.Haskell.Exts.Pretty
+--import Language.Haskell.Exts.Pretty
hunk ./src/Syntax/Translator.hs 44
-    in return $ (addToTypes pNameTy) . (addToInstances pTysClass) $ ctx
+    in return $ (addToConstructors pNameTy) . (addToInstances pTysClass) $ ctx
hunk ./src/Syntax/Translator.hs 60
-    in return $ (addToTypes pNameTy ) . (addToClasses pClssFuns) $ ctx 
+        pClssSupr   = [(T.toName cname,[ T.toName n | (Hs.ClassA n _vars) <- assts])]
+    in return $ (addToTypes pNameTy ) . (addToMembers pClssFuns) . (addToClasses pClssSupr) $ ctx 
hunk ./src/Syntax/Translator.hs 178
-    -- mapping a function/constructor name to its type
+    -- mapping a function name to its type
+    , ctx_ctors    :: Map.Map Name Type
+    -- mapping a constructor name to its type
hunk ./src/Syntax/Translator.hs 182
+    -- mapping a class name to its superclasses
+    , ctx_members  :: Map.Map Name [Name]
hunk ./src/Syntax/Translator.hs 186
-    -- mapping a type to its classes, of whic it is a member   
+    -- mapping a type to its classes, of which it is a member   
hunk ./src/Syntax/Translator.hs 195
-    add ctx@(Ctx bindings _ _ _ _ ) (n,cs) = 
-        ctx{ctx_bindings = Map.insert n cs bindings}
+    add ctx (n,cs) = 
+        let bindings = ctx_bindings ctx
+        in ctx{ctx_bindings = Map.insert n cs bindings}
hunk ./src/Syntax/Translator.hs 201
-    where
-    add ctx@(Ctx _ types _ _ _ ) (n, ty) = 
-        ctx{ctx_types = Map.insert n ty types}    
+    where    
+    add ctx (n, ty) =
+        let types = ctx_types ctx 
+        in ctx{ctx_types = Map.insert n ty types}    
hunk ./src/Syntax/Translator.hs 206
+addToConstructors :: [(Name, Type)] -> Context -> Context
+addToConstructors l c  = foldl add c l  
+    where    
+    add ctx (n, ty) =
+        let ctors = ctx_types ctx 
+        in ctx{ctx_ctors = Map.insert n ty ctors}
+            
hunk ./src/Syntax/Translator.hs 216
-    add ctx@(Ctx _ _ classes _ _ ) (n, ns) = 
-        ctx{ctx_classes = Map.insert n ns classes}    
+    add ctx (n, ns) = 
+        let classes = ctx_classes ctx 
+        in ctx{ctx_classes = Map.insert n ns classes} 
+             
+addToMembers :: [(Name, [Name])] -> Context -> Context
+addToMembers l c  = foldl add c l 
+    where
+    add ctx (n, ns) = 
+        let members = ctx_members ctx 
+        in ctx{ctx_members = Map.insert n ns members}       
hunk ./src/Syntax/Translator.hs 230
-    add ctx@(Ctx _ _ _ inst _ ) (ty, n) = 
-        ctx{ctx_instances = Map.insertWith (++) ty [n] inst}    
+    add ctx (ty, n) = 
+        let insts = ctx_instances ctx
+        in ctx{ctx_instances = Map.insertWith (++) ty [n] insts}    
hunk ./src/Syntax/Translator.hs 237
-    add ctx@(Ctx _ _ _ _ tysyns ) (syn, ty) = 
+    add ctx (syn, ty) =
+        let tysyns = ctx_typesyns ctx
+        in  
hunk ./src/Syntax/Translator.hs 247
-               "\n  ClssMems: " ++ (show . pretty . ctx_instances $ ctx) ++
+               "\n  ClssInsts: " ++ (show . pretty . ctx_instances $ ctx) ++
hunk ./src/Syntax/Translator.hs 251
+instance Pretty Context where
+    pretty ctx = linebreak <$> text "Context: " <$>
+               (indent 2 $ text "Bindings: " <$> pretty (ctx_bindings ctx) <$>
+                           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/Translator.hs 269
+    , ctx_ctors     = Map.empty
hunk ./src/Syntax/Translator.hs 271
+    , ctx_members   = Map.empty