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:
parent
5a7f68a44f
commit
6814ac2679
|
@ -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
|
||||||
|
|
|
@ -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" [] []
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
++ "\""
|
++ "\""
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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"]
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user