BaseATC.hs revision 06a671f19b2f76097ca4997268954721a831c527
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaederModule : $Header$
06a671f19b2f76097ca4997268954721a831c527Christian MaederDescription : basic ShATermConvertible instances
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian MaederCopyright : (c) Christian Maeder, Uni Bremen 2005-2006
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaederStability : provisional
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian MaederPortability : portable
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maedera few basic 'ShATermConvertible' instances needed by "Haskell.ATC_Haskell"
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder_tc_SrcLocTc :: TyCon
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder_tc_SrcLocTc = mkTyCon "SrcLoc"
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maederinstance Typeable SrcLoc where
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder typeOf _ = mkTyConApp _tc_SrcLocTc []
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maederinstance (ShATermConvertible a, ShATermConvertible b)
4193a06761942e1865d40e06598acea3ebf05515Christian Maeder => ShATermConvertible (Either a b) where
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder toShATermAux att0 (Left aa) = do
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att1,aa') <- toShATerm' att0 aa
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder return $ addATerm (ShAAppl "Left" [ aa' ] []) att1
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder toShATermAux att0 (Right aa) = do
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att1,aa') <- toShATerm' att0 aa
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder return $ addATerm (ShAAppl "Right" [ aa' ] []) att1
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder fromShATermAux ix att =
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case getShATerm ix att of
4193a06761942e1865d40e06598acea3ebf05515Christian Maeder ShAAppl "Left" [ aa ] _ ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' aa att of { (att2, aa') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder (att2, Left aa') }
4193a06761942e1865d40e06598acea3ebf05515Christian Maeder ShAAppl "Right" [ aa ] _ ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' aa att of { (att2, aa') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder (att2, Right aa') }
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder u -> fromShATermError "Either" u
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maederinstance ShATermConvertible SrcLoc where
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder toShATermAux att0 (SrcLoc aa ab ac ad) = do
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att1,aa') <- toShATerm' att0 aa
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att2,ab') <- toShATerm' att1 ab
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att3,ac') <- toShATerm' att2 ac
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder (att4,ad') <- toShATerm' att3 ad
62ec122da8d4fdfa66cc059b97dabbf10c81affeChristian Maeder return $ addATerm (ShAAppl "SrcLoc" [ aa',ab',ac',ad' ] []) att4
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder fromShATermAux ix att0 =
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case getShATerm ix att0 of
4193a06761942e1865d40e06598acea3ebf05515Christian Maeder ShAAppl "SrcLoc" [ aa,ab,ac,ad ] _ ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' aa att0 of { (att1, aa') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' ab att1 of { (att2, ab') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' ac att2 of { (att3, ac') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder case fromShATerm' ad att3 of { (att4, ad') ->
383aa66e5142365fe9b1f88b18c1da5b27cc8c04Christian Maeder (att4, SrcLoc aa' ab' ac' ad') }}}}
d23b0cc79c0d204e6ec758dff8d0ba71c9f693f7Christian Maeder u -> fromShATermError "SrcLoc" u