Commit 4e8d3715 authored by Kai-Oliver Prott's avatar Kai-Oliver Prott
Browse files

Reorder modules to be more similar to Haskell

parent 022fdb45
......@@ -27,7 +27,7 @@ module AllSolutions
#ifdef __PAKCS__
import Findall
#else
import SearchTree
import Algorithm.SearchTree
#endif
--- Gets all values of an expression (currently, via an incomplete
......
......@@ -4,7 +4,7 @@
--- @authors {bbr, fhu}@informatik.uni-kiel.de
--- @category algorithm
module Array
module Array
(Array,
emptyErrorArray, emptyDefaultArray,
......@@ -16,10 +16,7 @@ module Array
combine, combineSimilar)
where
import Integer
where
infixl 9 !, //
......@@ -31,7 +28,7 @@ data Entry b = Entry b (Entry b) (Entry b) | Empty
--- Creates an empty array which generates errors for non-initialized
--- indexes.
emptyErrorArray :: Array b
emptyErrorArray = emptyDefaultArray errorArray
emptyErrorArray = emptyDefaultArray errorArray
errorArray :: Int -> _
errorArray idx = error ("Array index "++show idx++" not initialized")
......@@ -49,8 +46,8 @@ emptyDefaultArray dflt = Array dflt Empty
--- will be overwritten. Likewise the last entry with a given index
--- will be contained in the result array.
(//) :: Array b -> [(Int,b)] -> Array b
(//) (Array dflt array) modifications =
Array dflt
(//) (Array dflt array) modifications =
Array dflt
(foldr (\ (n,v) a -> at (dflt n) a n (const v)) array modifications)
--- Inserts a new entry into an array.
......@@ -59,7 +56,7 @@ emptyDefaultArray dflt = Array dflt Empty
--- @param val - value to update at index idx
--- Entries already initialized will be overwritten.
update :: Array b -> Int -> b -> Array b
update (Array dflt a) i v =
update (Array dflt a) i v =
Array dflt (at (dflt i) a i (const v))
--- Applies a function to an element.
......@@ -72,10 +69,10 @@ applyAt (Array dflt a) n f = Array dflt (at (dflt n) a n f)
at :: b -> Entry b -> Int -> (b -> b) -> Entry b
at dflt Empty n f
at dflt Empty n f
| n==0 = Entry (f dflt) Empty Empty
| odd n = Entry dflt (at dflt Empty (n `div` 2) f) Empty
| otherwise = Entry dflt Empty (at dflt Empty (n `div` 2 - 1) f)
| otherwise = Entry dflt Empty (at dflt Empty (n `div` 2 - 1) f)
at dflt (Entry v al ar) n f
| n==0 = Entry (f v) al ar
| odd n = Entry v (at dflt al (n `div` 2) f) ar
......@@ -84,13 +81,13 @@ at dflt (Entry v al ar) n f
--- Yields the value at a given position.
--- @param a - array to look up in
--- @param n - index, where to look
--- @param n - index, where to look
(!) :: Array b -> Int -> b
(Array dflt array) ! i = from (dflt i) array i
from :: a -> Entry a -> Int -> a
from dflt Empty _ = dflt
from dflt (Entry v al ar) n
from dflt (Entry v al ar) n
| n==0 = v
| odd n = from dflt al (n `div` 2)
| otherwise = from dflt ar (n `div` 2 - 1)
......@@ -111,7 +108,7 @@ listToDefaultArray def = Array def . listToArray
--- Creates an error array from a list of entries.
--- @param xs - list of entries
listToErrorArray :: [b] -> Array b
listToErrorArray = listToDefaultArray errorArray
listToErrorArray = listToDefaultArray errorArray
listToArray :: [b] -> Entry b
......@@ -124,29 +121,29 @@ listToArray (x:xs) = let (ys,zs) = split xs in
--- combine two arbitrary arrays
combine :: (a -> b -> c) -> Array a -> Array b -> Array c
combine f (Array def1 a1) (Array def2 a2) =
combine f (Array def1 a1) (Array def2 a2) =
Array (\i -> f (def1 i) (def2 i)) (comb f def1 def2 a1 a2 0 1)
comb :: (a -> b -> c) -> (Int -> a) -> (Int -> b)
comb :: (a -> b -> c) -> (Int -> a) -> (Int -> b)
-> Entry a -> Entry b -> Int -> Int -> Entry c
comb _ _ _ Empty Empty _ _ = Empty
comb f def1 def2 (Entry x xl xr) Empty b o =
Entry (f x (def2 (b+o-1)))
comb f def1 def2 (Entry x xl xr) Empty b o =
Entry (f x (def2 (b+o-1)))
(comb f def1 def2 xl Empty (2*b) o)
(comb f def1 def2 xr Empty (2*b) (o+b))
comb f def1 def2 Empty (Entry y yl yr) b o =
Entry (f (def1 (b+o-1)) y)
comb f def1 def2 Empty (Entry y yl yr) b o =
Entry (f (def1 (b+o-1)) y)
(comb f def1 def2 Empty yl (2*b) o)
(comb f def1 def2 Empty yr (2*b) (o+b))
comb f def1 def2 (Entry x xl xr) (Entry y yl yr) b o =
Entry (f x y)
comb f def1 def2 (Entry x xl xr) (Entry y yl yr) b o =
Entry (f x y)
(comb f def1 def2 xl yl (2*b) o)
(comb f def1 def2 xr yr (2*b) (o+b))
--- the combination of two arrays with identical default function
--- and a combinator which is neutral in the default
--- and a combinator which is neutral in the default
--- can be implemented much more efficient
combineSimilar :: (a -> a -> a) -> Array a -> Array a -> Array a
......@@ -155,10 +152,5 @@ combineSimilar f (Array def a1) (Array _ a2) = Array def (combSim f a1 a2)
combSim :: (a -> a -> a) -> Entry a -> Entry a -> Entry a
combSim _ Empty a2 = a2
combSim _ (Entry x y z) Empty = Entry x y z
combSim f (Entry x xl xr) (Entry y yl yr) =
combSim f (Entry x xl xr) (Entry y yl yr) =
Entry (f x y) (combSim f xl yl) (combSim f xr yr)
......@@ -15,7 +15,7 @@
module Combinatorial(permute, subset, allSubsets, splitSet,
sizedSubset, partition) where
import List(sum)
import Data.List(sum)
import SetFunctions
import Test.Prop
......
module Control.Applicative where
infixl 4 <*>, <*, *>
--- Typeclass for Applicative-Functors
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
(*>) :: f a -> f b -> f b
m *> n = (id <$ m) <*> n
(<*) :: f a -> f b -> f a
(<*) = liftA2 const
liftA2 :: (a -> b -> c) -> f a -> f b -> f c
liftA2 f x = (<*>) (fmap f x)
instance Applicative Maybe where
pure = Just
Just f <*> Just a = Just (f a)
Nothing <*> Just _ = Nothing
Just _ <*> Nothing = Nothing
Nothing <*> Nothing = Nothing
--- Lift a function to actions.
--- This function may be used as a value for `fmap` in a `Functor` instance.
liftA :: Applicative f => (a -> b) -> f a -> f b
liftA f a = pure f <*> a
--- Lift a ternary function to actions.
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 f a b c = liftA2 f a b <*> c
module Control.Monad.Extra where
--- Same as `concatMap`, but for a monadic function.
concatMapM :: (Functor m, Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM f xs = concat <$> mapM f xs
--- Same as `mapM` but with an additional accumulator threaded through.
mapAccumM :: Monad m => (a -> b -> m (a, c))
-> a -> [b] -> m (a, [c])
mapAccumM _ s [] = return (s, [])
mapAccumM f s (x : xs) = f s x >>= (\(s', x') -> (mapAccumM f s' xs) >>=
(\(s'', xs') -> return (s'', x' : xs')))
module Control.Monad.Trans.Class where
class MonadTrans t where
lift :: (Monad m) => m a -> t m a
--- ---------------------------------------------------------------------------
--- This monad transformer adds the ability to fail
--- or throw exceptions to a monad.
---
--- @author Bjoern Peemoeller
--- @version September 2014
--- @category general
--- ----------------------------------------------------------------------------
module Control.Monad.Trans.Error (
module Control.Monad.Trans.Error,
module Control.Monad.Trans.Class
) where
import Data.Either
import Data.Functor.Identity
import Control.Monad.Trans.Class
import Control.Applicative
--- Error monad.
newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
class Error a where
noMsg :: a
noMsg = strMsg ""
strMsg :: String -> a
strMsg _ = noMsg
class ErrorList a where
listMsg :: String -> [a]
instance ErrorList Char where
listMsg = id
instance ErrorList a => Error [a] where
strMsg = listMsg
instance (Functor m) => Functor (ErrorT e m) where
fmap f = ErrorT . fmap (fmap f) . runErrorT
-- defined in terms of the monad instance for ErrorT
instance (Functor m, Monad m, Error e) => Applicative (ErrorT e m) where
pure = return
f <*> v = f >>= (\f' -> v >>= (\x -> return (f' x)))
instance (Monad m, Error e) => Monad (ErrorT e m) where
return a = ErrorT $ return (Right a)
m >>= k = ErrorT (do a <- runErrorT m
case a of
Left l -> return (Left l)
Right r -> runErrorT (k r))
fail msg = ErrorT $ return (Left (strMsg msg))
instance MonadTrans (ErrorT e) where
lift m = ErrorT (do a <- m
return (Right a))
-- Signal an error value e.
throwError :: (Monad m) => e -> ErrorT e m a
throwError l = ErrorT $ return (Left l)
-- Handle an error.
catchError :: (Monad m) => ErrorT e m a -> (e -> ErrorT e m a) -> ErrorT e m a
catchError m h = ErrorT (do a <- runErrorT m
case a of
Left l -> runErrorT (h l)
Right r -> return (Right r))
runError :: ErrorT e Identity a -> Either e a
runError = runIdentity . runErrorT
------------------------------------------------------------------------------
--- This library provides an implementation of the state monad.
---
--- @author Jan-Hendrik Matthes, Bjoern Peemoeller, Fabian Skrlac
--- @version August 2016
--- @category general
------------------------------------------------------------------------------
module Control.Monad.Trans.State
( State, StateT(runStateT)
, evalStateT, execStateT
, get, put, modify, runState, evalState, execState
, module Control.Monad.Trans.Class
) where
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Control.Applicative
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
instance (Functor m) => Functor (StateT s m) where
fmap f m = StateT (\ s ->
fmap (\ ~(a, s') -> (f a, s')) $ runStateT m s)
-- defined in terms of the monad instance for StateT
instance (Functor m, Monad m) => Applicative (StateT s m) where
pure = return
f <*> v = f >>= (\f' -> v >>= (\x -> return (f' x)))
instance (Monad m) => Monad (StateT s m) where
m >>= k = StateT (\ s -> do ~(a, s') <- runStateT m s
runStateT (k a) s')
return a = StateT (\ s -> return (a, s))
fail str = StateT (\ _ -> fail str)
instance MonadTrans (StateT s) where
lift m = StateT (\ s -> do a <- m
return (a, s))
state :: Monad m => (s -> (a, s)) -> StateT s m a
state f = StateT (return . f)
get :: Monad m => StateT s m s
get = state (\ s -> (s, s))
put :: Monad m => s -> StateT s m ()
put s = state (\ _ -> ((), s))
modify :: Monad m => (s -> s) -> StateT s m ()
modify f = state (\ s -> ((), f s))
type State s = StateT s Identity
runState :: State s a -> s -> (a, s)
runState m = runIdentity . runStateT m
evalState :: State s a -> s -> a
evalState m s = fst (runState m s)
execState :: State s a -> s -> s
execState m s = snd (runState m s)
evalStateT :: (Monad m) => StateT s m a -> s -> m a
evalStateT m s = do
~(a, _) <- runStateT m s
return a
execStateT :: (Monad m) => StateT s m a -> s -> m s
execStateT m s = do
~(_, s') <- runStateT m s
return s'
......@@ -6,7 +6,7 @@
--- @category general
------------------------------------------------------------------------------
module Char
module Data.Char
( isAscii, isLatin1, isAsciiUpper, isAsciiLower, isControl
, isUpper, isLower, isAlpha, isDigit, isAlphaNum
, isBinDigit, isOctDigit, isHexDigit, isSpace
......
......@@ -6,7 +6,7 @@
--- @category general
--- ----------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
module Either
module Data.Either
( Either (..)
, either
, lefts
......
--- ----------------------------------------------------------------------------
--- This module provides some utility functions for function application.
---
--- @author Bjoern Peemoeller
--- @version July 2013
--- @category general
--- ----------------------------------------------------------------------------
module Data.Function (fix, on) where
--- `fix f` is the least fixed point of the function `f`,
--- i.e. the least defined `x` such that `f x = x`.
fix :: (a -> a) -> a
fix f = let x = f x in x
--- `(*) \`on\` f = \\x y -> f x * f y`.
--- Typical usage: `sortBy (compare \`on\` fst)`.
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on op f x y = f x `op` f y
......@@ -6,7 +6,7 @@
--- @category general
--- ----------------------------------------------------------------------------
module FunctionInversion where
module Data.Function.Inversion where
--- Inverts a unary function.
invf1 :: (a -> b) -> (b -> a)
......
module Data.Functor.Identity where
newtype Identity a = Identity { runIdentity :: a }
deriving (Eq, Ord, Read, Show)
instance Functor Identity where
fmap f (Identity a) = Identity $ f a
instance Monad Identity where
m >>= k = k (runIdentity m)
return a = Identity a
......@@ -25,8 +25,8 @@
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Global( Global, GlobalSpec(..), global
, readGlobal, safeReadGlobal, writeGlobal)
module Data.Global( Global, GlobalSpec(..), global
, readGlobal, safeReadGlobal, writeGlobal)
where
----------------------------------------------------------------------
......
......@@ -6,9 +6,9 @@
--- @category general
------------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
--{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
module List
module Data.List
( elemIndex, elemIndices, find, findIndex, findIndices
, nub, nubBy, delete, deleteBy, (\\), union, intersect
, intersperse, intercalate, transpose, diagonal, permutations, partition
......@@ -23,7 +23,7 @@ module List
, cycle, unfoldr
) where
import Maybe (listToMaybe)
import Data.Maybe (listToMaybe)
infix 5 \\
......
This diff is collapsed.
......@@ -6,18 +6,15 @@
--- @category general
--- ----------------------------------------------------------------------------
module Maybe
module Data.Maybe
( Maybe (..)
, maybe
, isJust, isNothing
, fromJust, fromMaybe
, listToMaybe, maybeToList
, catMaybes, mapMaybe
, (>>-), sequenceMaybe, mapMMaybe, mplus
) where
infixl 1 >>-
--- Return `True` iff the argument is of the form `Just _`.
isJust :: Maybe _ -> Bool
isJust (Just _) = True
......@@ -59,27 +56,3 @@ catMaybes ms = [ m | (Just m) <- ms ]
--- constructor to a list of elements.
mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe f = catMaybes . map f
--- Monadic bind for Maybe.
--- Maybe can be interpreted as a monad where Nothing is interpreted
--- as the error case by this monadic binding.
--- @param maybeValue - Nothing or Just x
--- @param f - function to be applied to x
--- @return Nothing if maybeValue is Nothing, otherwise f is applied to x
(>>-) :: Maybe a -> (a -> Maybe b) -> Maybe b
Nothing >>- _ = Nothing
Just x >>- f = f x
--- Monadic `sequence` for `Maybe`.
sequenceMaybe :: [Maybe a] -> Maybe [a]
sequenceMaybe [] = Just []
sequenceMaybe (c:cs) = c >>- \x -> sequenceMaybe cs >>- \xs -> Just (x:xs)
--- Monadic `map` for `Maybe`.
mapMMaybe :: (a -> Maybe b) -> [a] -> Maybe [b]
mapMMaybe f = sequenceMaybe . map f
--- Combine two `Maybe`s, returning the first `Just` value, if any.
mplus :: Maybe a -> Maybe a -> Maybe a
Nothing `mplus` y = y
x@(Just _) `mplus` _ = x
......@@ -8,7 +8,7 @@
--- @category algorithm
------------------------------------------------------------------------------
module Dequeue
module Data.Queue
( -- Abstract data type, constructors and queries
Queue, empty, cons, snoc, isEmpty, deqLength
-- Selectors
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment