AsUtils.hs revision 51281dddda866c0cda9fca22bf6bc4eea7128112
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder{- HetCATS/HasCASL/AsUtils.hs
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian Maeder $Id$
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian Maeder Authors: Christian Maeder
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder Year: 2003
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder (further) auxiliary functions
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder-}
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maeder
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maedermodule AsUtils where
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maederimport As
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport Id
23f2c59644866aa82e90de353e77f9f1d1b51b9aChristian Maeder
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian MaederposOf :: PosItem a => [a] -> Pos
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederposOf l = if null l then nullPos else
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder case get_pos $ head l of
fc8c6570c7b4ee13f375eb607bed2290438573bfChristian Maeder Nothing -> case get_pos_l $ head l of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Nothing -> posOf $ tail l
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder Just ps -> if null ps then posOf $ tail l else head ps
fcb1d8a27670f3206bd4ca28d77d4172619db602Christian Maeder Just p -> p
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder
dc6b48bb46df8e56da3491c98476e6da0d1d5d1dChristian MaederfirstPos :: PosItem a => [a] -> [Pos] -> Pos
fc8c6570c7b4ee13f375eb607bed2290438573bfChristian MaederfirstPos l ps = if null ps then posOf l else head ps
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maeder
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maederinstance PosItem Kind where
10397bcc134edbcfbe3ae2c7ea4c6080036aae22Christian Maeder get_pos = Just . posOfKind
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian MaederposOfKind :: Kind -> Pos
af621d0066770895fd79562728e93099c8c52060Christian MaederposOfKind k =
7c554e9d4a39b8eb3b0881f20807c95dd8e793aeChristian Maeder case k of
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maeder KindAppl k1 k2 ps -> firstPos [k1,k2] ps
79d11c2e3ad242ebb241f5d4a5e98a674c0b986fChristian Maeder ProdClass cs ps -> firstPos cs ps
4fb19f237193a3bd6778f8aee3b6dd8da5856665Christian Maeder ExtClass c _ ps -> firstPos [c] ps
f8f78a2c8796a387a4348cc672ae08e8d9f69315Christian Maeder PlainClass c -> posOfClass c
024621f43239cfe9629e35d35a8669fad7acbba2Christian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinstance PosItem Class where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder get_pos = Just . posOfClass
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfClass :: Class -> Pos
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfClass c =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder case c of
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder Downset t -> posOfType t
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Intersection is ps -> firstPos is ps
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder-- ---------------------------------------------------------------------
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederinstance PosItem TypePattern where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder get_pos = Just . posOfTypePattern
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinstance PosItem TypeArg where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder get_pos (TypeArg t _ _ _) = Just $ posOfId t
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfTypePattern :: TypePattern -> Pos
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfTypePattern pat =
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder case pat of
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder TypePattern t _ _ -> posOfId t
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder TypePatternToken t -> tokPos t
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder MixfixTypePattern ts -> posOf ts
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder BracketTypePattern _ ts ps -> firstPos ts ps
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder TypePatternArgs as -> posOf as
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder-- ---------------------------------------------------------------------
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederinstance PosItem TypeArgs where
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder get_pos (TypeArgs tArgs ps) = Just $ firstPos tArgs ps
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinstance PosItem TypeScheme where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder get_pos (TypeScheme tArgs _ ps) = Just $ firstPos tArgs ps
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinstance PosItem Type where
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder get_pos = Just . posOfType
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maeder
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfType :: Type -> Pos
afa6848d579d235c9677e1ab477916df8e5ae11aChristian MaederposOfType ty =
e8a2ca3a7b3e9a19ef03b6b1c0b5d03dbad6463cChristian Maeder case ty of
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder TypeName i _ -> posOfId i
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder TypeAppl t1 t2 -> posOf [t1, t2]
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder TypeToken t -> tokPos t
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder BracketType _ ts ps -> firstPos ts ps
e76e6a43f51438215737d6fc176c89da05bb86daChristian Maeder KindedType t _ ps -> firstPos [t] ps
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder MixfixType ts -> posOf ts
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder LazyType t ps -> firstPos [t] ps
986e0e9cf8c2358f455460b3fc75ce7c5dcf0973Christian Maeder ProductType ts ps -> firstPos ts ps
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder FunType t1 _ t2 ps -> firstPos [t1,t2] ps
6a7e00a968cb0f3f9ccae19ab47ef3636c7e79bfChristian Maeder
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder-- ---------------------------------------------------------------------
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder