Added a joinWith helper (short for concat . intersperse) and changed most of the uses in the code to use the helper function

This commit is contained in:
Neil Brown 2009-04-08 16:28:23 +00:00
parent 5a7f68a44f
commit 6814ac2679
7 changed files with 17 additions and 11 deletions

View File

@ -232,7 +232,7 @@ formatProblem varToIndex (eq, ineq)
++ " " ++ op ++ " " ++ show (negate $ item ! 0) ++ " " ++ op ++ " " ++ show (negate $ item ! 0)
showEq :: Array CoeffIndex Integer -> m String showEq :: Array CoeffIndex Integer -> m String
showEq = liftM (concat . intersperse " + ") . mapM showItem . filter ((/= 0) . snd) . tail . assocs showEq = liftM (joinWith " + ") . mapM showItem . filter ((/= 0) . snd) . tail . assocs
showItem :: (CoeffIndex, Integer) -> m String showItem :: (CoeffIndex, Integer) -> m String
showItem (n, a) = case find ((== n) . snd) $ Map.assocs varToIndex of showItem (n, a) = case find ((== n) . snd) $ Map.assocs varToIndex of
@ -255,7 +255,7 @@ solve (ls,vm,(eq,ineq)) = case solveProblem eq ineq of
formatSolution :: (CSMR m, Monad m) => VarMap -> VariableMapping -> m String formatSolution :: (CSMR m, Monad m) => VarMap -> VariableMapping -> m String
formatSolution varToIndex vm formatSolution varToIndex vm
= do names <- mapM valOfVar $ Map.assocs varToIndex = do names <- mapM valOfVar $ Map.assocs varToIndex
return $ concat $ intersperse " , " $ catMaybes names return $ joinWith " , " $ catMaybes names
where where
indexToVar = flip lookup $ map revPair $ Map.assocs varToIndex indexToVar = flip lookup $ map revPair $ Map.assocs varToIndex
@ -275,7 +275,7 @@ formatSolution varToIndex vm
-1 -> "-" -1 -> "-"
n -> show n ++ "*" n -> show n ++ "*"
showWithCoeff xs = liftM (concat . intersperse " + ") $ mapM showWithCoeff' xs showWithCoeff xs = liftM (joinWith " + ") $ mapM showWithCoeff' xs
valOfVar (varExp,k) = case Map.lookup k indexToConst of valOfVar (varExp,k) = case Map.lookup k indexToConst of
Nothing -> return Nothing Nothing -> return Nothing
@ -290,7 +290,7 @@ formatSolution varToIndex vm
formatBounds _ [] = "" formatBounds _ [] = ""
formatBounds f [b] = f b formatBounds f [b] = f b
formatBounds f bs = f $ "(" ++ concat (intersperse "," bs) ++ ")" formatBounds f bs = f $ "(" ++ joinWith "," bs ++ ")"
showFlattenedExpSet :: Monad m => (A.Expression -> m String) -> Set.Set FlattenedExp -> m String showFlattenedExpSet :: Monad m => (A.Expression -> m String) -> Set.Set FlattenedExp -> m String
showFlattenedExpSet showExp s = liftM concat $ sequence $ intersperse (return " + ") $ map (showFlattenedExp showExp) $ Set.toList s showFlattenedExpSet showExp s = liftM concat $ sequence $ intersperse (return " + ") $ map (showFlattenedExp showExp) $ Set.toList s

View File

@ -446,7 +446,7 @@ showCodeExSet :: (CSMR m, Ord a, ShowOccam a, ShowRain a) => ExSet a -> m String
showCodeExSet Everything = return "<all-vars>" showCodeExSet Everything = return "<all-vars>"
showCodeExSet (NormalSet s) showCodeExSet (NormalSet s)
= do ss <- mapM showCode (Set.toList s) = do ss <- mapM showCode (Set.toList s)
return $ "{" ++ concat (intersperse ", " ss) ++ "}" return $ "{" ++ joinWith ", " ss ++ "}"
checkInitVarPass :: Pass checkInitVarPass :: Pass
checkInitVarPass = pass "checkInitVar" [] [] checkInitVarPass = pass "checkInitVar" [] []

View File

@ -328,7 +328,7 @@ showMaybe showFunc (Just x) = "Just " ++ showFunc x
showMaybe _ Nothing = "Nothing" showMaybe _ Nothing = "Nothing"
showListCustom :: (a -> String) -> [a] -> String showListCustom :: (a -> String) -> [a] -> String
showListCustom showFunc list = "[" ++ concat (intersperse "," (map showFunc list)) ++ "]" showListCustom showFunc list = "[" ++ joinWith "," (map showFunc list) ++ "]"
showPairCustom :: (a -> String) -> (b -> String) -> (a,b) -> String showPairCustom :: (a -> String) -> (b -> String) -> (a,b) -> String
showPairCustom showA showB (a,b) = "(" ++ showA a ++ "," ++ showB b ++ ")" showPairCustom showA showB (a,b) = "(" ++ showA a ++ "," ++ showB b ++ ")"
@ -398,3 +398,9 @@ liftWrapStateT wrap m
foldM1 :: Monad m => (a -> a -> m a) -> [a] -> m a foldM1 :: Monad m => (a -> a -> m a) -> [a] -> m a
foldM1 f (x:xs) = foldM f x xs foldM1 f (x:xs) = foldM f x xs
foldM1 _ [] = fail "Empty list in foldM1" foldM1 _ [] = fail "Empty list in foldM1"
-- | A shortcut for concat and intersperse.
-- For example, @joinWith " " names@ is the same as @concat (intersperse " "
-- names)@
joinWith :: [a] -> [[a]] -> [a]
joinWith x = concat . intersperse x

View File

@ -2004,7 +2004,7 @@ defaultDecl = concat
[Token emptyMeta $ Pragma $ "TOCKEXTERNAL \"" [Token emptyMeta $ Pragma $ "TOCKEXTERNAL \""
++ showOccam rt ++ showOccam rt
++ " FUNCTION \"" ++ concatMap doubleStar op ++ "\"(" ++ " FUNCTION \"" ++ concatMap doubleStar op ++ "\"("
++ concat (intersperse "," params) ++ joinWith "," params
++ ") = " ++ ") = "
++ occamDefaultOperator op ts ++ occamDefaultOperator op ts
++ "\"" ++ "\""

View File

@ -74,7 +74,7 @@ instancesFrom w
-- left to apply. -- left to apply.
baseInst :: [String] baseInst :: [String]
baseInst baseInst
= [ "instance (" ++ concat (intersperse ", " context) ++ ") =>" = [ "instance (" ++ joinWith ", " context ++ ") =>"
, " Polyplate m () o0 (" ++ wName ++ ") where" , " Polyplate m () o0 (" ++ wName ++ ") where"
] ++ ] ++
(if isAlgType wDType (if isAlgType wDType
@ -116,7 +116,7 @@ instancesFrom w
ctrName = modPrefix ++ ctrS ctrName = modPrefix ++ ctrS
makeCtr vs makeCtr vs
= if isTuple = if isTuple
then "(" ++ (concat $ intersperse ", " vs) ++ ")" then "(" ++ joinWith ", " vs ++ ")"
else ctrName ++ concatMap (" " ++) vs else ctrName ++ concatMap (" " ++) vs
ctrInput = makeCtr ["a" ++ show i | i <- argNums] ctrInput = makeCtr ["a" ++ show i | i <- argNums]
ctrResult = makeCtr ["r" ++ show i | i <- argNums] ctrResult = makeCtr ["r" ++ show i | i <- argNums]

View File

@ -58,7 +58,7 @@ ordFor' typeName x = process $ map processConstr $ dataTypeConstrs $ dataTypeOf
++ concat [ [ " compare (" ++ name ++ headL ++ ") (" ++ name ++ headR ++ ") = " ++ ++ concat [ [ " compare (" ++ name ++ headL ++ ") (" ++ name ++ headR ++ ") = " ++
--Shortcut: --Shortcut:
if null comparisons then "EQ" else if null comparisons then "EQ" else
"combineCompare [" ++ concat (intersperse "," comparisons) ++ "]" "combineCompare [" ++ joinWith "," comparisons) ++ "]"
] ++ if isLast then [] else ] ++ if isLast then [] else
[ " compare (" ++ name ++ " {}) _ = LT" [ " compare (" ++ name ++ " {}) _ = LT"
, " compare _ (" ++ name ++ " {}) = GT"] , " compare _ (" ++ name ++ " {}) = GT"]

View File

@ -80,7 +80,7 @@ genItem' suffix typeName (num, name, paramTypes)
where where
typeSuffix = "" typeSuffix = ""
params = concat $ intersperse " -> " $ paramTypes ++ [typeName] params = joinWith " -> " $ paramTypes ++ [typeName]
n = show num n = show num
mname = "m" ++ name ++ suffix mname = "m" ++ name ++ suffix