Replace tabs for whitespace in source code

This commit is contained in:
John J. Camilleri
2021-07-07 09:40:41 +02:00
parent a2b23d5897
commit f2e52d6f2c
32 changed files with 799 additions and 803 deletions

View File

@@ -16,18 +16,18 @@
{-# LANGUAGE CPP #-}
module GF.Data.BacktrackM (
-- * the backtracking state monad
BacktrackM,
-- * monad specific utilities
member,
cut,
-- * running the monad
foldBM, runBM,
foldSolutions, solutions,
foldFinalStates, finalStates,
-- * reexport the 'MonadState' class
module Control.Monad.State.Class,
) where
BacktrackM,
-- * monad specific utilities
member,
cut,
-- * running the monad
foldBM, runBM,
foldSolutions, solutions,
foldFinalStates, finalStates,
-- * reexport the 'MonadState' class
module Control.Monad.State.Class,
) where
import Data.List
import Control.Applicative
@@ -70,7 +70,7 @@ instance Applicative (BacktrackM s) where
instance Monad (BacktrackM s) where
return a = BM (\c s b -> c a s b)
BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
where unBM (BM m) = m
where unBM (BM m) = m
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail

View File

@@ -5,7 +5,7 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.2 $
--
@@ -34,7 +34,7 @@ import Data.Set (Set)
import qualified Data.Set as Set
data Graph n a b = Graph [n] ![Node n a] ![Edge n b]
deriving (Eq,Show)
deriving (Eq,Show)
type Node n a = (n,a)
type Edge n b = (n,n,b)
@@ -63,7 +63,7 @@ emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es]
-- | Add a node to the graph.
newNode :: a -- ^ Node label
-> Graph n a b
-> Graph n a b
-> (Graph n a b,n) -- ^ Node graph and name of new node
newNode l (Graph (c:cs) ns es) = (Graph cs ((c,l):ns) es, c)
@@ -83,7 +83,7 @@ newEdges es g = foldl' (flip newEdge) g es
-- lazy version:
-- newEdges es' (Graph c ns es) = Graph c ns (es'++es)
insertEdgeWith :: Eq n =>
insertEdgeWith :: Eq n =>
(b -> b -> b) -> Edge n b -> Graph n a b -> Graph n a b
insertEdgeWith f e@(x,y,l) (Graph c ns es) = Graph c ns (h es)
where h [] = [e]
@@ -97,7 +97,7 @@ removeNode n = removeNodes (Set.singleton n)
-- | Remove a set of nodes and all edges to and from those nodes.
removeNodes :: Ord n => Set n -> Graph n a b -> Graph n a b
removeNodes xs (Graph c ns es) = Graph c ns' es'
where
where
keepNode n = not (Set.member n xs)
ns' = [ x | x@(n,_) <- ns, keepNode n ]
es' = [ e | e@(f,t,_) <- es, keepNode f && keepNode t ]
@@ -105,7 +105,7 @@ removeNodes xs (Graph c ns es) = Graph c ns' es'
-- | Get a map of node names to info about each node.
nodeInfo :: Ord n => Graph n a b -> NodeInfo n a b
nodeInfo g = Map.fromList [ (n, (x, fn inc n, fn out n)) | (n,x) <- nodes g ]
where
where
inc = groupEdgesBy edgeTo g
out = groupEdgesBy edgeFrom g
fn m n = fromMaybe [] (Map.lookup n m)
@@ -148,16 +148,16 @@ reverseGraph :: Graph n a b -> Graph n a b
reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]
-- | Add the nodes from the second graph to the first graph.
-- The nodes in the second graph will be renamed using the name
-- The nodes in the second graph will be renamed using the name
-- supply in the first graph.
-- This function is more efficient when the second graph
-- is smaller than the first.
mergeGraphs :: Ord m => Graph n a b -> Graph m a b
mergeGraphs :: Ord m => Graph n a b -> Graph m a b
-> (Graph n a b, m -> n) -- ^ The new graph and a function translating
-- the old names of nodes in the second graph
-- to names in the new graph.
mergeGraphs (Graph c ns1 es1) g2 = (Graph c' (ns2++ns1) (es2++es1), newName)
where
where
(xs,c') = splitAt (length (nodes g2)) c
newNames = Map.fromList (zip (map fst (nodes g2)) xs)
newName n = fromJust $ Map.lookup n newNames
@@ -170,7 +170,7 @@ renameNodes :: (n -> m) -- ^ renaming function
-> Graph n a b -> Graph m a b
renameNodes newName c (Graph _ ns es) = Graph c ns' es'
where ns' = map' (\ (n,x) -> (newName n,x)) ns
es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
es' = map' (\ (f,t,l) -> (newName f, newName t, l)) es
-- | A strict 'map'
map' :: (a -> b) -> [a] -> [b]

View File

@@ -5,7 +5,7 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/15 18:10:44 $
-- > CVS $Date: 2005/09/15 18:10:44 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.2 $
--
@@ -13,14 +13,14 @@
-----------------------------------------------------------------------------
module GF.Data.Graphviz (
Graph(..), GraphType(..),
Node(..), Edge(..),
Attr,
addSubGraphs,
setName,
setAttr,
prGraphviz
) where
Graph(..), GraphType(..),
Node(..), Edge(..),
Attr,
addSubGraphs,
setName,
setAttr,
prGraphviz
) where
import Data.Char
@@ -70,14 +70,14 @@ prGraphviz g@(Graph t i _ _ _ _) =
graphtype t ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}\n"
prSubGraph :: Graph -> String
prSubGraph g@(Graph _ i _ _ _ _) =
prSubGraph g@(Graph _ i _ _ _ _) =
"subgraph" ++ " " ++ maybe "" esc i ++ " {\n" ++ prGraph g ++ "}"
prGraph :: Graph -> String
prGraph (Graph t id at ns es ss) =
prGraph (Graph t id at ns es ss) =
unlines $ map (++";") (map prAttr at
++ map prNode ns
++ map (prEdge t) es
++ map prNode ns
++ map (prEdge t) es
++ map prSubGraph ss)
graphtype :: GraphType -> String
@@ -96,7 +96,7 @@ edgeop Undirected = "--"
prAttrList :: [Attr] -> String
prAttrList [] = ""
prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"
prAttrList at = "[" ++ join "," (map prAttr at) ++ "]"
prAttr :: Attr -> String
prAttr (n,v) = esc n ++ " = " ++ esc v

View File

@@ -5,7 +5,7 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/11/11 16:12:41 $
-- > CVS $Date: 2005/11/11 16:12:41 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.22 $
--
@@ -15,34 +15,34 @@
-----------------------------------------------------------------------------
module GF.Data.Operations (
-- ** The Error monad
Err(..), err, maybeErr, testErr, fromErr, errIn,
lookupErr,
-- ** The Error monad
Err(..), err, maybeErr, testErr, fromErr, errIn,
lookupErr,
-- ** Error monad class
ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
liftErr,
-- ** Checking
checkUnique, unifyMaybeBy, unifyMaybe,
-- ** Error monad class
ErrorMonad(..), checks, --doUntil, allChecks, checkAgain,
liftErr,
-- ** Monadic operations on lists and pairs
mapPairsM, pairM,
-- ** Printing
indent, (+++), (++-), (++++), (+++-), (+++++),
prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
numberedParagraphs, prConjList, prIfEmpty, wrapLines,
-- ** Checking
checkUnique, unifyMaybeBy, unifyMaybe,
-- ** Topological sorting
topoTest, topoTest2,
-- ** Monadic operations on lists and pairs
mapPairsM, pairM,
-- ** Misc
readIntArg,
iterFix, chunks,
) where
-- ** Printing
indent, (+++), (++-), (++++), (+++-), (+++++),
prUpper, prReplicate, prTList, prQuotedString, prParenth, prCurly,
prBracket, prArgList, prSemicList, prCurlyList, restoreEscapes,
numberedParagraphs, prConjList, prIfEmpty, wrapLines,
-- ** Topological sorting
topoTest, topoTest2,
-- ** Misc
readIntArg,
iterFix, chunks,
) where
import Data.Char (isSpace, toUpper, isSpace, isDigit)
import Data.List (nub, partition, (\\))
@@ -107,7 +107,7 @@ indent i s = replicate i ' ' ++ s
(+++), (++-), (++++), (+++-), (+++++) :: String -> String -> String
a +++ b = a ++ " " ++ b
a ++- "" = a
a ++- "" = a
a ++- b = a +++ b
a ++++ b = a ++ "\n" ++ b
@@ -145,20 +145,20 @@ prCurly s = "{" ++ s ++ "}"
prBracket s = "[" ++ s ++ "]"
prArgList, prSemicList, prCurlyList :: [String] -> String
prArgList = prParenth . prTList ","
prArgList = prParenth . prTList ","
prSemicList = prTList " ; "
prCurlyList = prCurly . prSemicList
restoreEscapes :: String -> String
restoreEscapes s =
case s of
restoreEscapes s =
case s of
[] -> []
'"' : t -> '\\' : '"' : restoreEscapes t
'\\': t -> '\\' : '\\' : restoreEscapes t
c : t -> c : restoreEscapes t
numberedParagraphs :: [[String]] -> [String]
numberedParagraphs t = case t of
numberedParagraphs t = case t of
[] -> []
p:[] -> p
_ -> concat [(show n ++ ".") : s | (n,s) <- zip [1..] t]
@@ -204,12 +204,12 @@ topoTest2 g0 = maybe (Right cycles) Left (tsort g)
([],[]) -> Just []
([],_) -> Nothing
(ns,rest) -> (leaves:) `fmap` tsort [(n,es \\ leaves) | (n,es)<-rest]
where leaves = map fst ns
where leaves = map fst ns
-- | Fix point iterator (for computing e.g. transitive closures or reachability)
iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
iterFix more start = iter start start
iterFix more start = iter start start
where
iter old new = if (null new')
then old
@@ -241,7 +241,7 @@ liftErr e = err raise return e
{-
instance ErrorMonad (STM s) where
raise msg = STM (\s -> raise msg)
handle (STM f) g = STM (\s -> (f s)
handle (STM f) g = STM (\s -> (f s)
`handle` (\e -> let STM g' = (g e) in
g' s))

View File

@@ -5,7 +5,7 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/26 17:13:13 $
-- > CVS $Date: 2005/10/26 17:13:13 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.1 $
--
@@ -83,7 +83,7 @@ transitiveClosure r = fix (Map.map growSet) r
where growSet ys = foldl Set.union ys (map (allRelated r) $ Set.toList ys)
reflexiveClosure_ :: Ord a => [a] -- ^ The set over which the relation is defined.
-> Rel a -> Rel a
-> Rel a -> Rel a
reflexiveClosure_ u r = relates [(x,x) | x <- u] r
-- | Uses 'domain'
@@ -104,7 +104,7 @@ reflexiveElements :: Ord a => Rel a -> Set a
reflexiveElements r = Set.fromList [ x | (x,ys) <- Map.toList r, x `Set.member` ys ]
-- | Keep the related pairs for which the predicate is true.
filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a
filterRel :: Ord a => (a -> a -> Bool) -> Rel a -> Rel a
filterRel p = fst . purgeEmpty . Map.mapWithKey (Set.filter . p)
-- | Remove keys that map to no elements.
@@ -112,16 +112,16 @@ purgeEmpty :: Ord a => Rel a -> (Rel a, Set a)
purgeEmpty r = let (r',r'') = Map.partition (not . Set.null) r
in (r', Map.keysSet r'')
-- | Get the equivalence classes from an equivalence relation.
-- | Get the equivalence classes from an equivalence relation.
equivalenceClasses :: Ord a => Rel a -> [Set a]
equivalenceClasses r = equivalenceClasses_ (Map.keys r) r
where equivalenceClasses_ [] _ = []
equivalenceClasses_ (x:xs) r = ys:equivalenceClasses_ zs r
where ys = allRelated r x
zs = [x' | x' <- xs, not (x' `Set.member` ys)]
where ys = allRelated r x
zs = [x' | x' <- xs, not (x' `Set.member` ys)]
isTransitive :: Ord a => Rel a -> Bool
isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r,
isTransitive r = and [z `Set.member` ys | (x,ys) <- Map.toList r,
y <- Set.toList ys, z <- Set.toList (allRelated r y)]
isReflexive :: Ord a => Rel a -> Bool
@@ -181,7 +181,7 @@ remove x r = let (mss,r') = Map.updateLookupWithKey (\_ _ -> Nothing) x r
Nothing -> (r', Set.empty, Set.empty)
-- remove element from all incoming and outgoing sets
-- of other elements
Just (is,os) ->
Just (is,os) ->
let r'' = foldr (\i -> Map.adjust (\ (is',os') -> (is', Set.delete x os')) i) r' $ Set.toList is
r''' = foldr (\o -> Map.adjust (\ (is',os') -> (Set.delete x is', os')) o) r'' $ Set.toList os
in (r''', is, os)
@@ -190,4 +190,4 @@ incoming :: Ord a => a -> Rel' a -> Set a
incoming x r = maybe Set.empty fst $ Map.lookup x r
--outgoing :: Ord a => a -> Rel' a -> Set a
--outgoing x r = maybe Set.empty snd $ Map.lookup x r
--outgoing x r = maybe Set.empty snd $ Map.lookup x r

View File

@@ -4,7 +4,7 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/26 18:47:16 $
-- > CVS $Date: 2005/10/26 18:47:16 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.6 $
--
@@ -33,7 +33,7 @@ longerThan n = not . notLongerThan n
lookupList :: Eq a => a -> [(a, b)] -> [b]
lookupList a [] = []
lookupList a (p:ps) | a == fst p = snd p : lookupList a ps
| otherwise = lookupList a ps
| otherwise = lookupList a ps
split :: [a] -> ([a], [a])
split (x : y : as) = (x:xs, y:ys)
@@ -48,8 +48,8 @@ splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys)
foldMerge :: (a -> a -> a) -> a -> [a] -> a
foldMerge merge zero = fm
where fm [] = zero
fm [a] = a
fm abs = let (as, bs) = split abs in fm as `merge` fm bs
fm [a] = a
fm abs = let (as, bs) = split abs in fm as `merge` fm bs
select :: [a] -> [(a, [a])]
select [] = []
@@ -68,7 +68,7 @@ safeInit :: [a] -> [a]
safeInit [] = []
safeInit xs = init xs
-- | Sorts and then groups elements given an ordering of the
-- | Sorts and then groups elements given an ordering of the
-- elements.
sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
sortGroupBy f = groupBy (compareEq f) . sortBy f