Sml_cats.hs revision 306763c67bb99228487345b32ab8c5c6cd41f23c
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder{- |
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiModule : $Header$
1549f3abf73c1122acff724f718b615c82fa3648Till MossakowskiCopyright : (c) Klaus L�ttich and Uni Bremen 2002-2004
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : hets@tzi.de
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederStability : provisional
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder
e6d40133bc9f858308654afb1262b8b483ec5922Till Mossakowski This module exports functions, that can convert an sml-CATS ATerm
1549f3abf73c1122acff724f718b615c82fa3648Till Mossakowski into the Haskell abstract syntax tree. So it contains all the
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder necessary instances of ATermConvertible and a heuritic function
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder that calculates the new lists of Pos out of Region tuples.
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
f8b715ab2993083761c0aedb78f1819bcf67b6ccChristian Maeder the templates for the instances are automatically derived by
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder DrIFT. But there were made many hand written changes.
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder todo:
ad270004874ce1d0697fb30d7309f180553bb315Christian Maeder - p_flag from pos-TERM is not considered jet!
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski-}
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang
23a00c966f2aa8da525d7a7c51933c99964426c0Christian Maedermodule ATC.Sml_cats (from_sml_ATerm,read_sml_ATerm) where
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maederimport Data.List (isPrefixOf)
8e9c3881fb6e710b1e08bf5ac8ff9d393df2e74eChristian Maederimport List (mapAccumL)
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maederimport Common.Lib.Map hiding (map)
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maeder-- better recompilation checking without 'import Common.ATerm.Lib'
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maederimport Common.ATerm.AbstractSyntax
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maederimport Common.ATerm.ReadWrite
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiimport Common.Utils
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maederimport Common.Id
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederimport Common.AS_Annotation
90c174bac60a72ffd81bc3bf5ae2dd9a61943b8bChristian Maeder
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian Maederimport CASL.AS_Basic_CASL
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettich
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maederimport CASL.Logic_CASL
ca020e82eb3567e7bdbb1cf70729efbd07e9caa4Klaus Luettichimport Logic.Grothendieck
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maederimport Syntax.AS_Structured
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskiimport Syntax.AS_Architecture
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederimport Syntax.AS_Library
c7e03d0708369f944b6f235057b39142a21599f2Mihai Codescu
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder-- for debugging only
986d3f255182539098a97ac86da9eeee5b7a72e3Christian Maeder-- import Debug.Trace (trace)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
8e80792f474d154ff11762fac081a422e34f1accChristian Maeder-- the following module provides the ability to parse the "unparsed-anno"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederimport Common.Lib.Parsec (parse,setPosition)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederimport Common.Lib.Parsec.Pos (newPos)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederimport qualified Common.Anno_Parser (annotations,parse_anno)
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederimport Common.Lexer(skip)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder--from_sml_ATerm :: ATermTable -> LIB_DEFN
16e124196c6b204769042028c74f533509c9b5d3Christian Maederread_sml_ATerm :: FilePath -> IO LIB_DEFN
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian Maeder
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder--from_sml_ATerm = fromShATerm
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maederread_sml_ATerm fn = readFile fn >>= return . from_sml_ATermString
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder----- Convertible class for sml -----------------------------------------
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maederclass ATermConvertibleSML t where
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder -- ATerm
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder -- conversion functions known from Joost Visser
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder to_sml_ATerm :: t -> ATerm
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder from_sml_ATerm :: ATerm -> t
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder -- conversion functions to omit overlapping instances
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder to_sml_ATermList :: [t] -> ATerm
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder from_sml_ATermList :: ATerm -> [t]
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder -- default functions ignore the Annotation part
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder to_sml_ATermList ts = AList (map to_sml_ATerm ts) []
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder from_sml_ATermList aterm =
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder case aterm of
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder AList aterms _ -> map from_sml_ATerm aterms
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder _ -> from_sml_ATermError "[a]" aterm
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder
351145cfe8c03b4d47133c96b209f2bd6cfbf504Christian Maeder -- ShATerm
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder -- functions for conversion to an ATermTable
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder to_sml_ShATerm :: ATermTable -> t -> (ATermTable,Int)
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder to_sml_ShATermList :: ATermTable -> [t] -> (ATermTable,Int)
81101b83a042f5a1bdeeef93b1b49aff05817e44Christian Maeder from_sml_ShATerm :: ATermTable -> t
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder from_sml_ShATermList :: ATermTable -> [t]
9eb39c7a0e7a1ddad1eec1d23c6d4e3a99c54023Christian Maeder
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder -- default functions ignore the Annotation part
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder to_sml_ShATermList at ts = addATerm (ShAList inds []) at'
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder where (at',inds) = mapAccumL to_sml_ShATerm at ts
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder from_sml_ShATermList at =
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder case aterm of
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder ShAList ats _ -> map conv ats
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder _ -> from_sml_ShATermError "[a]" aterm
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder where aterm = getATerm at
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder conv i = from_sml_ShATerm (getATermByIndex1 i at)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maederto_sml_ATermString :: ATermConvertibleSML a => a -> String
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederto_sml_ATermString t = (writeATerm . fst) (to_sml_ShATerm emptyATermTable t)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder
5e46b572ed576c0494768998b043d9d340594122Till Mossakowskito_sml_SharedATermString :: ATermConvertibleSML a => a -> String
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederto_sml_SharedATermString t = (writeSharedATerm . fst) (to_sml_ShATerm emptyATermTable t)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
fa167e362877db231378e17ba49c66fbb84862fcChristian Maederfrom_sml_ATermString :: ATermConvertibleSML a => String -> a
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederfrom_sml_ATermString s = (\ a -> from_sml_ShATerm a) (readATerm s)
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederfrom_sml_ATermError :: String -> ATerm -> a
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederfrom_sml_ATermError t u = error ("Cannot convert ATerm to "++t++": "++(err u))
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder where err u = case u of
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder AAppl s _ _ -> "!AAppl "++s
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder AList _ _ -> "!AList"
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski _ -> "!AInt"
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskifrom_sml_ShATermError :: String -> ShATerm -> a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowskifrom_sml_ShATermError t u = error ("Cannot convert Sml-ShATerm to "++t++": "++(err u))
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski where err u = case u of
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder ShAAppl s l _ -> "!ShAAppl "++s++"("++show (length l)++")"
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ShAList _ _ -> "!ShAList"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder _ -> "!ShAInt"
4b6aa93c12e4db86ccc7694a48a73e9cf7262d06Christian Maeder
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder-- basic instances -----------------------------------------------
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederinstance ATermConvertibleSML Bool where
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Bool\" not implemented"
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Bool\" not implemented"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Bool\" not implemented"
26d11a256b1433604a3dbc69913b520fff7586acChristian Maeder from_sml_ShATerm att = case at of
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder ShAAppl "true" [] _ -> True
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder ShAAppl "false" [] _ -> False
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder _ -> from_sml_ShATermError "Bool" at
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder where at = getATerm att
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder-- for Integer derive : ATermConvertibleSML hand written!
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maederinstance ATermConvertibleSML Integer where
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Integer\" not implemented"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Integer\" not implemented"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Integer\" not implemented"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder from_sml_ShATerm att = case at of
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder (ShAInt x _) -> x
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder _ -> from_sml_ShATermError "Integer" at
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder where at = getATerm att
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederinstance ATermConvertibleSML Int where
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Int\" not implemented"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Int\" not implemented"
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Int\" not implemented"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder from_sml_ShATerm att = case mi y of
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder (Just i) -> i
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder Nothing -> error ("Integer to big for Int: "++(show y))
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder where
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder y::Integer
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski y = from_sml_ShATerm att
74d9a385499bf903b24848dff450a153f525bda7Christian Maeder mi :: (Num a) => Integer -> Maybe a
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder mi x = if toInteger ((fromInteger::Integer->Int) x) == x
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder then Just (fromInteger x)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder else Nothing
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederinstance ATermConvertibleSML Char where
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Char\" not implemented"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Char\" not implemented"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder to_sml_ATermList _ = error "*** to_sml_ATerm for \"String\" not implemented"
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder from_sml_ATermList _ = error "*** from_sml_ATerm for \"String\" not implemented"
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Char\" not implemented"
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder from_sml_ShATerm att = case at of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl s [] _) -> conv s
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder _ -> from_sml_ShATermError "Char" at
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where at = getATerm att
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder to_sml_ShATermList _ _ = error "*** to_sml_ShATerm for \"String\" not implemented"
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder from_sml_ShATermList att = case at of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl s [] _) -> read s
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder _ -> from_sml_ShATermError "String" at
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski where at = getATerm att
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederconv :: String -> Char
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederconv ('\"':sr) = case reverse sr of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder ('\"':so) -> conv' (reverse so)
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder where
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder conv' ('\\':x:[]) = case x of
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder 'n' -> '\n'
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder 't' -> '\t'
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder 'r' -> '\r'
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder '\"' -> '\"'
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder _ -> error "very strange reach"
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder conv' (x:[]) = x
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder conv' _ = error "String not convertible to char"
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder _ -> error "No matching '\"' found"
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maederconv _ = error "String doesn't begin with '\"'"
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maederinstance (Ord a, ATermConvertibleSML a, ATermConvertibleSML b) => ATermConvertibleSML (Map a b) where
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder to_sml_ATerm fm = to_sml_ATerm (toList fm)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder from_sml_ATerm at = fromList $ from_sml_ATerm at
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maeder to_sml_ShATerm att fm = to_sml_ShATerm att $ toList fm
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder from_sml_ShATerm att = fromList $ from_sml_ShATerm att
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maeder
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maederinstance ATermConvertibleSML a => ATermConvertibleSML [a] where
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski to_sml_ATerm l = to_sml_ATermList l
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder from_sml_ATerm at = from_sml_ATermList at
ab642ff136ce716af9e609b667e3f06d766c4ad7Christian Maeder to_sml_ShATerm att l = to_sml_ShATermList att l
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder from_sml_ShATerm att = from_sml_ShATermList att
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederinstance (ATermConvertibleSML a,ATermConvertibleSML b) => ATermConvertibleSML (a,b) where
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder to_sml_ATerm (a,b) = AAppl "" [to_sml_ATerm a,to_sml_ATerm b] []
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder from_sml_ATerm at = case at of
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder (AAppl "" [a,b] _) -> (from_sml_ATerm a,from_sml_ATerm b)
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder _ -> from_sml_ATermError "(a,b)" at
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder to_sml_ShATerm att (x,y) = addATerm (ShAAppl "" [x',y'] []) att'
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder where (att' ,y') = to_sml_ShATerm att'' y
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder (att'',x') = to_sml_ShATerm att x
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder from_sml_ShATerm att = case at of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl "" [x,y] _) -> (x',y')
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where x' = from_sml_ShATerm (getATermByIndex1 x att)
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder y' = from_sml_ShATerm (getATermByIndex1 y att)
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder _ -> from_sml_ShATermError "(a,b)" at
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where at = getATerm att
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maederinstance (ATermConvertibleSML a, ATermConvertibleSML b, ATermConvertibleSML c) => ATermConvertibleSML (a,b,c) where
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder to_sml_ATerm (a,b,c) = AAppl "" [to_sml_ATerm a, to_sml_ATerm b, to_sml_ATerm c] []
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder from_sml_ATerm at = case at of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (AAppl "" [a,b,c] _) -> (from_sml_ATerm a, from_sml_ATerm b, from_sml_ATerm c)
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder _ -> from_sml_ATermError "(a,b,c)" at
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder to_sml_ShATerm att (a,b,c) = addATerm (ShAAppl "" [a',b',c'] []) att1
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder where (att1,c') = to_sml_ShATerm att'' c
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder (att'',b') = to_sml_ShATerm att' b
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder (att',a') = to_sml_ShATerm att a
88124ca824f94153b0a2a24ea1e4b089fff7011fChristian Maeder from_sml_ShATerm att = case at of
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl "" [a,b,c] _) -> (a',b',c')
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where a' = from_sml_ShATerm (getATermByIndex1 a att)
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder b' = from_sml_ShATerm (getATermByIndex1 b att)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder c' = from_sml_ShATerm (getATermByIndex1 c att)
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder _ -> from_sml_ShATermError "(a,b,c)" at
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where at = getATerm att
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maederinstance (ATermConvertibleSML a, ATermConvertibleSML b, ATermConvertibleSML c, ATermConvertibleSML d) => ATermConvertibleSML (a,b,c,d) where
8c63cd89ef840cd7a3d3b75f0207dc800388c800Christian Maeder to_sml_ATerm (a,b,c,d) = AAppl "" [to_sml_ATerm a, to_sml_ATerm b, to_sml_ATerm c,to_sml_ATerm d] []
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder from_sml_ATerm at = case at of
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski (AAppl "" [a,b,c,d] _) -> (from_sml_ATerm a, from_sml_ATerm b, from_sml_ATerm c, from_sml_ATerm d)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder _ -> from_sml_ATermError "(a,b,c)" at
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder to_sml_ShATerm att (a,b,c,d) = addATerm (ShAAppl "" [a',b',c',d'] []) att2
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder where (att2,d') = to_sml_ShATerm att1 d
ee152ae82dc19d6415119c0019ae1bfa991b1f02Christian Maeder (att1,c') = to_sml_ShATerm att'' c
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder (att'',b') = to_sml_ShATerm att' b
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski (att',a') = to_sml_ShATerm att a
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski from_sml_ShATerm att = case at of
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder (ShAAppl "" [a,b,c,d] _) -> (a',b',c',d')
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder where a' = from_sml_ShATerm (getATermByIndex1 a att)
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder b' = from_sml_ShATerm (getATermByIndex1 b att)
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder c' = from_sml_ShATerm (getATermByIndex1 c att)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder d' = from_sml_ShATerm (getATermByIndex1 d att)
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder _ -> from_sml_ShATermError "(a,b,c)" at
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder where at = getATerm att
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder----- instances of Id.hs ------------------------------------------------
03136b84a0c70d877e227444f0875e209506b9e4Christian Maederinstance ATermConvertibleSML Token where
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Token\" not implemented"
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Token\" not implemented"
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Token\" not implemented"
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder from_sml_ShATerm att =
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder case aterm of
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder (ShAAppl "token" [ aa ] _) ->
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder let
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder ab' = nullPos
99476ac2689c74251219db4782e57fe713a24a52Christian Maeder in (Token aa' ab')
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder (ShAAppl "place" [] _) ->
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder let
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder aa' = Common.Id.place
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ab' = nullPos
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder in (Token aa' ab')
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder _ -> from_sml_ShATermError "Token" aterm
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder where
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski aterm = getATerm att
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maederinstance ATermConvertibleSML Id where
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Id\" not implemented"
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Id\" not implemented"
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Id\" not implemented"
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder from_sml_ShATerm att =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder case aterm of
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder (ShAAppl "compound-id" [ aa,ab ] _) -> -- TOKEN_OR_MIXFIX,[ID]
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder aa' = from_sml_ATermTokenTup (getATermByIndex1 aa att)
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder ac' = []
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder in (Id aa' ab' ac')
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder (ShAAppl "simple-id" [ aa ] _) ->
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder let
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder aa' = from_sml_ATermTokenTup (getATermByIndex1 aa att)
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder ab' = []
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder ac' = []
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder in (Id aa' ab' ac')
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder _ -> from_sml_ShATermError "Id" aterm
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder where
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder aterm = getATerm att
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder-------------------------------------------------------------------------
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maederfrom_sml_ATermTokenTup :: ATermTable -> [Token]
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maederfrom_sml_ATermTokenTup att =
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian Maeder case aterm of
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder (ShAAppl "" [tops,_,_] _) ->
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder from_sml_ShATerm (getATermByIndex1 tops att)
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder _ -> from_sml_ShATermError "Token" aterm
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder where aterm = getATerm att
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder----- instances of AS_Annotation.hs -------------------------------------
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maederinstance ATermConvertibleSML Annotation where
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"Annotation\" not implemented"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"Annotation\" not implemented"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"Annotation\" not implemented"
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder from_sml_ShATerm att =
caf021dd48c90ff6b26117f13e1d8c0ef1ca618aChristian Maeder case aterm of
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder (ShAAppl "comment-line" [ aa ] _) ->
b10d6cef708b7a659f2d3b367e8e0db0d03ae3f5Till Mossakowski let
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder aa' = chomp $ from_sml_ShATerm (getATermByIndex1 aa att)
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder ab' = pos_l
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder in (Unparsed_anno Comment_start (Line_anno aa') ab')
fbf1cdad9a9775bd7332e85f01b6a307d7dbb1cfChristian Maeder (ShAAppl "comment" [ aa ] _) ->
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder let
a23e572c8f957cc051a1b0831abd6fe9380d45c7Christian Maeder aa' = lines (from_sml_ShATerm (getATermByIndex1 aa att))
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ab' = pos_l
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder in (Unparsed_anno Comment_start (Group_anno aa') ab')
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder (ShAAppl "unparsed-anno" [ aa ] _) ->
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder parse_anno pos_l
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder (from_sml_ShATerm (getATermByIndex1 aa att))
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder (ShAAppl "annote-line" [ aa,ab ] _) ->
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder let
e01299e9b22b96b31b720ca1e9f9f5f25af9b024Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder ac' = pos_l
4fc727afa544a757d1959ce77c02208f8bf330dcChristian Maeder in (Unparsed_anno (Annote_word aa') (Line_anno ab') ac')
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder (ShAAppl "annote-group" [ aa,ab ] _) ->
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder let
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ac' = pos_l
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder in (Unparsed_anno (Annote_word aa') (Group_anno ab') ac')
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder (ShAAppl "display-anno" [ aa,ab ] _) ->
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder let
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
4fc727afa544a757d1959ce77c02208f8bf330dcChristian Maeder ab' = parse_disp_anno aa' pos_l
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder (chomp $ from_sml_ShATerm (getATermByIndex1 ab att))
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder in ab'
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder (ShAAppl "string-anno" [ aa,ab ] _) ->
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder let
68138d26bcddf5e89c30206aa83ab5ec006d170dChristian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder ac' = pos_l
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder in (String_anno aa' ab' ac')
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder (ShAAppl "list-anno" [ aa,ab,ac ] _) ->
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder let
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ac' = from_sml_ShATerm (getATermByIndex1 ac att)
74d9a385499bf903b24848dff450a153f525bda7Christian Maeder ad' = pos_l
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski in (List_anno aa' ab' ac' ad')
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder (ShAAppl "number-anno" [ aa ] _) ->
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder let
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski aa' = from_sml_ShATerm (getATermByIndex1 aa att)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ab' = pos_l
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski in (Number_anno aa' ab')
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder (ShAAppl "floating-anno" [ aa,ab ] _) ->
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski let
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski aa' = from_sml_ShATerm (getATermByIndex1 aa att)
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski ab' = from_sml_ShATerm (getATermByIndex1 ab att)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder ac' = pos_l
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder in (Float_anno aa' ab' ac')
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl "prec-anno" [ aa,ab,ac ] _) ->
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski let
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder ab' = from_sml_ShATerm (getATermByIndex1 ab att)
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder ac' = from_sml_ShATerm (getATermByIndex1 ac att)
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder ad' = pos_l
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder in (Prec_anno (if aa' then Lower else BothDirections)
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder ab' ac' ad')
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder (ShAAppl "lassoc-anno" [ aa ] _) ->
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder let
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder ab' = pos_l
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder in (Assoc_anno ALeft aa' ab')
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder (ShAAppl "rassoc-anno" [ aa ] _) ->
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder let
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder ab' = pos_l
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder in (Assoc_anno ARight aa' ab')
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder (ShAAppl "label-anno" [ aa ] _) ->
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder let
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder aa' =
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder lines (showId (from_sml_ShATerm (getATermByIndex1 aa att)) "")
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder ab' = pos_l
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder in (Label aa' ab')
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder (ShAAppl "implies" [] _) ->
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder let
be98c516a8ff1d496fcdeb9b8be8c5f4b908ab95Christian Maeder aa' = pos_l
22eea35d0effc6582b2951a28b5240fa7a82f3dfChristian Maeder in (Semantic_anno SA_implies aa')
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder (ShAAppl "definitional" [] _) ->
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder let
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder aa' = pos_l
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder in (Semantic_anno SA_def aa')
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl "conservative" [] _) ->
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder let
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder aa' = pos_l
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder in (Semantic_anno SA_cons aa')
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder (ShAAppl "mono" [] _) ->
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder Semantic_anno SA_mono pos_l
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder _ -> from_sml_ShATermError "Annotation" aterm
ebc51e8081f6f1fe2f3d39ceff81d8dd0169c0b0Christian Maeder where
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder aterm = getATerm att'
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder (pos_l,att') =
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski case getATerm att of
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder (ShAAppl "pos-ANNO" [reg_i,item_i] _) ->
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder (posFromRegion reg_i att,getATermByIndex1 item_i att)
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder _ -> ([],att)
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder
03136b84a0c70d877e227444f0875e209506b9e4Christian Maeder--- Well the following instance has to tie together things, that don't
5a9a06d23910b9521e1d1cd39865ac7912ccee4bChristian Maeder--- belong to each other. Because I can't declare instances for
5a9a06d23910b9521e1d1cd39865ac7912ccee4bChristian Maeder--- certain "Annoted types"
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maederinstance (ATermConvertibleSML a) => ATermConvertibleSML (Annoted a) where
d058429727dd696a0327cdc28cadd268c34c36baChristian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"(Annoted a)\" not implemented"
329d1810c6d5a5a0827e1d07503d94431578d176Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"(Annoted a)\" not implemented"
5e46b572ed576c0494768998b043d9d340594122Till Mossakowski to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"(Annoted a)\" not implemented"
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder from_sml_ShATerm att =
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder case aterm of
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (ShAAppl con as _) ->
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder (case con of
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder -- Basic Items (including sig_items)
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder "pos-BASIC-ITEMS" ->
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder let (bi,las) = from_sml_ATermAnnotedBasic_Items att
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder in Annoted bi [] las []
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder -- L_.* constuctors from SML
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder "" -> Annoted (from_sml_ShATerm (getATermByIndex1
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder (head as)
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder att))
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder []
27b37f8e6b165f7abb653a54b45ffcdb81cec561Christian Maeder []
86b1d0c80abdd4ca36491cf7025b718a5fea5080Christian Maeder (toAnnoList (last as) att)
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder _ -> -- "No appropiate constructor for Annoted found"
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder Annoted (from_sml_ShATerm att)
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian Maeder []
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski []
32562a567baac248a00782d2727716c13117dc4aChristian Maeder []
32562a567baac248a00782d2727716c13117dc4aChristian Maeder )
32562a567baac248a00782d2727716c13117dc4aChristian Maeder _ -> from_sml_ShATermError "Annoted a" aterm
32562a567baac248a00782d2727716c13117dc4aChristian Maeder where
32562a567baac248a00782d2727716c13117dc4aChristian Maeder aterm = getATerm att
32562a567baac248a00782d2727716c13117dc4aChristian Maeder
0e2ae85e2453466d03c1fc5884a3d693235bb9d9Christian Maeder---- functions to convert annoted stuff ---------------------------------
4601edb679f0ba530bbb085b25d82a411cd070aaChristian Maeder-- all these functions are called by instance ATermConvertibleSML Annoted a
32562a567baac248a00782d2727716c13117dc4aChristian Maeder
32562a567baac248a00782d2727716c13117dc4aChristian Maederfrom_sml_ATermAnnotedBasic_Items :: forall a . ATermConvertibleSML a =>
32562a567baac248a00782d2727716c13117dc4aChristian Maeder ATermTable -> (a,[Annotation])
32562a567baac248a00782d2727716c13117dc4aChristian Maederfrom_sml_ATermAnnotedBasic_Items att =
32562a567baac248a00782d2727716c13117dc4aChristian Maeder if isSig_items then
32562a567baac248a00782d2727716c13117dc4aChristian Maeder ((from_sml_ShATerm att),[])
746440cc1b984a852f5864235b8fa3930963a081Christian Maeder else ((from_sml_ShATerm att),annoList)
32562a567baac248a00782d2727716c13117dc4aChristian Maeder where isSig_items =
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder case aterm of
7a47fbe6b987bd69a5056ce5d00fc8710f6c5e8aChristian Maeder (ShAAppl _ as _)-> -- pos-BASIC-ITEMS
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder case getATerm $ getATermByIndex1 (last as) att of
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder (ShAAppl "sig-items" _ _) -> True
e68f45f355ed9d4026ee9baff5aa75aa7c911cc2Christian Maeder _ -> False
e68f45f355ed9d4026ee9baff5aa75aa7c911cc2Christian Maeder _ -> from_sml_ShATermError "{SIG,BASIC}_items" aterm
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder aterm = getATerm att
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder annoList = case getATerm att of
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder (ShAAppl _ as _) -> getAnnoList (last as) att
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder _ -> error "Wrong ATerm structure: BASIC_ITEMS"
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder{- att' = let (ShAAppl _ as _) = getATerm att -- pos-BASIC-ITEMS
fa167e362877db231378e17ba49c66fbb84862fcChristian Maeder (ShAAppl _ as' _) = getATerm $ -- sig-items
4aa35aadcb28f8a962096efc70d3bdb58ab7d9faChristian Maeder getATermByIndex1 (head as) att
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder in getATermByIndex1 (head as') att -}
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder{-from_sml_ATermAnnotedSig_Items :: ATermTable -> [SIG_ITEMS]
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederfrom_sml_ATermAnnotedSig_Items att =
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- Sig Items have an anno list which now is attached to
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- the first item
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder Just "s-items" ->
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder let aterm' = getATerm (getATermByIndex1 (head as) att)
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder as' = case aterm' of ShAAppl _ as _ -> as
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder in Annoted (from_sml_ShATerm att)
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder []
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder []
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder (getAnnoList (last as) att)
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-}
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- getAnnoList and toAnnoList are only working with an AIndex as first
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- argument is given. If getAnnoList is called every ShAAppl that starts _
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- with "pos-" is crossed without consideration. toAnnoList just calls
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-- the [Annotation] conversion directly.
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian MaedergetAnnoList :: Int -> ATermTable -> [Annotation]
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian MaedergetAnnoList ai att = case at of
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder ShAAppl c as _ | isPrefixOf "pos-" c ->
6a22b2854c3bc9cb4877cb7d29049d6559238639Christian Maeder getAnnoList (last as) att
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder ShAAppl _ as _ -> toAnnoList (last as) att
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder _ -> error "wrong storage or missed 'pos-' contructor"
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder where at = getATerm (getATermByIndex1 ai att)
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian MaedertoAnnoList :: Int -> ATermTable -> [Annotation]
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian MaedertoAnnoList ai att = from_sml_ShATerm $ getATermByIndex1 ai att
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder-------------------------------------------------------------------------
575a55eadc8dcab8ee350324b417cbd9e52e69c0Christian Maeder
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederparse_anno :: [Pos] -> String -> Annotation
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maederparse_anno pos_l inp =
d79a4d0d842c212f82f9507fff178ffe4ba2e214Christian Maeder case (parse (set_pos Common.Anno_Parser.annotations) "" inp) of
32562a567baac248a00782d2727716c13117dc4aChristian Maeder Left err -> error ("internal parse error at " ++ (show err))
32562a567baac248a00782d2727716c13117dc4aChristian Maeder Right [x] -> x
32562a567baac248a00782d2727716c13117dc4aChristian Maeder Right _ -> error ("something strange happend to \"" ++
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder inp ++ "\" during ATerm Conversion")
32562a567baac248a00782d2727716c13117dc4aChristian Maeder where set_pos p = do setPosition sp
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder skip
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder p
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder sp = pos -- newPos "ATermConversion from SML" (fst pos) (snd pos)
32562a567baac248a00782d2727716c13117dc4aChristian Maeder pos = head pos_l
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maederparse_disp_anno :: Id -> [Pos] -> String -> Annotation
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maederparse_disp_anno i pos_l inp =
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder case (Common.Anno_Parser.parse_anno (Unparsed_anno (Annote_word "display")
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder (Group_anno [inp']) pos_l) sp) of
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder Left err -> error ("internal parse error at " ++ (show err))
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder --Right [] -> error $ "No displayanno: " ++ inp'
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder Right x -> x -- trace ("parsed display anno:" ++ show x) x
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder --Right xs -> error $ "More than one displayanno" ++ show xs
3b70d8ee5c2927f843d5d907e6ef724f867f1b40Till Mossakowski where sp = pos -- newPos "ATermConversion from SML" (fst pos) (snd pos)
a001917177db7ae636853b37c0d0f9f4e90a83ffChristian Maeder pos = head pos_l
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder inp' = (showId i "") ++ (' ':s_inp)
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder s_inp = case reverse inp of
3b70d8ee5c2927f843d5d907e6ef724f867f1b40Till Mossakowski rin | "%)" `isPrefixOf` rin -> reverse $ drop 2 rin
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder | otherwise -> inp
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder----- instances of AS_Basic_CASL.hs -------------------------------------
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maederinstance ATermConvertibleSML BASIC_SPEC where
ca732bc259f74cb4f3f725daab7fe80fc7e1d9a0Till Mossakowski to_sml_ATerm _ = error "*** to_sml_ATerm for \"BASIC_SPEC\" not implemented"
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"BASIC_SPEC\" not implemented"
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"BASIC_SPEC\" not implemented"
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder from_sml_ShATerm att =
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder case aterm of
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder (ShAAppl "basic-spec" [ aa ] _) ->
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder let
2766ec926fcf3faf72248b10c3305b715b8c3249Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ca732bc259f74cb4f3f725daab7fe80fc7e1d9a0Till Mossakowski in (CASL.AS_Basic_CASL.Basic_spec aa')
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang _ -> from_sml_ShATermError "BASIC_SPEC" aterm
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang where
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang aterm = getATerm att'
aea143fff7a50aceb809845fbc42698b0b3f545aChristian Maeder att' =
58b671de3fe578346fef9642ffa3c5a0a0edb3cbTill Mossakowski case getATerm att of
5824312cc0cfccce61f195fbe92307a21a467049Christian Maeder (ShAAppl "pos-BASIC-SPEC" [_,item_i] _) ->
2561b4bfc45d280ee2be8a7870314670e4e682e4Christian Maeder getATermByIndex1 item_i att
5824312cc0cfccce61f195fbe92307a21a467049Christian Maeder _ -> att
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maeder
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maederinstance ATermConvertibleSML BASIC_ITEMS where
9ecf13b5fd914bc7272f1fc17348d7f4a8c77061Christian Maeder to_sml_ATerm _ = error "*** to_sml_ATerm for \"BASIC_ITEMS\" not implemented"
5824312cc0cfccce61f195fbe92307a21a467049Christian Maeder from_sml_ATerm _ = error "*** from_sml_ATerm for \"BASIC_ITEMS\" not implemented"
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maeder to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"BASIC_ITEMS\" not implemented"
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder from_sml_ShATerm att =
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder case aterm of
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder (ShAAppl "sig-items" [ aa ] _) ->
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder let
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder in (Sig_items aa')
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder (ShAAppl "free-datatype" [ aa,_ ] _) ->
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder let
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder ab' = pos_l
40d15f6c5f4d15866e085c588f8b5130dfd6cf63Christian Maeder in (Free_datatype aa' ab')
d0c66a832d7b556e20ea4af4852cdc27a5463d51Christian Maeder (ShAAppl "sort-gen" [ aa,_ ] _) ->
e82587ca2892d246aa4405c2f5b9f30f287f9ebfChristian Maeder let
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
2b2f3b72e82e28b34db9c69af2d1ec38f228272eChristian Maeder ab' = pos_l
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang in (Sort_gen aa' ab')
5824312cc0cfccce61f195fbe92307a21a467049Christian Maeder (ShAAppl "var-items" [ aa,_ ] _) ->
db453fe9625a9dab5d108f7a5e464598814144b8Jian Chun Wang let
5824312cc0cfccce61f195fbe92307a21a467049Christian Maeder aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Var_items aa' ab')
(ShAAppl "local-var-axioms" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Local_var_axioms aa' ab' ac')
(ShAAppl "axiom-items" [ aa,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Axiom_items aa' ab')
_ -> from_sml_ShATermError "BASIC_ITEMS" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-BASIC-ITEMS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML SIG_ITEMS where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SIG_ITEMS\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SIG_ITEMS\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SIG_ITEMS\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "sort-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
as = from_sml_ShATerm (getATermByIndex1 ab att)
aa'' = (addLAnnoList as $ head aa'):(tail aa')
ab' = pos_l
in (Sort_items aa'' ab')
(ShAAppl "op-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
as = from_sml_ShATerm (getATermByIndex1 ab att)
aa'' = (addLAnnoList as $ head aa'):(tail aa')
ab' = pos_l
in (Op_items aa'' ab')
(ShAAppl "pred-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
as = from_sml_ShATerm (getATermByIndex1 ab att)
aa'' = (addLAnnoList as $ head aa'):(tail aa')
ab' = pos_l
in (Pred_items aa'' ab')
(ShAAppl "datatype-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
as = from_sml_ShATerm (getATermByIndex1 ab att)
aa'' = (addLAnnoList as $ head aa'):(tail aa')
ab' = pos_l
in (Datatype_items aa'' ab')
_ -> from_sml_ShATermError "SIG_ITEMS" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SIG-ITEMS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML SORT_ITEM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SORT_ITEM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SORT_ITEM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SORT_ITEM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "sort-decl" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Sort_decl aa' ab')
(ShAAppl "subsort-decl" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Subsort_decl aa' ab' ac')
(ShAAppl "subsort-defn" [ aa,ab,ac,ad,ae ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ATermSIMPLE_ID (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = from_sml_ShATerm (getATermByIndex1 ad att)
as = toAnnoList ae att
ad''= addRAnnoList as ad'
ae' = pos_l
in (Subsort_defn aa' ab' ac' ad'' ae')
(ShAAppl "iso-decl" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Iso_decl aa' ab')
_ -> from_sml_ShATermError "SORT_ITEM" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SORT-ITEM" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML OP_ITEM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"OP_ITEM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"OP_ITEM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"OP_ITEM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "op-decl" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = pos_l
in (Op_decl aa' ab' ac' ad')
(ShAAppl "op-defn" [ aa,ab,ac,ad ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
as = from_sml_ShATerm (getATermByIndex1 ad att)
ac''= addRAnnoList as ac'
ad' = pos_l
in (Op_defn aa' ab' ac'' ad')
_ -> from_sml_ShATermError "OP_ITEM" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-OP-ITEM" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML OP_TYPE where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"OP_TYPE\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"OP_TYPE\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"OP_TYPE\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "total-op-type" [ aa,ab ] _) ->
let
(aa',ps) = from_sml_ATermSORTS (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = insertPos ps pos_l
in (Total_op_type aa' ab' ac')
(ShAAppl "partial-op-type" [ aa,ab ] _) ->
let
(aa',ps) = from_sml_ATermSORTS (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = insertPos ps pos_l
in (Partial_op_type aa' ab' ac')
_ -> from_sml_ShATermError "OP_TYPE" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-OP-TYPE" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
---- a helper for the SML-datatype SORTS -------------------------------
from_sml_ATermSORTS :: ATermTable -> ([SORT],[Pos])
from_sml_ATermSORTS att =
case aterm of
(ShAAppl "sorts" [ aa ] _) ->
(from_sml_ShATerm (getATermByIndex1 aa att),pos_l)
_ -> from_sml_ShATermError "([SORT],[Pos])" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SORTS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
------------------------------------------------------------------------
instance ATermConvertibleSML OP_HEAD where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"OP_HEAD\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"OP_HEAD\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"OP_HEAD\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "total-op-head" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Total_op_head aa' ab' ac')
(ShAAppl "partial-op-head" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Partial_op_head aa' ab' ac')
_ -> from_sml_ShATermError "OP_HEAD" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-OP-HEAD" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML ARG_DECL where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"ARG_DECL\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"ARG_DECL\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"ARG_DECL\" not implemented"
from_sml_ShATerm att =
case aterm of
-- (ShAAppl "arg-decl" [ ShAAppl "" [aa,ab] _ ] _) ->
(ShAAppl "" [aa,ab] _) ->
let
aa' = from_sml_ATermVARs (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Arg_decl aa' ab' ac')
_ -> from_sml_ShATermError "ARG_DECL" aterm
where
-- Just aterm = getATermSp att' $ ShAAppl "arg-decl" [ShAAppl "" [] _] _
aterm = case getATerm att' of
ShAAppl "arg-decl" [i] _ ->
snd $ getATermByIndex i att
x -> from_sml_ShATermError "arg-decl" x
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-ARG-DECL" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML OP_ATTR where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"OP_ATTR\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"OP_ATTR\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"OP_ATTR\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "associative" [ ] _) ->
let
in Assoc_op_attr
(ShAAppl "commutative" [ ] _) ->
let
in Comm_op_attr
(ShAAppl "idempotent" [ ] _) ->
let
in Idem_op_attr
(ShAAppl "unit-op-attr" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Unit_op_attr aa')
_ -> from_sml_ShATermError "OP_ATTR" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-OP-ATTR" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML PRED_ITEM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"PRED_ITEM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"PRED_ITEM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"PRED_ITEM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "pred-decl" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Pred_decl aa' ab' ac')
(ShAAppl "pred-defn" [ aa,ab,ac,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = pos_l
in (Pred_defn aa' ab' ac' ad')
_ -> from_sml_ShATermError "PRED_ITEM" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-PRED-ITEM" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML PRED_TYPE where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"PRED_TYPE\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"PRED_TYPE\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"PRED_TYPE\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "pred-type" [ aa ] _) ->
let
(aa',ps) = from_sml_ATermSORTS (getATermByIndex1 aa att)
ab' = insertPos ps pos_l
in (Pred_type aa' ab')
_ -> from_sml_ShATermError "PRED_TYPE" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-PRED-TYPE" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML PRED_HEAD where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"PRED_HEAD\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"PRED_HEAD\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"PRED_HEAD\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "pred-head" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Pred_head aa' ab')
_ -> from_sml_ShATermError "PRED_HEAD" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-PRED-HEAD" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML DATATYPE_DECL where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"DATATYPE_DECL\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"DATATYPE_DECL\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"DATATYPE_DECL\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "datatype-decl" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
as = from_sml_ShATerm (getATermByIndex1 ac att)
ab''= (addLAnnoList as $ head ab'):(tail ab')
ac' = pos_l
in (Datatype_decl aa' ab'' ac')
_ -> from_sml_ShATermError "DATATYPE_DECL" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-DATATYPE-DECL" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML ALTERNATIVE where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"ALTERNATIVE\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"ALTERNATIVE\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"ALTERNATIVE\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "total-construct" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Total_construct aa' ab' ac')
(ShAAppl "partial-construct" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Partial_construct aa' ab' ac')
(ShAAppl "subsort" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Subsorts aa' ab')
_ -> from_sml_ShATermError "ALTERNATIVE" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-ALTERNATIVE" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML COMPONENTS where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"COMPONENTS\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"COMPONENTS\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"COMPONENTS\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "total-select" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Total_select aa' ab' ac')
(ShAAppl "partial-select" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Partial_select aa' ab' ac')
(ShAAppl "sort-component" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Sort aa')
_ -> from_sml_ShATermError "COMPONENTS" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-COMPONENTS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML VAR_DECL where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"VAR_DECL\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"VAR_DECL\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"VAR_DECL\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "" [ aa,ab ] _) ->
let
aa' = from_sml_ATermVARs (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in (Var_decl aa' ab' [])
_ -> from_sml_ShATermError "VAR_DECL" aterm
where
aterm = getATerm att
instance ATermConvertibleSML FORMULA where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"FORMULA\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"FORMULA\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"FORMULA\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "quantification" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
pq = getPos (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = insertPos pq pos_l
in (Quantification aa' ab' ac' ad')
(ShAAppl "conjunction" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Conjunction aa' ab')
(ShAAppl "disjunction" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Disjunction aa' ab')
(ShAAppl "implication" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Implication aa' ab' ac')
(ShAAppl "equivalence" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Equivalence aa' ab' ac')
(ShAAppl "negation" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Negation aa' ab')
-- the following things are from SML-type ATOM
(ShAAppl "atom" [i] _) ->
case snd (getATermByIndex i att') of
(ShAAppl "ttrue" [] _) ->
let
aa' = pos_l
in (True_atom aa')
(ShAAppl "ffalse" [] _) ->
let
aa' = pos_l
in (False_atom aa')
(ShAAppl "predication" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
(ab',ps) = from_sml_ATermTERMS (getATermByIndex1 ab att)
ac' = insertPos ps pos_l
in (Predication aa' ab' ac')
(ShAAppl "definedness" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Definedness aa' ab')
(ShAAppl "existl-equation" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Existl_equation aa' ab' ac')
(ShAAppl "strong-equation" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Strong_equation aa' ab' ac')
(ShAAppl "membership" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Membership aa' ab' ac')
_ -> from_sml_ShATermError "FORMULA" aterm
_ -> from_sml_ShATermError "FORMULA" aterm
where
aterm = getATerm att'
(pos_l,_g_flag,att') = skipPosFlag "pos-FORMULA" att
---- a helper for the SML-datatype TERMS -------------------------------
from_sml_ATermTERMS :: ATermTable -> ([TERM],[Pos])
from_sml_ATermTERMS att =
case aterm of
(ShAAppl "terms" [ aa ] _) ->
(from_sml_ShATerm (getATermByIndex1 aa att),pos_l)
_ -> from_sml_ShATermError "([TERM],[Pos])" aterm
where aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-TERMS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
---- a helper for SIMPLE_IDs --------------------------------------------
from_sml_ATermSIMPLE_ID :: ATermTable -> SIMPLE_ID
from_sml_ATermSIMPLE_ID att =
case aterm of
(ShAAppl "" [ si, _ ] _) -> -- snd element is 'None'
-- (CASL.grm:((WORDS,None)))
let s = from_sml_ShATerm $ getATermByIndex1 si att
in Token s nullPos
_ -> from_sml_ShATermError "SIMPLE_ID" aterm
where aterm = getATerm att
---- a helper for [VAR] -------------------------------------------------
from_sml_ATermVARs :: ATermTable -> [VAR]
from_sml_ATermVARs att = map from_sml_ATermSIMPLE_ID att_list
where att_list = case getATerm att of
ShAList l _-> map getAtt l
_ -> from_sml_ShATermError "[VAR]" $ getATerm att
getAtt ai = getATermByIndex1 ai att
-------------------------------------------------------------------------
instance ATermConvertibleSML QUANTIFIER where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"QUANTIFIER\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"QUANTIFIER\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"QUANTIFIER\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "forall" [ ] _) ->
let
in Universal
(ShAAppl "exists" [ ] _) ->
let
in Existential
(ShAAppl "exists-uniquely" [ ] _) ->
let
in Unique_existential
_ -> from_sml_ShATermError "QUANTIFIER" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-QUANTIFIER" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML PRED_SYMB where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"PRED_SYMB\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"PRED_SYMB\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"PRED_SYMB\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "pred-symb" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in case getATerm $ getATermByIndex1 ab att of
ShAAppl "None" [] _ ->
(Pred_name aa')
ShAAppl "Some" [ aab ] _ ->
let aab' = from_sml_ShATerm (getATermByIndex1 aab att)
ac' = pos_l
in (Qual_pred_name aa' aab' ac')
_ -> from_sml_ShATermError "Option" aterm
_ -> from_sml_ShATermError "PRED_SYMB" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-PRED-SYMB" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML TERM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"TERM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"TERM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"TERM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "var-or-const" [ aa ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
in (Simple_id aa')
(ShAAppl "qual-var" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Qual_var aa' ab' ac')
(ShAAppl "application" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
(ab',ps) = from_sml_ATermTERMS (getATermByIndex1 ab att)
ac' = insertPos ps pos_l
in (Application aa' ab' ac')
(ShAAppl "sorted-term" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Sorted_term aa' ab' ac')
(ShAAppl "cast" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Cast aa' ab' ac')
(ShAAppl "conditional" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = pos_l
in (Conditional aa' ab' ac' ad')
_ -> from_sml_ShATermError "TERM" aterm
where
aterm = getATerm att'
(pos_l,_p_flag,att') = skipPosFlag "pos-TERM" att
instance ATermConvertibleSML OP_SYMB where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"OP_SYMB\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"OP_SYMB\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"OP_SYMB\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "op-symb" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in case getATerm $ getATermByIndex1 ab att of
ShAAppl "None" [] _ ->
(Op_name aa')
ShAAppl "Some" [ aab ] _ ->
let aab' = from_sml_ShATerm (getATermByIndex1 aab att)
ac' = pos_l
in (Qual_op_name aa' aab' ac')
_ -> from_sml_ShATermError "Option" aterm
_ -> from_sml_ShATermError "OP_SYMB" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-OP-SYMB" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML SYMB_ITEMS where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SYMB_ITEMS\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SYMB_ITEMS\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SYMB_ITEMS\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "symb-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Symb_items aa' ab' ac')
_ -> from_sml_ShATermError "SYMB_ITEMS" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SYMB-ITEMS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML SYMB_MAP_ITEMS where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SYMB_MAP_ITEMS\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SYMB_MAP_ITEMS\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SYMB_MAP_ITEMS\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "symb-map-items" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Symb_map_items aa' ab' ac')
_ -> from_sml_ShATermError "SYMB_MAP_ITEMS" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SYMB-MAP-ITEMS" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML SYMB_KIND where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SYMB_KIND\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SYMB_KIND\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SYMB_KIND\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "implicitk" [ ] _) ->
Implicit
(ShAAppl "sortsk" [ ] _) ->
Sorts_kind
(ShAAppl "opsk" [ ] _) ->
Ops_kind
(ShAAppl "predsk" [ ] _) ->
Preds_kind
_ -> from_sml_ShATermError "SYMB_KIND" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-SYMB-KIND" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML SYMB where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SYMB\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SYMB\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SYMB\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "symb-id" [ aa ] _) ->
let
i = from_sml_ShATerm (getATermByIndex1 aa att)
aa' = setFstPos pos_l i
in (Symb_id aa')
(ShAAppl "qual-id" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Qual_id aa' ab' ac')
_ -> from_sml_ShATermError "SYMB" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SYMB" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML TYPE where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"TYPE\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"TYPE\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"TYPE\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "op-symb-type" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (O_type aa')
(ShAAppl "pred-symb-type" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (P_type aa')
_ -> from_sml_ShATermError "TYPE" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-TYPE" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML SYMB_OR_MAP where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SYMB_OR_MAP\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SYMB_OR_MAP\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SYMB_OR_MAP\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "symb" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Symb aa')
(ShAAppl "symb-or-map" [ aa ] _) ->
let
(aa',ab') = from_sml_ATermSYMB_MAP (getATermByIndex1 aa att)
ac' = pos_l
in (Symb_map aa' ab' ac')
_ -> from_sml_ShATermError "SYMB_OR_MAP" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SYMB-OR-MAP" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
---- a helper for SYMB_MAP from SML -------------------------------------
from_sml_ATermSYMB_MAP :: ATermTable -> (SYMB,SYMB)
from_sml_ATermSYMB_MAP att =
case aterm of
(ShAAppl "symb-map" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in (aa',ab')
_ -> from_sml_ShATermError "(SYMB,SYMB)" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-SYMB-MAP" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
-------------------------------------------------------------------------
----- instances of AS_Structured.hs -------------------------------------
instance ATermConvertibleSML SPEC where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"SPEC\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"SPEC\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"SPEC\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "basic" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa'' = G_basic_spec CASL aa'
in group (Syntax.AS_Structured.Basic_spec aa'') group_flag
(ShAAppl "translation" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in group (Translation aa' ab') group_flag
(ShAAppl "reduction" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in group (Reduction aa' ab') group_flag
(ShAAppl "union-spec" [ aa ] _) ->
let
aa' :: [(Annoted SPEC,[Annotation])]
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in group (Union (toAnnotedList aa') ab') group_flag
(ShAAppl "extension" [ aa ] _) ->
let
aa' :: [(Annoted SPEC,[Annotation])]
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in group (Extension (toAnnotedList aa') ab') group_flag
(ShAAppl "free-spec" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa''= addLAnnoList (toAnnoList ab att) aa'
ab' = pos_l
in group (Free_spec aa'' ab') group_flag
(ShAAppl "local-spec" [ aa,ab,ac,ad ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
sp1 = addLAnnoList (toAnnoList ab att) aa'
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
sp2 = addLAnnoList (toAnnoList ad att) ac'
in group (Local_spec sp1 sp2 pos_l) group_flag
(ShAAppl "closed-spec" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa''= addLAnnoList (toAnnoList ab att) aa'
ab' = pos_l
in group (Closed_spec aa'' ab') group_flag
(ShAAppl "spec-inst" [ aa,ab ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in (Spec_inst aa' ab' [nullPos])
_ -> from_sml_ShATermError "SPEC" aterm
where
aterm = getATerm att'
group s gf = if gf then (Group s' pos_l) else s
where s' = Annoted s [] [] []
(pos_l,group_flag,att') = skipPosFlag "pos-SPEC" att
--- a helper function for [(Annoted a, [Annotation])] --------------------
toAnnotedList :: forall a . [(Annoted a,[Annotation])] -> [Annoted a]
toAnnotedList xs = map merge xs
where merge (ai,as) = ai { l_annos = (l_annos ai) ++ as}
--------------------------------------------------------------------------
instance ATermConvertibleSML RENAMING where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"RENAMING\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"RENAMING\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"RENAMING\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "renaming" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa''= if null aa' then []
else [G_symb_map $ G_symb_map_items_list CASL aa']
ab' = pos_l
in (Renaming aa'' ab')
_ -> from_sml_ShATermError "RENAMING" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-RENAMING" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML RESTRICTION where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"RESTRICTION\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"RESTRICTION\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"RESTRICTION\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "hide" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa''= if null aa' then []
else [G_symb_list $ G_symb_items_list CASL aa']
ab' = pos_l
in (Hidden aa'' ab')
(ShAAppl "reveal" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
aa''= G_symb_map_items_list CASL aa'
ab' = pos_l
in (Revealed aa'' ab')
_ -> from_sml_ShATermError "RESTRICTION" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-RESTRICTION" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
{- !!! This will be done by the instance of LIB_ITEM !!!
instance ATermConvertibleSML SPEC_DEFN where
to_sml_ATerm att0 (Spec_defn aa ab ac ad) =
let (att1,aa') = to_sml_ATerm att0 aa
(att2,ab') = to_sml_ATerm att1 ab
(att3,ac') = to_sml_ATerm att2 ac
(att4,ad') = to_sml_ATerm att3 ad
lat = [ aa',ab',ac',ad' ]
in addATermSp (AAppl "spec-defn" lat) att4
from_sml_ShATerm att =
case aterm of
(ShAAppl "spec-defn" [ aa,ab,ac,ad ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = pos_l
in (Spec_defn aa' ab' ac' ad')
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-SPEC-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-}
instance ATermConvertibleSML GENERICITY where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"GENERICITY\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"GENERICITY\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"GENERICITY\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "genericity" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Genericity aa' ab' ac')
_ -> from_sml_ShATermError "GENERICITY" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-GENERICITY" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML PARAMS where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"PARAMS\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"PARAMS\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"PARAMS\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "params" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Params aa')
_ -> from_sml_ShATermError "PARAMS" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-PARAMS" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML IMPORTED where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"IMPORTED\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"IMPORTED\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"IMPORTED\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "imports" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Imported aa')
_ -> from_sml_ShATermError "IMPORTED" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-IMPORTS" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML FIT_ARG where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"FIT_ARG\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"FIT_ARG\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"FIT_ARG\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "fit-spec" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ab''= G_symb_map_items_list CASL ab'
ac' = pos_l
in (Fit_spec aa' ab'' ac')
(ShAAppl "fit-view" [ aa,ab ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Fit_view aa' ab' ac' [])
_ -> from_sml_ShATermError "FIT_ARG" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-FIT-ARG" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
{- !!! This conversion is covered by the instance of LIB_ITEM !!!
instance ATermConvertibleSML VIEW_DEFN where
to_sml_ATerm att0 (View_defn aa ab ac ad ae) =
let (att1,aa') = to_sml_ATerm att0 aa
(att2,ab') = to_sml_ATerm att1 ab
(att3,ac') = to_sml_ATerm att2 ac
(att4,ad') = to_sml_ATerm att3 ad
(att5,ae') = to_sml_ATerm att4 ae
lat = [ aa',ab',ac',ad',ae' ]
in addATermSp (AAppl "view-defn" lat) att5
from_sml_ShATerm att =
case aterm of
(ShAAppl "view-defn" [ aa,ab,ac,ad,ae ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = from_sml_ShATerm (getATermByIndex1 ad att)
ae' = pos_l
in (View_defn aa' ab' ac' ad' ae')
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-VIEW-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-}
instance ATermConvertibleSML VIEW_TYPE where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"VIEW_TYPE\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"VIEW_TYPE\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"VIEW_TYPE\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "view-type" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (View_type aa' ab' ac')
_ -> from_sml_ShATermError "VIEW_TYPE" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-VIEW-TYPE" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-------------------------------------------------------------------------
----- instances of AS_Architecture.hs -----------------------------------
{- !!! This conversion is covered by the instance of LIB_ITEM !!!
instance ATermConvertibleSML ARCH_SPEC_DEFN where
to_sml_ATerm att0 (Arch_spec_defn aa ab ac) =
let (att1,aa') = to_sml_ATerm att0 aa
(att2,ab') = to_sml_ATerm att1 ab
(att3,ac') = to_sml_ATerm att2 ac
lat = [ aa',ab',ac' ]
in addATermSp (ShAAppl "arch-spec-defn" lat _) att3
from_sml_ShATerm att =
case aterm of
(ShAAppl "arch-spec-defn" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Arch_spec_defn aa' ab' ac')
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-ARCH-SPEC-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-}
instance ATermConvertibleSML ARCH_SPEC where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"ARCH_SPEC\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"ARCH_SPEC\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"ARCH_SPEC\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "basic-arch-spec" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ATermRESULT_UNIT (getATermByIndex1 ab att)
as = toAnnoList ac att
aa''= (addLAnnoList as $ head aa'):tail aa'
ac' = pos_l
in (Basic_arch_spec aa'' ab' ac')
(ShAAppl "named-arch-spec" [ aa ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
in (Arch_spec_name aa')
_ -> from_sml_ShATermError "ARCH_SPEC" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-ARCH-SPEC" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
--------------------------------------------------------------------------
from_sml_ATermRESULT_UNIT :: ATermTable -> (Annoted UNIT_EXPRESSION)
from_sml_ATermRESULT_UNIT att =
case aterm of
(ShAAppl "result-unit" [ aa,ab ] _) ->
let
-- aa' :: UNIT_EXPRESSION
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
as = toAnnoList ab att
in (Annoted aa' [] as [])
_ -> from_sml_ShATermError "RESULT-UNIT" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-RESULT-UNIT" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
--------------------------------------------------------------------------
instance ATermConvertibleSML UNIT_DECL_DEFN where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"UNIT_DECL_DEFN\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"UNIT_DECL_DEFN\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"UNIT_DECL_DEFN\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-decl-case" [ udl ] _) ->
let att1 = getATermByIndex1 udl att
(ps,att2) = case getATerm att1 of
(ShAAppl "pos-UNIT-DECL" [reg_i,item_i] _) ->
(posFromRegion reg_i att,
getATermByIndex1 item_i att1)
_ -> ([],att1)
aterm2 = getATerm att2
in case aterm2 of
ShAAppl "unit-decl" [aa,ab,ac] _ ->
let aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ATermUNIT_IMPORTS $
getATermByIndex1 ac att
ad' = ps
in (Unit_decl aa' ab' ac' ad')
_ -> from_sml_ShATermError "UNIT_DECL" aterm2
(ShAAppl "unit-defn-case" [ udn ] _) ->
from_sml_ATermUNIT_DEFN $ getATermByIndex1 udn att
(ShAAppl "pos-UNIT-DEFN" _ _) ->
from_sml_ATermUNIT_DEFN att
(ShAAppl "unit-defn" _ _) ->
from_sml_ATermUNIT_DEFN att
_ -> from_sml_ShATermError "UNIT-DECL-DEFN" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-UNIT-DECL-DEFN" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
---- a helper for the SML-datatype UNIT_IMPORTS ------------------------
from_sml_ATermUNIT_IMPORTS :: ATermTable -> [Annoted UNIT_TERM]
from_sml_ATermUNIT_IMPORTS att =
case aterm of
(ShAAppl "unit-imports" [ aa ] _) ->
from_sml_ShATerm $ getATermByIndex1 aa att
_ -> from_sml_ShATermError "UNIT_IMPORTS" aterm
where aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-UNIT-IMPORTS" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
-------------------------------------------------------------------------
from_sml_ATermUNIT_DEFN :: ATermTable -> UNIT_DECL_DEFN
from_sml_ATermUNIT_DEFN att =
case aterm of
ShAAppl "unit-defn" [aa,ab] _ ->
let aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = ps
in (Unit_defn aa' ab' ac')
_ -> from_sml_ShATermError "UNIT_DEFN" aterm
where aterm = getATerm att'
(ps,att') =
case getATerm att of
(ShAAppl "pos-UNIT-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-------------------------------------------------------------------------
{- !!! This conversion is covered by the instance of LIB_ITEM !!!
instance ATermConvertibleSML UNIT_SPEC_DEFN where
to_sml_ATerm att0 (Unit_spec_defn aa ab ac) =
let (att1,aa') = to_sml_ATerm att0 aa
(att2,ab') = to_sml_ATerm att1 ab
(att3,ac') = to_sml_ATerm att2 ac
lat = [ aa',ab',ac' ]
in addATermSp (ShAAppl "unit-spec-defn" lat _) att3
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-spec-defn" [ aa,ab,ac ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Unit_spec_defn aa' ab' ac')
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-UNIT-SPEC-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-}
instance ATermConvertibleSML UNIT_SPEC where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"UNIT_SPEC\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"UNIT_SPEC\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"UNIT_SPEC\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-type-case" [ aa ] _) ->
let
(aa',ab') = from_sml_ATermUNIT_TYPE $ getATermByIndex1 aa att
ac' = pos_l
in (Unit_type aa' ab' ac')
(ShAAppl "spec-name-case" [ aa ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
in (Spec_name aa')
(ShAAppl "arch-spec-case" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ps = toAnnoList ab att
aa'' = addLAnnoList ps aa'
ab' = pos_l
aa''' = case aa'' of
(Annoted (Basic_arch_spec _ _ _) _ _ _) ->
Annoted (Group_arch_spec aa'' ab') [] [][]
_ -> aa''
in (Arch_unit_spec aa''' ab')
(ShAAppl "closed" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Closed_unit_spec aa' ab')
_ -> from_sml_ShATermError "UNIT_SPEC" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-UNIT-SPEC" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
---- a helper for the SML-datatype UNIT_TYPE ----------------------------
from_sml_ATermUNIT_TYPE :: ATermTable -> ([Annoted SPEC],(Annoted SPEC))
from_sml_ATermUNIT_TYPE att =
case aterm of
(ShAAppl "unit-type" [ aa,ab ] _) ->
(from_sml_ShATerm $ getATermByIndex1 aa att,
from_sml_ShATerm $ getATermByIndex1 ab att)
_ -> from_sml_ShATermError "UNIT_TYPE" aterm
where aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-UNIT-TYPE" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
-------------------------------------------------------------------------
instance ATermConvertibleSML UNIT_EXPRESSION where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"UNIT_EXPRESSION\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"UNIT_EXPRESSION\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"UNIT_EXPRESSION\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-expression" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Unit_expression aa' ab' ac')
_ -> from_sml_ShATermError "UNIT_EXPRESSION" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-UNIT-EXPRESSION" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML UNIT_BINDING where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"UNIT_BINDING\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"UNIT_BINDING\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"UNIT_BINDING\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-binding" [ aa,ab ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Unit_binding aa' ab' ac')
_ -> from_sml_ShATermError "UNIT_BINDING" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-UNIT-BINDING" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML UNIT_TERM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"UNIT_TERM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"UNIT_TERM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"UNIT_TERM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "unit-reduction" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in group (Unit_reduction aa' ab') group_flag
(ShAAppl "unit-translation" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in group (Unit_translation aa' ab') group_flag
(ShAAppl "amalgamation" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in group (Amalgamation aa' ab') group_flag
(ShAAppl "local-unit" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in group (Local_unit aa' ab' ac') group_flag
(ShAAppl "unit-appl" [ aa,ab ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in group (Unit_appl aa' ab' ac') group_flag
_ -> from_sml_ShATermError "UNIT_TERM" aterm
where
aterm = getATerm att'
group ut gf = if gf then (Group_unit_term ut' pos_l) else ut
where ut' = Annoted ut [] [] []
(pos_l,group_flag,att') = skipPosFlag "pos-UNIT-TERM" att
instance ATermConvertibleSML FIT_ARG_UNIT where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"FIT_ARG_UNIT\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"FIT_ARG_UNIT\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"FIT_ARG_UNIT\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "fit-arg-unit" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ab''= G_symb_map_items_list CASL ab'
ac' = pos_l
in (Fit_arg_unit aa' ab'' ac')
_ -> from_sml_ShATermError "FIT_ARG_UNIT" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-FIT-ARG-UNIT" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-------------------------------------------------------------------------
----- instances of AS_LIbrary.hs ----------------------------------------
instance ATermConvertibleSML LIB_DEFN where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"LIB_DEFN\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"LIB_DEFN\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"LIB_DEFN\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "lib-defn" [ aa,ab,ad ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
ad' = from_sml_ShATerm (getATermByIndex1 ad att)
in (Lib_defn aa' ab' ac' ad')
_ -> from_sml_ShATermError "LIB_DEFN" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-LIB-DEFN" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML LIB_ITEM where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"LIB_ITEM\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"LIB_ITEM\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"LIB_ITEM\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "spec-defn" [ aa,ab,ac,ad ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
as = toAnnoList ad att
ac''= addLAnnoList as ac'
ad' = pos_l
in Syntax.AS_Library.Spec_defn aa' ab' ac'' ad'
(ShAAppl "view-defn" [ aa,ab,ac,ad,_ ] _) ->
let -- the annotation list is lost !!!!
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = from_sml_ShATerm (getATermByIndex1 ac att)
ad' = from_sml_ShATerm (getATermByIndex1 ad att)
ad''= if null ad' then []
else [G_symb_map $ G_symb_map_items_list CASL ad']
{- as = toAnnoList ae att
ac''= addLAnnoList as ac'-}
ae' = pos_l
in (Syntax.AS_Library.View_defn aa' ab' ac' ad'' ae')
(ShAAppl "arch-spec-defn" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Syntax.AS_Library.Arch_spec_defn aa' ab' ac')
(ShAAppl "unit-spec-defn" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Syntax.AS_Library.Unit_spec_defn aa' ab' ac')
(ShAAppl "download-items" [ aa,ab,_ ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
ac' = pos_l
in (Syntax.AS_Library.Download_items aa' ab' ac')
_ -> from_sml_ShATermError "LIB_ITEM" aterm
where
aterm = getATerm att'
(pos_l,att') = skipPos "pos-LIB-ITEM" att
---- helpers to skip nested "pos-"-constructors -----------------------
skipPos :: String -> ATermTable -> ([Pos],ATermTable)
skipPos mcon at =
case getATerm at of
ShAAppl con [reg_i,item_i] _ | mcon == con ->
if pCon then skipPos mcon at'
else (posFromRegion (reg_i) at, at')
where pCon = case getATerm at' of
ShAAppl con' _ _ | mcon == con' -> True
_ -> False
at' = getATermByIndex1 item_i at
_ -> ([],at)
skipPosFlag :: String -> ATermTable -> ([Pos],Bool,ATermTable)
skipPosFlag mcon att =
case getATerm att of
ShAAppl con [reg_i,b_i,item_i] _ | mcon == con ->
if pCon then let (_r_pos_l,r_b,r_at') = skipPosFlag mcon at'
in (pos_l,r_b || b,r_at')
else (pos_l,b,at')
where pCon = case getATerm at' of
ShAAppl con' _ _ | mcon == con' -> True
_ -> False
at' = getATermByIndex1 item_i att
pos_l = posFromRegion reg_i att
b = from_sml_ShATerm $ getATermByIndex1 b_i att
_ -> ([],False,att)
-----------------------------------------------------------------------
instance ATermConvertibleSML ITEM_NAME_OR_MAP where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"ITEM_NAME_OR_MAP\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"ITEM_NAME_OR_MAP\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"ITEM_NAME_OR_MAP\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "item-name" [ aa ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
in (Item_name aa')
(ShAAppl "item-name-map" [ aa,ab ] _) ->
let
aa' = from_sml_ATermSIMPLE_ID (getATermByIndex1 aa att)
ab' = from_sml_ATermSIMPLE_ID (getATermByIndex1 ab att)
ac' = pos_l
in (Item_name_map aa' ab' ac')
_ -> from_sml_ShATermError "ITEM_NAME_OR_MAP" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-ITEM-NAME-OR-MAP" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML LIB_NAME where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"LIB_NAME\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"LIB_NAME\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"LIB_NAME\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "versioned-lib" [ aa,ab ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = from_sml_ShATerm (getATermByIndex1 ab att)
in (Lib_version aa' ab')
(ShAAppl "lib" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
in (Lib_id aa')
_ -> from_sml_ShATermError "LIB_NAME" aterm
where
aterm = getATerm att'
att' =
case getATerm att of
(ShAAppl "pos-LIB-NAME" [_,item_i] _) ->
getATermByIndex1 item_i att
_ -> att
instance ATermConvertibleSML LIB_ID where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"LIB_ID\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"LIB_ID\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"LIB_ID\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "url" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Direct_link aa' ab')
(ShAAppl "path-name" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Indirect_link aa' ab')
_ -> from_sml_ShATermError "LIB_NAME" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-LIB-ID" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
instance ATermConvertibleSML VERSION_NUMBER where
to_sml_ATerm _ = error "*** to_sml_ATerm for \"VERSION_NUMBER\" not implemented"
from_sml_ATerm _ = error "*** from_sml_ATerm for \"VERSION_NUMBER\" not implemented"
to_sml_ShATerm _ _ = error "*** to_sml_ShATerm for \"VERSION_NUMBER\" not implemented"
from_sml_ShATerm att =
case aterm of
(ShAAppl "version" [ aa ] _) ->
let
aa' = from_sml_ShATerm (getATermByIndex1 aa att)
ab' = pos_l
in (Version_number aa' ab')
_ -> from_sml_ShATermError "VERSION_NUMBER" aterm
where
aterm = getATerm att'
(pos_l,att') =
case getATerm att of
(ShAAppl "pos-VERSION" [reg_i,item_i] _) ->
(posFromRegion reg_i att,getATermByIndex1 item_i att)
_ -> ([],att)
-------------------------------------------------------------------------
-- some helpers for Annoted things --------------------------------------
addLAnnoList :: forall a . [Annotation] -> Annoted a -> Annoted a
addLAnnoList as ani = ani {l_annos = as ++ (l_annos ani) }
addRAnnoList :: forall a . [Annotation] -> Annoted a -> Annoted a
addRAnnoList as ani = ani {r_annos = (r_annos ani) ++ as }
--- some helpers for Regions and Positions ------------------------------
posFromRegion :: Int -> ATermTable -> [Pos]
posFromRegion reg at = map ( \ (l, c) -> newPos "" l c )
$ from_sml_ATerm_reg reg at
getPos :: ATermTable -> [Pos]
getPos att = case getATerm att of
ShAAppl _ (x:_) _ -> posFromRegion x att
_ -> []
-- converts an aterm region information to [Pos]
from_sml_ATerm_reg :: Int -> ATermTable -> [(Int,Int)]
from_sml_ATerm_reg reg_i at = [fst r,snd r]
where r :: ((Int,Int),(Int,Int)) -- Id.hs Region
r = from_sml_ShATerm r_at
r_at = getATermByIndex1 reg_i at
insertIM, insertPos :: [a] -> [a] -> [a]
insertIM ips ops | even $ length ops = let hl = (length ops) `div` 2
(fp,lp) = splitAt hl ops
in fp ++ ips ++ lp
| otherwise = error
"wrong call: length of snd list must be even"
insertPos = insertIM
setFstPos :: [Pos] -> Id -> Id
setFstPos (p:_) i = case i of
Id tops ids pos_l ->
Id (setFstPos' tops) ids pos_l
where setFstPos' tops | null tops = []
| otherwise = (ftop):(tail tops)
where ftop = (head tops) { tokPos = p }
setFstPos _ _ = error "wrong call: setFstPos"
-------------------------------------------------------------------------