{-# OPTIONS -w -O0 #-}
{-# LANGUAGE CPP, StandaloneDeriving, DeriveDataTypeable, DeriveGeneric #-}
{- |
Module      :  OMDoc/ATC_OMDoc.der.hs
Description :  generated ShATermConvertible, Json instances
Copyright   :  (c) DFKI GmbH 2012
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable(derive Typeable instances)

Automatic derivation of instances via DrIFT-rule ShATermConvertible, Json
  for the type(s):
'OMDoc.OMDocInterface.OMDoc'
'OMDoc.OMDocInterface.Theory'
'OMDoc.OMDocInterface.ImportsType'
'OMDoc.OMDocInterface.Imports'
'OMDoc.OMDocInterface.Presentation'
'OMDoc.OMDocInterface.Use'
'OMDoc.OMDocInterface.SymbolRole'
'OMDoc.OMDocInterface.Symbol'
'OMDoc.OMDocInterface.Type'
'OMDoc.OMDocInterface.Constitutive'
'OMDoc.OMDocInterface.Axiom'
'OMDoc.OMDocInterface.CMP'
'OMDoc.OMDocInterface.FMP'
'OMDoc.OMDocInterface.Assumption'
'OMDoc.OMDocInterface.Conclusion'
'OMDoc.OMDocInterface.Definition'
'OMDoc.OMDocInterface.ADT'
'OMDoc.OMDocInterface.SortType'
'OMDoc.OMDocInterface.SortDef'
'OMDoc.OMDocInterface.Constructor'
'OMDoc.OMDocInterface.Insort'
'OMDoc.OMDocInterface.Recognizer'
'OMDoc.OMDocInterface.Conservativity'
'OMDoc.OMDocInterface.Inclusion'
'OMDoc.OMDocInterface.Morphism'
'OMDoc.OMDocInterface.MText'
'OMDoc.OMDocInterface.OMDocMathObject'
'OMDoc.OMDocInterface.OMObject'
'OMDoc.OMDocInterface.OMSymbol'
'OMDoc.OMDocInterface.OMInteger'
'OMDoc.OMDocInterface.OMVariable'
'OMDoc.OMDocInterface.OMSimpleVariable'
'OMDoc.OMDocInterface.OMAttribution'
'OMDoc.OMDocInterface.OMAttributionPart'
'OMDoc.OMDocInterface.OMBindingVariables'
'OMDoc.OMDocInterface.OMBase64'
'OMDoc.OMDocInterface.OMString'
'OMDoc.OMDocInterface.OMFloat'
'OMDoc.OMDocInterface.OMApply'
'OMDoc.OMDocInterface.OMError'
'OMDoc.OMDocInterface.OMReference'
'OMDoc.OMDocInterface.OMBind'
'OMDoc.OMDocInterface.OMElement'
-}

{-
Generated by 'genRules' (automatic rule generation for DrIFT). Don't touch!!
  dependency files:
OMDoc/OMDocInterface.hs
-}

module OMDoc.ATC_OMDoc () where

import ATC.IRI
import ATerm.Lib
import Common.Doc
import Common.DocUtils
import Common.Id
import Common.Json.Instances
import Data.Aeson(ToJSON, FromJSON)
import Data.Char
import Data.Data
import GHC.Generics(Generic)
import OMDoc.OMDocInterface
import qualified Common.IRI as IRI
import qualified Data.Word as Word

{-! for OMDoc.OMDocInterface.OMDoc derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Theory derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.ImportsType derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Imports derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Presentation derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Use derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.SymbolRole derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Symbol derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Type derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Constitutive derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Axiom derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.CMP derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.FMP derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Assumption derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Conclusion derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Definition derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.ADT derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.SortType derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.SortDef derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Constructor derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Insort derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Recognizer derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Conservativity derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Inclusion derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.Morphism derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.MText derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMDocMathObject derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMObject derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMSymbol derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMInteger derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMVariable derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMSimpleVariable derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMAttribution derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMAttributionPart derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMBindingVariables derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMBase64 derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMString derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMFloat derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMApply derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMError derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMReference derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMBind derive : ShATermConvertible !-}
{-! for OMDoc.OMDocInterface.OMElement derive : ShATermConvertible !-}

{-! for OMDoc.OMDocInterface.OMDoc derive : Json !-}
{-! for OMDoc.OMDocInterface.Theory derive : Json !-}
{-! for OMDoc.OMDocInterface.ImportsType derive : Json !-}
{-! for OMDoc.OMDocInterface.Imports derive : Json !-}
{-! for OMDoc.OMDocInterface.Presentation derive : Json !-}
{-! for OMDoc.OMDocInterface.Use derive : Json !-}
{-! for OMDoc.OMDocInterface.SymbolRole derive : Json !-}
{-! for OMDoc.OMDocInterface.Symbol derive : Json !-}
{-! for OMDoc.OMDocInterface.Type derive : Json !-}
{-! for OMDoc.OMDocInterface.Constitutive derive : Json !-}
{-! for OMDoc.OMDocInterface.Axiom derive : Json !-}
{-! for OMDoc.OMDocInterface.CMP derive : Json !-}
{-! for OMDoc.OMDocInterface.FMP derive : Json !-}
{-! for OMDoc.OMDocInterface.Assumption derive : Json !-}
{-! for OMDoc.OMDocInterface.Conclusion derive : Json !-}
{-! for OMDoc.OMDocInterface.Definition derive : Json !-}
{-! for OMDoc.OMDocInterface.ADT derive : Json !-}
{-! for OMDoc.OMDocInterface.SortType derive : Json !-}
{-! for OMDoc.OMDocInterface.SortDef derive : Json !-}
{-! for OMDoc.OMDocInterface.Constructor derive : Json !-}
{-! for OMDoc.OMDocInterface.Insort derive : Json !-}
{-! for OMDoc.OMDocInterface.Recognizer derive : Json !-}
{-! for OMDoc.OMDocInterface.Conservativity derive : Json !-}
{-! for OMDoc.OMDocInterface.Inclusion derive : Json !-}
{-! for OMDoc.OMDocInterface.Morphism derive : Json !-}
{-! for OMDoc.OMDocInterface.MText derive : Json !-}
{-! for OMDoc.OMDocInterface.OMDocMathObject derive : Json !-}
{-! for OMDoc.OMDocInterface.OMObject derive : Json !-}
{-! for OMDoc.OMDocInterface.OMSymbol derive : Json !-}
{-! for OMDoc.OMDocInterface.OMInteger derive : Json !-}
{-! for OMDoc.OMDocInterface.OMVariable derive : Json !-}
{-! for OMDoc.OMDocInterface.OMSimpleVariable derive : Json !-}
{-! for OMDoc.OMDocInterface.OMAttribution derive : Json !-}
{-! for OMDoc.OMDocInterface.OMAttributionPart derive : Json !-}
{-! for OMDoc.OMDocInterface.OMBindingVariables derive : Json !-}
{-! for OMDoc.OMDocInterface.OMBase64 derive : Json !-}
{-! for OMDoc.OMDocInterface.OMString derive : Json !-}
{-! for OMDoc.OMDocInterface.OMFloat derive : Json !-}
{-! for OMDoc.OMDocInterface.OMApply derive : Json !-}
{-! for OMDoc.OMDocInterface.OMError derive : Json !-}
{-! for OMDoc.OMDocInterface.OMReference derive : Json !-}
{-! for OMDoc.OMDocInterface.OMBind derive : Json !-}
{-! for OMDoc.OMDocInterface.OMElement derive : Json !-}

-- Generated by DrIFT, look but don't touch!

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMElement
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMElement where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMElement where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMBind
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMBind where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMBind where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMReference
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMReference where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMReference where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMError
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMError where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMError where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMApply
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMApply where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMApply where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMFloat
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMFloat where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMFloat where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMString
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMString where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMString where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMBase64
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMBase64 where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMBase64 where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMBindingVariables
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMBindingVariables where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMBindingVariables where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMAttributionPart
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMAttributionPart where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMAttributionPart where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMAttribution
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMAttribution where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMAttribution where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMSimpleVariable
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMSimpleVariable where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMSimpleVariable where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMVariable
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMVariable where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMVariable where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMInteger
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMInteger where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMInteger where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMSymbol
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMSymbol where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMSymbol where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMObject
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMObject where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMObject where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMDocMathObject
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMDocMathObject where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMDocMathObject where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.MText
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.MText where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.MText where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Morphism
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Morphism where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Morphism where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Inclusion
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Inclusion where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Inclusion where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Conservativity
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Conservativity where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Conservativity where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Recognizer
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Recognizer where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Recognizer where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Insort
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Insort where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Insort where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Constructor
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Constructor where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Constructor where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.SortDef
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.SortDef where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.SortDef where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.SortType
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.SortType where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.SortType where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.ADT
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.ADT where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.ADT where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Definition
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Definition where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Definition where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Conclusion
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Conclusion where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Conclusion where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Assumption
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Assumption where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Assumption where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.FMP
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.FMP where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.FMP where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.CMP
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.CMP where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.CMP where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Axiom
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Axiom where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Axiom where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Constitutive
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Constitutive where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Constitutive where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Type
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Type where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Type where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Symbol
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Symbol where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Symbol where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.SymbolRole
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.SymbolRole where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.SymbolRole where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Use
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Use where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Use where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Presentation
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Presentation where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Presentation where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Imports
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Imports where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Imports where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.ImportsType
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.ImportsType where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.ImportsType where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.Theory
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.Theory where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.Theory where

deriving instance GHC.Generics.Generic OMDoc.OMDocInterface.OMDoc
instance Data.Aeson.ToJSON OMDoc.OMDocInterface.OMDoc where
instance Data.Aeson.FromJSON OMDoc.OMDocInterface.OMDoc where

instance ShATermConvertible OMDoc.OMDocInterface.OMElement where
  toShATermAux :: ATermTable -> OMElement -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMElement
xv = case OMElement
xv of
    OMES a :: OMSymbol
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMSymbol -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMSymbol
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMES" [Int
a'] []) ATermTable
att1
    OMEV a :: OMSimpleVariable
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMSimpleVariable -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMSimpleVariable
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEV" [Int
a'] []) ATermTable
att1
    OMEI a :: OMInteger
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMInteger -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMInteger
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEI" [Int
a'] []) ATermTable
att1
    OMEB a :: OMBase64
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMBase64 -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMBase64
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEB" [Int
a'] []) ATermTable
att1
    OMESTR a :: OMString
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMString -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMString
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMESTR" [Int
a'] []) ATermTable
att1
    OMEF a :: OMFloat
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMFloat -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMFloat
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEF" [Int
a'] []) ATermTable
att1
    OMEA a :: OMApply
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMApply -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMApply
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEA" [Int
a'] []) ATermTable
att1
    OMEBIND a :: OMBind
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMBind -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMBind
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEBIND" [Int
a'] []) ATermTable
att1
    OMEE a :: OMError
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMError -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMError
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEE" [Int
a'] []) ATermTable
att1
    OMEATTR a :: OMAttribution
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMAttribution -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMAttribution
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEATTR" [Int
a'] []) ATermTable
att1
    OMER a :: OMReference
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMReference -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMReference
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMER" [Int
a'] []) ATermTable
att1
    OMEC a :: Maybe OMElement
a b :: String
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe OMElement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe OMElement
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 String
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMEC" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMElement)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMES" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMSymbol)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMSymbol
a') ->
      (ATermTable
att1, OMSymbol -> OMElement
OMES OMSymbol
a') }
    ShAAppl "OMEV" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMSimpleVariable)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMSimpleVariable
a') ->
      (ATermTable
att1, OMSimpleVariable -> OMElement
OMEV OMSimpleVariable
a') }
    ShAAppl "OMEI" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMInteger)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMInteger
a') ->
      (ATermTable
att1, OMInteger -> OMElement
OMEI OMInteger
a') }
    ShAAppl "OMEB" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMBase64)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMBase64
a') ->
      (ATermTable
att1, OMBase64 -> OMElement
OMEB OMBase64
a') }
    ShAAppl "OMESTR" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMString)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMString
a') ->
      (ATermTable
att1, OMString -> OMElement
OMESTR OMString
a') }
    ShAAppl "OMEF" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMFloat)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMFloat
a') ->
      (ATermTable
att1, OMFloat -> OMElement
OMEF OMFloat
a') }
    ShAAppl "OMEA" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMApply)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMApply
a') ->
      (ATermTable
att1, OMApply -> OMElement
OMEA OMApply
a') }
    ShAAppl "OMEBIND" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMBind)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMBind
a') ->
      (ATermTable
att1, OMBind -> OMElement
OMEBIND OMBind
a') }
    ShAAppl "OMEE" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMError)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMError
a') ->
      (ATermTable
att1, OMError -> OMElement
OMEE OMError
a') }
    ShAAppl "OMEATTR" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMAttribution)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMAttribution
a') ->
      (ATermTable
att1, OMAttribution -> OMElement
OMEATTR OMAttribution
a') }
    ShAAppl "OMER" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMReference)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMReference
a') ->
      (ATermTable
att1, OMReference -> OMElement
OMER OMReference
a') }
    ShAAppl "OMEC" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe OMElement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe OMElement
a') ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: String
b') ->
      (ATermTable
att2, Maybe OMElement -> String -> OMElement
OMEC Maybe OMElement
a' String
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMElement)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMElement" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMBind where
  toShATermAux :: ATermTable -> OMBind -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMBind
xv = case OMBind
xv of
    OMBIND a :: OMElement
a b :: OMBindingVariables
b c :: OMElement
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMElement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMElement
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> OMBindingVariables -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 OMBindingVariables
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> OMElement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 OMElement
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMBIND" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMBind)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMBIND" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, OMElement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMElement
a') ->
      case Int -> ATermTable -> (ATermTable, OMBindingVariables)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: OMBindingVariables
b') ->
      case Int -> ATermTable -> (ATermTable, OMElement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: OMElement
c') ->
      (ATermTable
att3, OMElement -> OMBindingVariables -> OMElement -> OMBind
OMBIND OMElement
a' OMBindingVariables
b' OMElement
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMBind)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMBind" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMReference where
  toShATermAux :: ATermTable -> OMReference -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMReference
xv = case OMReference
xv of
    OMR a :: IRI
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 IRI
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMR" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMReference)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMR" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: IRI
a') ->
      (ATermTable
att1, IRI -> OMReference
OMR IRI
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMReference)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMReference" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMError where
  toShATermAux :: ATermTable -> OMError -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMError
xv = case OMError
xv of
    OME a :: OMSymbol
a b :: [OMElement]
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMSymbol -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMSymbol
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [OMElement] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [OMElement]
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OME" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMError)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OME" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, OMSymbol)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMSymbol
a') ->
      case Int -> ATermTable -> (ATermTable, [OMElement])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [OMElement]
b') ->
      (ATermTable
att2, OMSymbol -> [OMElement] -> OMError
OME OMSymbol
a' [OMElement]
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMError)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMError" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMApply where
  toShATermAux :: ATermTable -> OMApply -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMApply
xv = case OMApply
xv of
    OMA a :: [OMElement]
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> [OMElement] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 [OMElement]
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMA" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMApply)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMA" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, [OMElement])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: [OMElement]
a') ->
      (ATermTable
att1, [OMElement] -> OMApply
OMA [OMElement]
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMApply)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMApply" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMFloat where
  toShATermAux :: ATermTable -> OMFloat -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMFloat
xv = case OMFloat
xv of
    OMF a :: Float
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Float -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Float
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMF" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMFloat)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMF" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Float)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Float
a') ->
      (ATermTable
att1, Float -> OMFloat
OMF Float
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMFloat)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMFloat" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMString where
  toShATermAux :: ATermTable -> OMString -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMString
xv = case OMString
xv of
    OMSTR a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMSTR" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMString)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMSTR" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> OMString
OMSTR String
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMString)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMString" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMBase64 where
  toShATermAux :: ATermTable -> OMBase64 -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMBase64
xv = case OMBase64
xv of
    OMB a :: [Word8]
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> [Word8] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 [Word8]
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMB" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMBase64)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMB" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, [Word8])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: [Word8]
a') ->
      (ATermTable
att1, [Word8] -> OMBase64
OMB [Word8]
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMBase64)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMBase64" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMBindingVariables where
  toShATermAux :: ATermTable -> OMBindingVariables -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMBindingVariables
xv = case OMBindingVariables
xv of
    OMBVAR a :: [OMVariable]
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> [OMVariable] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 [OMVariable]
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMBVAR" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMBindingVariables)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMBVAR" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, [OMVariable])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: [OMVariable]
a') ->
      (ATermTable
att1, [OMVariable] -> OMBindingVariables
OMBVAR [OMVariable]
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMBindingVariables)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMBindingVariables" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMAttributionPart where
  toShATermAux :: ATermTable -> OMAttributionPart -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMAttributionPart
xv = case OMAttributionPart
xv of
    OMATP a :: [(OMSymbol, OMElement)]
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> [(OMSymbol, OMElement)] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 [(OMSymbol, OMElement)]
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMATP" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMAttributionPart)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMATP" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, [(OMSymbol, OMElement)])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: [(OMSymbol, OMElement)]
a') ->
      (ATermTable
att1, [(OMSymbol, OMElement)] -> OMAttributionPart
OMATP [(OMSymbol, OMElement)]
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMAttributionPart)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMAttributionPart" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMAttribution where
  toShATermAux :: ATermTable -> OMAttribution -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMAttribution
xv = case OMAttribution
xv of
    OMATTR a :: OMAttributionPart
a b :: OMElement
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMAttributionPart -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMAttributionPart
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> OMElement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 OMElement
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMATTR" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMAttribution)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMATTR" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, OMAttributionPart)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMAttributionPart
a') ->
      case Int -> ATermTable -> (ATermTable, OMElement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: OMElement
b') ->
      (ATermTable
att2, OMAttributionPart -> OMElement -> OMAttribution
OMATTR OMAttributionPart
a' OMElement
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMAttribution)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMAttribution" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMSimpleVariable where
  toShATermAux :: ATermTable -> OMSimpleVariable -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMSimpleVariable
xv = case OMSimpleVariable
xv of
    OMV a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMV" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMSimpleVariable)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMV" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> OMSimpleVariable
OMV String
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMSimpleVariable)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMSimpleVariable" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMVariable where
  toShATermAux :: ATermTable -> OMVariable -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMVariable
xv = case OMVariable
xv of
    OMVS a :: OMSimpleVariable
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMSimpleVariable -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMSimpleVariable
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMVS" [Int
a'] []) ATermTable
att1
    OMVA a :: OMAttribution
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMAttribution -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMAttribution
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMVA" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMVariable)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMVS" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMSimpleVariable)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMSimpleVariable
a') ->
      (ATermTable
att1, OMSimpleVariable -> OMVariable
OMVS OMSimpleVariable
a') }
    ShAAppl "OMVA" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMAttribution)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMAttribution
a') ->
      (ATermTable
att1, OMAttribution -> OMVariable
OMVA OMAttribution
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMVariable)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMVariable" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMInteger where
  toShATermAux :: ATermTable -> OMInteger -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMInteger
xv = case OMInteger
xv of
    OMI a :: Int
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Int -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Int
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMI" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMInteger)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMI" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Int)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Int
a') ->
      (ATermTable
att1, Int -> OMInteger
OMI Int
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMInteger)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMInteger" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMSymbol where
  toShATermAux :: ATermTable -> OMSymbol -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMSymbol
xv = case OMSymbol
xv of
    OMS a :: Maybe IRI
a b :: String
b c :: String
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe IRI
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 String
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 String
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMS" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMSymbol)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMS" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe IRI
a') ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: String
b') ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: String
c') ->
      (ATermTable
att3, Maybe IRI -> String -> String -> OMSymbol
OMS Maybe IRI
a' String
b' String
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMSymbol)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMSymbol" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMObject where
  toShATermAux :: ATermTable -> OMObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMObject
xv = case OMObject
xv of
    OMObject a :: OMElement
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMElement -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMElement
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMObject" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMObject" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMElement)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMElement
a') ->
      (ATermTable
att1, OMElement -> OMObject
OMObject OMElement
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMObject)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMObject" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMDocMathObject where
  toShATermAux :: ATermTable -> OMDocMathObject -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMDocMathObject
xv = case OMDocMathObject
xv of
    OMOMOBJ a :: OMObject
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMObject
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMOMOBJ" [Int
a'] []) ATermTable
att1
    OMLegacy a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMLegacy" [Int
a'] []) ATermTable
att1
    OMMath a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMMath" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMDocMathObject)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMOMOBJ" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMObject
a') ->
      (ATermTable
att1, OMObject -> OMDocMathObject
OMOMOBJ OMObject
a') }
    ShAAppl "OMLegacy" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> OMDocMathObject
OMLegacy String
a') }
    ShAAppl "OMMath" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> OMDocMathObject
OMMath String
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMDocMathObject)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMDocMathObject" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.MText where
  toShATermAux :: ATermTable -> MText -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: MText
xv = case MText
xv of
    MTextText a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "MTextText" [Int
a'] []) ATermTable
att1
    MTextTerm a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "MTextTerm" [Int
a'] []) ATermTable
att1
    MTextPhrase a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "MTextPhrase" [Int
a'] []) ATermTable
att1
    MTextOM a :: OMObject
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> OMObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 OMObject
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "MTextOM" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, MText)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "MTextText" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> MText
MTextText String
a') }
    ShAAppl "MTextTerm" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> MText
MTextTerm String
a') }
    ShAAppl "MTextPhrase" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> MText
MTextPhrase String
a') }
    ShAAppl "MTextOM" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, OMObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: OMObject
a') ->
      (ATermTable
att1, OMObject -> MText
MTextOM OMObject
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, MText)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.MText" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Morphism where
  toShATermAux :: ATermTable -> Morphism -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Morphism
xv = case Morphism
xv of
    Morphism a :: Maybe String
a b :: [String]
b c :: [String]
c d :: [(MText, MText)]
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [String] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [String]
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [String] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [String]
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> [(MText, MText)] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 [(MText, MText)]
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Morphism" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Morphism)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Morphism" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe String
a') ->
      case Int -> ATermTable -> (ATermTable, [String])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [String]
b') ->
      case Int -> ATermTable -> (ATermTable, [String])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [String]
c') ->
      case Int -> ATermTable -> (ATermTable, [(MText, MText)])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: [(MText, MText)]
d') ->
      (ATermTable
att4, Maybe String
-> [String] -> [String] -> [(MText, MText)] -> Morphism
Morphism Maybe String
a' [String]
b' [String]
c' [(MText, MText)]
d') }}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Morphism)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Morphism" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Inclusion where
  toShATermAux :: ATermTable -> Inclusion -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Inclusion
xv = case Inclusion
xv of
    TheoryInclusion a :: IRI
a b :: IRI
b c :: Maybe Morphism
c d :: Maybe String
d e :: Conservativity
e -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 IRI
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 IRI
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Maybe Morphism -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Maybe Morphism
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Maybe String
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> Conservativity -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 Conservativity
e
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "TheoryInclusion" [Int
a', Int
b', Int
c', Int
d',
                                                    Int
e'] []) ATermTable
att5
    AxiomInclusion a :: IRI
a b :: IRI
b c :: Maybe Morphism
c d :: Maybe String
d e :: Conservativity
e -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 IRI
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 IRI
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Maybe Morphism -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Maybe Morphism
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Maybe String
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> Conservativity -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 Conservativity
e
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "AxiomInclusion" [Int
a', Int
b', Int
c', Int
d',
                                                   Int
e'] []) ATermTable
att5
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Inclusion)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "TheoryInclusion" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e] _ ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: IRI
a') ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: IRI
b') ->
      case Int -> ATermTable -> (ATermTable, Maybe Morphism)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Maybe Morphism
c') ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Maybe String
d') ->
      case Int -> ATermTable -> (ATermTable, Conservativity)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: Conservativity
e') ->
      (ATermTable
att5, IRI
-> IRI
-> Maybe Morphism
-> Maybe String
-> Conservativity
-> Inclusion
TheoryInclusion IRI
a' IRI
b' Maybe Morphism
c' Maybe String
d' Conservativity
e') }}}}}
    ShAAppl "AxiomInclusion" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e] _ ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: IRI
a') ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: IRI
b') ->
      case Int -> ATermTable -> (ATermTable, Maybe Morphism)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Maybe Morphism
c') ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Maybe String
d') ->
      case Int -> ATermTable -> (ATermTable, Conservativity)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: Conservativity
e') ->
      (ATermTable
att5, IRI
-> IRI
-> Maybe Morphism
-> Maybe String
-> Conservativity
-> Inclusion
AxiomInclusion IRI
a' IRI
b' Maybe Morphism
c' Maybe String
d' Conservativity
e') }}}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Inclusion)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Inclusion" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Conservativity where
  toShATermAux :: ATermTable -> Conservativity -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Conservativity
xv = case Conservativity
xv of
    CNone -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CNone" [] []) ATermTable
att0
    CMonomorphism -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CMonomorphism" [] []) ATermTable
att0
    CDefinitional -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CDefinitional" [] []) ATermTable
att0
    CConservative -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CConservative" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Conservativity)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "CNone" [] _ -> (ATermTable
att0, Conservativity
CNone)
    ShAAppl "CMonomorphism" [] _ -> (ATermTable
att0, Conservativity
CMonomorphism)
    ShAAppl "CDefinitional" [] _ -> (ATermTable
att0, Conservativity
CDefinitional)
    ShAAppl "CConservative" [] _ -> (ATermTable
att0, Conservativity
CConservative)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Conservativity)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Conservativity" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Recognizer where
  toShATermAux :: ATermTable -> Recognizer -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Recognizer
xv = case Recognizer
xv of
    Recognizer a :: String
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Recognizer" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Recognizer)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Recognizer" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      (ATermTable
att1, String -> Recognizer
Recognizer String
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Recognizer)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Recognizer" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Insort where
  toShATermAux :: ATermTable -> Insort -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Insort
xv = case Insort
xv of
    Insort a :: IRI
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 IRI
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Insort" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Insort)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Insort" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: IRI
a') ->
      (ATermTable
att1, IRI -> Insort
Insort IRI
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Insort)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Insort" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Constructor where
  toShATermAux :: ATermTable -> Constructor -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Constructor
xv = case Constructor
xv of
    Constructor a :: String
a b :: SymbolRole
b c :: [Type]
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> SymbolRole -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 SymbolRole
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [Type] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [Type]
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Constructor" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Constructor)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Constructor" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, SymbolRole)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: SymbolRole
b') ->
      case Int -> ATermTable -> (ATermTable, [Type])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [Type]
c') ->
      (ATermTable
att3, String -> SymbolRole -> [Type] -> Constructor
Constructor String
a' SymbolRole
b' [Type]
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Constructor)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Constructor" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.SortDef where
  toShATermAux :: ATermTable -> SortDef -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: SortDef
xv = case SortDef
xv of
    SortDef a :: String
a b :: SymbolRole
b c :: SortType
c d :: [Constructor]
d e :: [Insort]
e f :: [Recognizer]
f -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> SymbolRole -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 SymbolRole
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> SortType -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 SortType
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> [Constructor] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 [Constructor]
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> [Insort] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 [Insort]
e
      (att6 :: ATermTable
att6, f' :: Int
f') <- ATermTable -> [Recognizer] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att5 [Recognizer]
f
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SortDef" [Int
a', Int
b', Int
c', Int
d', Int
e',
                                            Int
f'] []) ATermTable
att6
  fromShATermAux :: Int -> ATermTable -> (ATermTable, SortDef)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "SortDef" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e, f :: Int
f] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, SymbolRole)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: SymbolRole
b') ->
      case Int -> ATermTable -> (ATermTable, SortType)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: SortType
c') ->
      case Int -> ATermTable -> (ATermTable, [Constructor])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: [Constructor]
d') ->
      case Int -> ATermTable -> (ATermTable, [Insort])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: [Insort]
e') ->
      case Int -> ATermTable -> (ATermTable, [Recognizer])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
f ATermTable
att5 of
      { (att6 :: ATermTable
att6, f' :: [Recognizer]
f') ->
      (ATermTable
att6, String
-> SymbolRole
-> SortType
-> [Constructor]
-> [Insort]
-> [Recognizer]
-> SortDef
SortDef String
a' SymbolRole
b' SortType
c' [Constructor]
d' [Insort]
e' [Recognizer]
f') }}}}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, SortDef)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.SortDef" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.SortType where
  toShATermAux :: ATermTable -> SortType -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: SortType
xv = case SortType
xv of
    STFree -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "STFree" [] []) ATermTable
att0
    STGenerated -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "STGenerated" [] []) ATermTable
att0
    STLoose -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "STLoose" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, SortType)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "STFree" [] _ -> (ATermTable
att0, SortType
STFree)
    ShAAppl "STGenerated" [] _ -> (ATermTable
att0, SortType
STGenerated)
    ShAAppl "STLoose" [] _ -> (ATermTable
att0, SortType
STLoose)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, SortType)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.SortType" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.ADT where
  toShATermAux :: ATermTable -> ADT -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: ADT
xv = case ADT
xv of
    ADT a :: Maybe String
a b :: [SortDef]
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [SortDef] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [SortDef]
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "ADT" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, ADT)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "ADT" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe String
a') ->
      case Int -> ATermTable -> (ATermTable, [SortDef])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [SortDef]
b') ->
      (ATermTable
att2, Maybe String -> [SortDef] -> ADT
ADT Maybe String
a' [SortDef]
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, ADT)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.ADT" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Definition where
  toShATermAux :: ATermTable -> Definition -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Definition
xv = case Definition
xv of
    Definition a :: String
a b :: [CMP]
b c :: [FMP]
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [CMP] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [CMP]
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [FMP] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [FMP]
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Definition" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Definition)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Definition" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, [CMP])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [CMP]
b') ->
      case Int -> ATermTable -> (ATermTable, [FMP])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [FMP]
c') ->
      (ATermTable
att3, String -> [CMP] -> [FMP] -> Definition
Definition String
a' [CMP]
b' [FMP]
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Definition)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Definition" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Conclusion where
  toShATermAux :: ATermTable -> Conclusion -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Conclusion
xv = case Conclusion
xv of
    Conclusion -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Conclusion" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Conclusion)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Conclusion" [] _ -> (ATermTable
att0, Conclusion
Conclusion)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Conclusion)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Conclusion" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Assumption where
  toShATermAux :: ATermTable -> Assumption -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Assumption
xv = case Assumption
xv of
    Assumption -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Assumption" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Assumption)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Assumption" [] _ -> (ATermTable
att0, Assumption
Assumption)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Assumption)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Assumption" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.FMP where
  toShATermAux :: ATermTable -> FMP -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: FMP
xv = case FMP
xv of
    FMP a :: Maybe String
a b :: Either OMObject ([Assumption], [Conclusion])
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable
-> Either OMObject ([Assumption], [Conclusion])
-> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Either OMObject ([Assumption], [Conclusion])
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "FMP" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, FMP)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "FMP" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe String
a') ->
      case Int
-> ATermTable
-> (ATermTable, Either OMObject ([Assumption], [Conclusion]))
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Either OMObject ([Assumption], [Conclusion])
b') ->
      (ATermTable
att2, Maybe String -> Either OMObject ([Assumption], [Conclusion]) -> FMP
FMP Maybe String
a' Either OMObject ([Assumption], [Conclusion])
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, FMP)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.FMP" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.CMP where
  toShATermAux :: ATermTable -> CMP -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: CMP
xv = case CMP
xv of
    CMP a :: MText
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> MText -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 MText
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CMP" [Int
a'] []) ATermTable
att1
  fromShATermAux :: Int -> ATermTable -> (ATermTable, CMP)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "CMP" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, MText)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: MText
a') ->
      (ATermTable
att1, MText -> CMP
CMP MText
a') }
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, CMP)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.CMP" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Axiom where
  toShATermAux :: ATermTable -> Axiom -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Axiom
xv = case Axiom
xv of
    Axiom a :: String
a b :: [CMP]
b c :: [FMP]
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [CMP] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [CMP]
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [FMP] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [FMP]
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Axiom" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Axiom)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Axiom" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, [CMP])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [CMP]
b') ->
      case Int -> ATermTable -> (ATermTable, [FMP])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [FMP]
c') ->
      (ATermTable
att3, String -> [CMP] -> [FMP] -> Axiom
Axiom String
a' [CMP]
b' [FMP]
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Axiom)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Axiom" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Constitutive where
  toShATermAux :: ATermTable -> Constitutive -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Constitutive
xv = case Constitutive
xv of
    CAx a :: Axiom
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Axiom -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Axiom
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CAx" [Int
a'] []) ATermTable
att1
    CDe a :: Definition
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Definition -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Definition
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CDe" [Int
a'] []) ATermTable
att1
    CSy a :: Symbol
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Symbol -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Symbol
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CSy" [Int
a'] []) ATermTable
att1
    CIm a :: Imports
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Imports -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Imports
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CIm" [Int
a'] []) ATermTable
att1
    CAd a :: ADT
a -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> ADT -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 ADT
a
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CAd" [Int
a'] []) ATermTable
att1
    CCo a :: String
a b :: Constitutive
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Constitutive -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Constitutive
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "CCo" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Constitutive)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "CAx" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Axiom)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Axiom
a') ->
      (ATermTable
att1, Axiom -> Constitutive
CAx Axiom
a') }
    ShAAppl "CDe" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Definition)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Definition
a') ->
      (ATermTable
att1, Definition -> Constitutive
CDe Definition
a') }
    ShAAppl "CSy" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Symbol)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Symbol
a') ->
      (ATermTable
att1, Symbol -> Constitutive
CSy Symbol
a') }
    ShAAppl "CIm" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, Imports)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Imports
a') ->
      (ATermTable
att1, Imports -> Constitutive
CIm Imports
a') }
    ShAAppl "CAd" [a :: Int
a] _ ->
      case Int -> ATermTable -> (ATermTable, ADT)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: ADT
a') ->
      (ATermTable
att1, ADT -> Constitutive
CAd ADT
a') }
    ShAAppl "CCo" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, Constitutive)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Constitutive
b') ->
      (ATermTable
att2, String -> Constitutive -> Constitutive
CCo String
a' Constitutive
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Constitutive)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Constitutive" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Type where
  toShATermAux :: ATermTable -> Type -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Type
xv = case Type
xv of
    Type a :: Maybe IRI
a b :: OMDocMathObject
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe IRI
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> OMDocMathObject -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 OMDocMathObject
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Type" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Type)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Type" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe IRI
a') ->
      case Int -> ATermTable -> (ATermTable, OMDocMathObject)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: OMDocMathObject
b') ->
      (ATermTable
att2, Maybe IRI -> OMDocMathObject -> Type
Type Maybe IRI
a' OMDocMathObject
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Type)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Type" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Symbol where
  toShATermAux :: ATermTable -> Symbol -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Symbol
xv = case Symbol
xv of
    Symbol a :: Maybe String
a b :: String
b c :: SymbolRole
c d :: Maybe Type
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 Maybe String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 String
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> SymbolRole -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 SymbolRole
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Maybe Type -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Maybe Type
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Symbol" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Symbol)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Symbol" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: Maybe String
a') ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: String
b') ->
      case Int -> ATermTable -> (ATermTable, SymbolRole)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: SymbolRole
c') ->
      case Int -> ATermTable -> (ATermTable, Maybe Type)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Maybe Type
d') ->
      (ATermTable
att4, Maybe String -> String -> SymbolRole -> Maybe Type -> Symbol
Symbol Maybe String
a' String
b' SymbolRole
c' Maybe Type
d') }}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Symbol)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Symbol" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.SymbolRole where
  toShATermAux :: ATermTable -> SymbolRole -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: SymbolRole
xv = case SymbolRole
xv of
    SRType -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRType" [] []) ATermTable
att0
    SRSort -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRSort" [] []) ATermTable
att0
    SRObject -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRObject" [] []) ATermTable
att0
    SRBinder -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRBinder" [] []) ATermTable
att0
    SRAttribution -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRAttribution" [] []) ATermTable
att0
    SRSemanticAttribution ->
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRSemanticAttribution" [] []) ATermTable
att0
    SRError -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "SRError" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, SymbolRole)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "SRType" [] _ -> (ATermTable
att0, SymbolRole
SRType)
    ShAAppl "SRSort" [] _ -> (ATermTable
att0, SymbolRole
SRSort)
    ShAAppl "SRObject" [] _ -> (ATermTable
att0, SymbolRole
SRObject)
    ShAAppl "SRBinder" [] _ -> (ATermTable
att0, SymbolRole
SRBinder)
    ShAAppl "SRAttribution" [] _ -> (ATermTable
att0, SymbolRole
SRAttribution)
    ShAAppl "SRSemanticAttribution" [] _ -> (ATermTable
att0, SymbolRole
SRSemanticAttribution)
    ShAAppl "SRError" [] _ -> (ATermTable
att0, SymbolRole
SRError)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, SymbolRole)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.SymbolRole" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Use where
  toShATermAux :: ATermTable -> Use -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Use
xv = case Use
xv of
    Use a :: String
a b :: String
b -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 String
b
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Use" [Int
a', Int
b'] []) ATermTable
att2
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Use)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Use" [a :: Int
a, b :: Int
b] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: String
b') ->
      (ATermTable
att2, String -> String -> Use
Use String
a' String
b') }}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Use)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Use" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Presentation where
  toShATermAux :: ATermTable -> Presentation -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Presentation
xv = case Presentation
xv of
    Presentation a :: String
a b :: Maybe String
b c :: [Use]
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Maybe String
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [Use] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [Use]
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Presentation" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Presentation)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Presentation" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Maybe String
b') ->
      case Int -> ATermTable -> (ATermTable, [Use])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [Use]
c') ->
      (ATermTable
att3, String -> Maybe String -> [Use] -> Presentation
Presentation String
a' Maybe String
b' [Use]
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Presentation)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Presentation" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Imports where
  toShATermAux :: ATermTable -> Imports -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Imports
xv = case Imports
xv of
    Imports a :: IRI
a b :: Maybe Morphism
b c :: Maybe String
c d :: ImportsType
d e :: Conservativity
e -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> IRI -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 IRI
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> Maybe Morphism -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 Maybe Morphism
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 Maybe String
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> ImportsType -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 ImportsType
d
      (att5 :: ATermTable
att5, e' :: Int
e') <- ATermTable -> Conservativity -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att4 Conservativity
e
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Imports" [Int
a', Int
b', Int
c', Int
d', Int
e'] []) ATermTable
att5
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Imports)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Imports" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d, e :: Int
e] _ ->
      case Int -> ATermTable -> (ATermTable, IRI)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: IRI
a') ->
      case Int -> ATermTable -> (ATermTable, Maybe Morphism)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: Maybe Morphism
b') ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: Maybe String
c') ->
      case Int -> ATermTable -> (ATermTable, ImportsType)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: ImportsType
d') ->
      case Int -> ATermTable -> (ATermTable, Conservativity)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
e ATermTable
att4 of
      { (att5 :: ATermTable
att5, e' :: Conservativity
e') ->
      (ATermTable
att5, IRI
-> Maybe Morphism
-> Maybe String
-> ImportsType
-> Conservativity
-> Imports
Imports IRI
a' Maybe Morphism
b' Maybe String
c' ImportsType
d' Conservativity
e') }}}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Imports)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Imports" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.ImportsType where
  toShATermAux :: ATermTable -> ImportsType -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: ImportsType
xv = case ImportsType
xv of
    ITLocal -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "ITLocal" [] []) ATermTable
att0
    ITGlobal -> (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "ITGlobal" [] []) ATermTable
att0
  fromShATermAux :: Int -> ATermTable -> (ATermTable, ImportsType)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "ITLocal" [] _ -> (ATermTable
att0, ImportsType
ITLocal)
    ShAAppl "ITGlobal" [] _ -> (ATermTable
att0, ImportsType
ITGlobal)
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, ImportsType)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.ImportsType" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.Theory where
  toShATermAux :: ATermTable -> Theory -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: Theory
xv = case Theory
xv of
    Theory a :: String
a b :: [Constitutive]
b c :: [Presentation]
c d :: Maybe String
d -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [Constitutive] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [Constitutive]
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [Presentation] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [Presentation]
c
      (att4 :: ATermTable
att4, d' :: Int
d') <- ATermTable -> Maybe String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att3 Maybe String
d
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "Theory" [Int
a', Int
b', Int
c', Int
d'] []) ATermTable
att4
  fromShATermAux :: Int -> ATermTable -> (ATermTable, Theory)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "Theory" [a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, [Constitutive])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [Constitutive]
b') ->
      case Int -> ATermTable -> (ATermTable, [Presentation])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [Presentation]
c') ->
      case Int -> ATermTable -> (ATermTable, Maybe String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
d ATermTable
att3 of
      { (att4 :: ATermTable
att4, d' :: Maybe String
d') ->
      (ATermTable
att4, String
-> [Constitutive] -> [Presentation] -> Maybe String -> Theory
Theory String
a' [Constitutive]
b' [Presentation]
c' Maybe String
d') }}}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, Theory)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.Theory" ShATerm
u

instance ShATermConvertible OMDoc.OMDocInterface.OMDoc where
  toShATermAux :: ATermTable -> OMDoc -> IO (ATermTable, Int)
toShATermAux att0 :: ATermTable
att0 xv :: OMDoc
xv = case OMDoc
xv of
    OMDoc a :: String
a b :: [Theory]
b c :: [Inclusion]
c -> do
      (att1 :: ATermTable
att1, a' :: Int
a') <- ATermTable -> String -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att0 String
a
      (att2 :: ATermTable
att2, b' :: Int
b') <- ATermTable -> [Theory] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att1 [Theory]
b
      (att3 :: ATermTable
att3, c' :: Int
c') <- ATermTable -> [Inclusion] -> IO (ATermTable, Int)
forall t.
ShATermConvertible t =>
ATermTable -> t -> IO (ATermTable, Int)
toShATerm' ATermTable
att2 [Inclusion]
c
      (ATermTable, Int) -> IO (ATermTable, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ATermTable, Int) -> IO (ATermTable, Int))
-> (ATermTable, Int) -> IO (ATermTable, Int)
forall a b. (a -> b) -> a -> b
$ ShATerm -> ATermTable -> (ATermTable, Int)
addATerm (String -> [Int] -> [Int] -> ShATerm
ShAAppl "OMDoc" [Int
a', Int
b', Int
c'] []) ATermTable
att3
  fromShATermAux :: Int -> ATermTable -> (ATermTable, OMDoc)
fromShATermAux ix :: Int
ix att0 :: ATermTable
att0 = case Int -> ATermTable -> ShATerm
getShATerm Int
ix ATermTable
att0 of
    ShAAppl "OMDoc" [a :: Int
a, b :: Int
b, c :: Int
c] _ ->
      case Int -> ATermTable -> (ATermTable, String)
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
a ATermTable
att0 of
      { (att1 :: ATermTable
att1, a' :: String
a') ->
      case Int -> ATermTable -> (ATermTable, [Theory])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
b ATermTable
att1 of
      { (att2 :: ATermTable
att2, b' :: [Theory]
b') ->
      case Int -> ATermTable -> (ATermTable, [Inclusion])
forall t.
ShATermConvertible t =>
Int -> ATermTable -> (ATermTable, t)
fromShATerm' Int
c ATermTable
att2 of
      { (att3 :: ATermTable
att3, c' :: [Inclusion]
c') ->
      (ATermTable
att3, String -> [Theory] -> [Inclusion] -> OMDoc
OMDoc String
a' [Theory]
b' [Inclusion]
c') }}}
    u :: ShATerm
u -> String -> ShATerm -> (ATermTable, OMDoc)
forall a. String -> ShATerm -> a
fromShATermError "OMDoc.OMDocInterface.OMDoc" ShATerm
u