added some BinaryLG instances

git-svn-id: https://svn-agbkb.informatik.uni-bremen.de/Hets/trunk@12085 cec4b9c1-7d33-0410-9eda-942365e851bb

ATC/Grothendieck.der.hs

@@ -79,7 +79,7 @@ instance ShATermConvertible a => ShATermLG a where
   toShATermLG = toShATermAux
   fromShATermLG _ = fromShATermAux
 
--- the same class as ShATermConvertible, but allowing a logic graph as input
+-- the same class as Binary, but allowing a logic graph as input
 class BinaryLG t where
     putLG :: t -> Put
     getLG :: LogicGraph -> Get t
@@ -101,6 +101,18 @@ instance ShATermLG G_basic_spec where
                 (att2, G_basic_spec lid i2') }}}
             u -> fromShATermError "G_basic_spec" u
 
+instance BinaryLG G_basic_spec where
+  putLG xv = case xv of
+    G_basic_spec a b -> do
+      putLG $ language_name a
+      putLG b
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_basic_spec" a of
+        Logic lid -> do
+          b <- getLG lg
+          return $ G_basic_spec lid b
+
 instance ShATermLG G_sign where
   toShATermLG att0 (G_sign lid sign si) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -116,6 +128,20 @@ instance ShATermLG G_sign where
                 (att3, G_sign lid i2' i3') }}}}
             u -> fromShATermError "G_sign" u
 
+instance BinaryLG G_sign where
+  putLG xv = case xv of
+    G_sign a b c -> do
+      putLG $ language_name a
+      putLG b
+      putLG c
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_sign" a of
+        Logic lid -> do
+          b <- getLG lg
+          c <- getLG lg
+          return $ G_sign lid b c
+
 instance ShATermLG G_symbol where
   toShATermLG att0 (G_symbol lid symbol) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -129,6 +155,18 @@ instance ShATermLG G_symbol where
                 (att2, G_symbol lid i2') }}}
             u -> fromShATermError "G_symbol" u
 
+instance BinaryLG G_symbol where
+  putLG xv = case xv of
+    G_symbol a b -> do
+      putLG $ language_name a
+      putLG b
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_symbol" a of
+         Logic lid -> do
+           b <- getLG lg
+           return $ G_symbol lid b
+
 instance ShATermLG G_symb_items_list where
   toShATermLG att0 (G_symb_items_list lid symb_items) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -142,6 +180,18 @@ instance ShATermLG G_symb_items_list where
                 (att2, G_symb_items_list lid i2') }}}
             u -> fromShATermError "G_symb_items_list" u
 
+instance BinaryLG G_symb_items_list where
+  putLG xv = case xv of
+    G_symb_items_list a b -> do
+      putLG $ language_name a
+      putLG b
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_symb_items_list" a of
+         Logic lid -> do
+           b <- getLG lg
+           return $ G_symb_items_list lid b
+
 instance ShATermLG G_symb_map_items_list where
   toShATermLG att0 (G_symb_map_items_list lid symb_map_items) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -156,6 +206,18 @@ instance ShATermLG G_symb_map_items_list where
                 (att2, G_symb_map_items_list lid i2') }}}
             u -> fromShATermError "G_symb_map_items_list" u
 
+instance BinaryLG G_symb_map_items_list where
+  putLG xv = case xv of
+    G_symb_map_items_list a b -> do
+      putLG $ language_name a
+      putLG b
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_symb_map_items_list" a of
+         Logic lid -> do
+           b <- getLG lg
+           return $ G_symb_map_items_list lid b
+
 instance ShATermLG G_sublogics where
   toShATermLG att0 (G_sublogics lid sublogics) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -169,6 +231,18 @@ instance ShATermLG G_sublogics where
                 (att2, G_sublogics lid i2') }}}
             u -> fromShATermError "G_sublogics" u
 
+instance BinaryLG G_sublogics where
+  putLG xv = case xv of
+    G_sublogics a b -> do
+      putLG $ language_name a
+      putLG b
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_sublogics" a of
+         Logic lid -> do
+           b <- getLG lg
+           return $ G_sublogics lid b
+
 instance ShATermLG G_morphism where
   toShATermLG att0 (G_morphism lid morphism mi) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)
@@ -184,6 +258,20 @@ instance ShATermLG G_morphism where
                 (att3, G_morphism lid i2' i3') }}}}
             u -> fromShATermError "G_morphism" u
 
+instance BinaryLG G_morphism where
+  putLG xv = case xv of
+    G_morphism a b c -> do
+      putLG $ language_name a
+      putLG b
+      putLG c
+  getLG lg = do
+      a <- getLG lg
+      case atcLogicLookup lg "G_morphism" a of
+        Logic lid -> do
+          b <- getLG lg
+          c <- getLG lg
+          return $ G_morphism lid b c
+
 instance ShATermLG AnyComorphism where
   toShATermLG att0 (Comorphism cid) = do
          (att1,i1) <- toShATermLG' att0 (language_name cid)
@@ -216,6 +304,24 @@ instance ShATermLG GMorphism where
                 (att5, GMorphism cid i2' i3' i4' i5') }}}}}}
             u -> fromShATermError "GMorphism" u
 
+instance BinaryLG GMorphism where
+  putLG xv = case xv of
+    GMorphism a b c d e -> do
+      putLG $ language_name a
+      putLG b
+      putLG c
+      putLG d
+      putLG e
+  getLG lg = do
+      a <- getLG lg
+      case propagateErrors $ lookupComorphism a lg of
+        Comorphism cid -> do
+          b <- getLG lg
+          c <- getLG lg
+          d <- getLG lg
+          e <- getLG lg
+          return $ GMorphism cid b c d e
+
 instance ShATermLG AnyLogic where
   toShATermLG att0 (Logic lid) = do
          (att1,i1) <- toShATermLG' att0 (language_name lid)