strict-0.3.2/0000755000076500007650000000000010764252172010660 5ustar rlrlstrict-0.3.2/Data/0000755000076500007650000000000010764252172011531 5ustar rlrlstrict-0.3.2/Data/Strict/0000755000076500007650000000000010764252172013001 5ustar rlrlstrict-0.3.2/Data/Strict/Either.hs0000644000076500007650000000344410764252172014562 0ustar rlrl----------------------------------------------------------------------------- -- | -- Module : Data.Strict.Either -- Copyright : (c) 2006-2007 Roman Leshchinskiy -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Strict @Either@. -- -- Same as the standard Haskell @Either@, but @Left _|_ = Right _|_ = _|_@ -- ----------------------------------------------------------------------------- module Data.Strict.Either ( Either(..) , either , isLeft, isRight , fromLeft, fromRight ) where import Prelude hiding( Either(..), either ) -- | The strict choice type. data Either a b = Left !a | Right !b deriving(Eq, Ord, Read, Show) instance Functor (Either a) where fmap _ (Left x) = Left x fmap f (Right y) = Right (f y) -- | Case analysis: if the value is @'Left' a@, apply the first function to @a@; -- if it is @'Right' b@, apply the second function to @b@. either :: (a -> c) -> (b -> c) -> Either a b -> c either f _ (Left x) = f x either _ g (Right y) = g y -- | Yields 'True' iff the argument is of the form @Left _@. -- isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft _ = False -- | Yields 'True' iff the argument is of the form @Right _@. -- isRight :: Either a b -> Bool isRight (Right _) = True isRight _ = False -- | Extracts the element out of a 'Left' and throws an error if the argument -- is a 'Right'. fromLeft :: Either a b -> a fromLeft (Left x) = x fromLeft _ = error "Data.Strict.Either.fromLeft: Right" -- | Extracts the element out of a 'Right' and throws an error if the argument -- is a 'Left'. fromRight :: Either a b -> b fromRight (Right x) = x fromRight _ = error "Data.Strict.Either.fromRight: Left" strict-0.3.2/Data/Strict/Maybe.hs0000644000076500007650000000370210764252172014374 0ustar rlrl----------------------------------------------------------------------------- -- | -- Module : Data.Strict.Maybe -- Copyright : (c) 2006-2007 Roman Leshchinskiy -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Strict @Maybe@. -- -- Same as the standard Haskell @Maybe@, but @Just _|_ = _|_@ -- -- Note that strict @Maybe@ is not a monad since -- @ return _|_ >>= f = _|_ @ -- which is not necessarily the same as @f _|_@. -- ----------------------------------------------------------------------------- module Data.Strict.Maybe ( Maybe(..) , isJust , isNothing , fromJust , fromMaybe , maybe ) where import Prelude hiding( Maybe(..), maybe ) -- | The type of strict optional values. data Maybe a = Nothing | Just !a deriving(Eq, Ord, Show, Read) instance Functor Maybe where fmap _ Nothing = Nothing fmap f (Just x) = Just (f x) -- | Yields 'True' iff the argument is of the form @Just _@. isJust :: Maybe a -> Bool isJust Nothing = False isJust _ = True -- | Yields 'True' iff the argument is 'Nothing'. isNothing :: Maybe a -> Bool isNothing Nothing = True isNothing _ = False -- | Extracts the element out of a 'Just' and throws an error if the argument -- is 'Nothing'. fromJust :: Maybe a -> a fromJust Nothing = error "Data.Strict.Maybe.fromJust: Nothing" fromJust (Just x) = x -- | Given a default value and a 'Maybe', yield the default value if the -- 'Maybe' argument is 'Nothing' and extract the value out of the 'Just' -- otherwise. fromMaybe :: a -> Maybe a -> a fromMaybe x Nothing = x fromMaybe _ (Just y) = y -- | Given a default value, a function and a 'Maybe' value, yields the default -- value if the 'Maybe' value is 'Nothing' and applies the function to the -- value stored in the 'Just' otherwise. maybe :: b -> (a -> b) -> Maybe a -> b maybe x _ Nothing = x maybe _ f (Just y) = f y strict-0.3.2/Data/Strict/Tuple.hs0000644000076500007650000000270510764252172014432 0ustar rlrl----------------------------------------------------------------------------- -- | -- Module : Data.Strict.Tuple -- Copyright : (c) 2006-2007 Roman Leshchinskiy -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Strict pairs. -- -- Same as regular Haskell pairs, but @(x :*: _|_) = (_|_ :*: y) = _|_@ -- ----------------------------------------------------------------------------- {-# OPTIONS_GHC -fglasgow-exts #-} module Data.Strict.Tuple ( Pair(..) #ifndef __HADDOCK__ #ifdef __GLASGOW_HASKELL__ , (:!:) #endif #endif , fst , snd , curry , uncurry ) where import Prelude hiding( fst, snd, curry, uncurry ) import Data.Array (Ix) infixl 2 :!: -- | The type of strict pairs. data Pair a b = !a :!: !b deriving(Eq, Ord, Show, Read, Bounded, Ix) #ifndef __HADDOCK__ #ifdef __GLASGOW_HASKELL__ -- This gives a nicer syntax for the type but only works in GHC for now. type (:!:) = Pair #endif #endif -- | Extract the first component of a strict pair. fst :: Pair a b -> a fst (x :!: _) = x -- | Extract the second component of a strict pair. snd :: Pair a b -> b snd (_ :!: y) = y -- | Curry a function on strict pairs. curry :: (Pair a b -> c) -> a -> b -> c curry f x y = f (x :!: y) -- | Convert a curried function to a function on strict pairs. uncurry :: (a -> b -> c) -> Pair a b -> c uncurry f (x :!: y) = f x y strict-0.3.2/Data/Strict.hs0000644000076500007650000000123210764252172013333 0ustar rlrl----------------------------------------------------------------------------- -- | -- Module : Data.Strict -- Copyright : (c) 2006-2007 Roman Leshchinskiy -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Roman Leshchinskiy -- Stability : experimental -- Portability : portable -- -- Strict versions of some standard Haskell types. -- ----------------------------------------------------------------------------- module Data.Strict ( module Data.Strict.Tuple , module Data.Strict.Maybe , module Data.Strict.Either ) where import Data.Strict.Tuple import Data.Strict.Maybe import Data.Strict.Either strict-0.3.2/LICENSE0000644000076500007650000000264710764252172011676 0ustar rlrlCopyright (c) Roman Leshchinskiy 2006-2007 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. strict-0.3.2/Setup.lhs0000744000076500007650000000011410764252172012465 0ustar rlrl#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain strict-0.3.2/strict.cabal0000644000076500007650000000163410764252172013160 0ustar rlrlName: strict Version: 0.3.2 Synopsis: Strict data types and String IO. Category: Data, System Description: This package provides strict versions of some standard Haskell data types (pairs, Maybe and Either). It also contains strict IO operations. License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy Maintainer: Don Stewart Copyright: (c) 2006-2007 by Roman Leshchinskiy Homepage: http://www.cse.unsw.edu.au/~rl/code/strict.html Cabal-Version: >= 1.2 Build-type: Simple flag split-base library if flag(split-base) build-depends: base >= 3, array else build-depends: base < 3 exposed-modules: Data.Strict.Tuple Data.Strict.Maybe Data.Strict.Either Data.Strict System.IO.Strict ghc-options: -Wall extensions: CPP strict-0.3.2/System/0000755000076500007650000000000010764252172012144 5ustar rlrlstrict-0.3.2/System/IO/0000755000076500007650000000000010764252172012453 5ustar rlrlstrict-0.3.2/System/IO/Strict.hs0000644000076500007650000000462210764252172014263 0ustar rlrl----------------------------------------------------------------------------- -- | -- Module : System.IO.Strict -- Copyright : (c) Don Stewart 2007 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : dons@galois.com -- Stability : stable -- Portability : portable -- -- The standard IO input functions using strict IO. -- ----------------------------------------------------------------------------- module System.IO.Strict ( -- * Strict Handle IO hGetContents, -- :: Handle -> IO [Char] -- * Strict String IO wrappers getContents, -- :: IO String readFile, -- :: FilePath -> IO String interact -- :: (String -> String) -> IO () ) where import Prelude ( String, (>>=), seq, return, (.), (=<<), FilePath, length) import System.IO (IO) import qualified System.IO as IO -- ----------------------------------------------------------------------------- -- Strict hGetContents -- | Computation 'hGetContents' @hdl@ returns the list of characters -- corresponding to the unread portion of the channel or file managed -- by @hdl@, which is immediate closed. -- -- Items are read strictly from the input Handle. -- -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. hGetContents :: IO.Handle -> IO.IO String hGetContents h = IO.hGetContents h >>= \s -> length s `seq` return s -- ----------------------------------------------------------------------------- -- Standard IO -- | The 'getContents' operation returns all user input as a single string, -- which is read stirctly (same as 'hGetContents' 'stdin'). getContents :: IO String getContents = hGetContents IO.stdin {-# INLINE getContents #-} -- | The 'interact' function takes a function of type @String->String@ -- as its argument. The entire input from the standard input device is -- passed to this function as its argument, and the resulting string is -- output on the standard output device. interact :: (String -> String) -> IO () interact f = IO.putStr . f =<< getContents {-# INLINE interact #-} -- | The 'readFile' function reads a file and -- returns the contents of the file as a string. -- The file is read strictly, as with 'getContents'. readFile :: FilePath -> IO String readFile name = IO.openFile name IO.ReadMode >>= hGetContents {-# INLINE readFile #-}