AsUtils.hs revision 30b01cb7094463449238dee8c1542544a242fcc0
c58a94c44b76b072ace930f2126c889c0b64cb2aChristian Maeder Authors: Christian Maeder
3f69b6948966979163bdfe8331c38833d5d90ecdChristian Maeder (further) auxiliary functions
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maedermodule AsUtils where
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian Maederimport FiniteMap
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maederimport List(intersperse)
ad270004874ce1d0697fb30d7309f180553bb315Christian Maederimport MonadState
dc6b48bb46df8e56da3491c98476e6da0d1d5d1dChristian Maeder-- ---------------------------------------------------------------------
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maederinstance Show a => Show (Set a) where
b603f34b79bc0992e5d74f484e5bdc9f9c2346c6Christian Maeder showsPrec _ s = showString "{"
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder . showSepList (showString ",") shows (setToList s)
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder . showString "}"
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian MaederanaList :: Monad m => (a -> m (Result b)) -> [a] -> m (Result [b])
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder do rs <- mapM f l
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder let ms = map maybeResult rs
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder ds = concatMap diags rs
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder failErr = Diag FatalError "an element failed" $
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder if null ds then nullPos else diagPos $ head ds
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder if all isJust ms then Result ds (Just $ map fromJust ms)
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder (if any (FatalError == ) (map diagKind ds) then ds
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder else failErr : ds)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder-- ---------------------------------------------------------------------
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederkindArity :: Kind -> Int
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaederkindArity(Kind args _ _) =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder sum $ map prodClassArity args
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian MaederprodClassArity :: ProdClass -> Int
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaederprodClassArity (ProdClass l _) = length l
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder-- ---------------------------------------------------------------------
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaederposOfTypePattern :: TypePattern -> Pos
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian MaederposOfTypePattern (TypePattern t _ _) = posOfId t
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaederposOfTypePattern (TypePatternToken t) = tokPos t
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian MaederposOfTypePattern (MixfixTypePattern ts) =
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder if null ts then nullPos else posOfTypePattern $ head ts
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaederposOfTypePattern (BracketTypePattern _ ts ps) =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder if null ps then
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder if null ts then nullPos
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder else posOfTypePattern $ head ts
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaederposOfTypePattern (TypePatternArgs as) =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder if null as then nullPos else
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder let TypeArg t _ _ _ = head as in tokPos t
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder-- ---------------------------------------------------------------------
27912d626bf179b82fcb337077e5cd9653bb71cfChristian MaedershowClassList :: [ClassName] -> ShowS
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedershowClassList is = showParen (length is > 1)
cf3232cec840a6945667bdb06f5b47b22243bc8fChristian Maeder $ showSepList ("," ++) ((++) . tokStr) is
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder----------------------------------------------------------------------------
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder-- FiniteMap stuff
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder-----------------------------------------------------------------------------
5ba323da9f037264b4a356085e844889aedeac23Christian MaederlookUp :: (Ord a, MonadPlus m) => FiniteMap a (m b) -> a -> (m b)
5ba323da9f037264b4a356085e844889aedeac23Christian MaederlookUp ce = lookupWithDefaultFM ce mzero
ad187062b0009820118c1b773a232e29b879a2faChristian MaedershowMap :: Ord a => (a -> ShowS) -> (b -> ShowS) -> FiniteMap a b -> ShowS
ad187062b0009820118c1b773a232e29b879a2faChristian MaedershowMap showA showB m =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder showSepList (showChar '\n') (\ (a, b) -> showA a . showString " -> " .
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder indent 2 (showB b))
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder-----------------------------------------------------------------------------
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maederindent :: Int -> ShowS -> ShowS
1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maederindent i s = showString $ concat $
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder intersperse ('\n' : replicate i ' ') (lines $ s "")