-- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise
-- to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad.
-newtype ArrowApply a => ArrowMonad a b = ArrowMonad (a () b)
+newtype ArrowMonad a b = ArrowMonad (a () b)
instance ArrowApply a => Monad (ArrowMonad a) where
return x = ArrowMonad (arr (\_ -> x))
-- in an 'MVar' to the appropriate normal form, or utilize a strict
-- MVar provided by the strict-concurrency package.
--
+-- * Ordering
+--
+-- 'MVar' operations are always observed to take place in the order
+-- they are written in the program, regardless of the memory model of
+-- the underlying machine. This is in contrast to 'IORef' operations
+-- which may appear out-of-order to another thread in some cases.
+--
-- * Example
--
-- Consider the following concurrent data structure, a skip channel.
-- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@,
-- but oriented in the positive real direction, whereas @'signum' z@
-- has the phase of @z@, but unit magnitude.
-data (RealFloat a) => Complex a
+data Complex a
= !a :+ !a -- ^ forms a complex number from its real and imaginary
-- rectangular components.
# if __GLASGOW_HASKELL__
#if !defined(__PARALLEL_HASKELL__) && defined(__GLASGOW_HASKELL__)
mkWeakIORef, -- :: IORef a -> IO () -> IO (Weak (IORef a))
#endif
+ -- ** Memory Model
+
+ -- $memmodel
+
) where
#ifdef __HUGS__
writeIORef r a'
return b
#endif
+
+{- $memmodel
+
+ In a concurrent program, 'IORef' operations may appear out-of-order
+ to another thread, depending on the memory model of the underlying
+ processor architecture. For example, on x86, loads can move ahead
+ of stores, so in the following example:
+
+> maybePrint :: IORef Bool -> IORef Bool -> IO ()
+> maybePrint myRef yourRef = do
+> writeIORef myRef True
+> yourVal <- readIORef yourRef
+> unless yourVal $ putStrLn "critical section"
+>
+> main :: IO ()
+> main = do
+> r1 <- newIORef False
+> r2 <- newIORef False
+> forkIO $ maybePrint r1 r2
+> forkIO $ maybePrint r2 r1
+> threadDelay 1000000
+
+ it is possible that the string @"critical section"@ is printed
+ twice, even though there is no interleaving of the operations of the
+ two threads that allows that outcome. The memory model of x86
+ allows 'readIORef' to happen before the earlier 'writeIORef'.
+
+ The implementation is required to ensure that reordering of memory
+ operations cannot cause type-correct code to go wrong. In
+ particular, when inspecting the value read from an 'IORef', the
+ memory writes that created that value must have occurred from the
+ point of view of the current therad.
+
+ 'atomicModifyIORef' acts as a barrier to reordering. Multiple
+ 'atomicModifyIORef' operations occur in strict program order. An
+ 'atomicModifyIORef' is never observed to take place ahead of any
+ earlier (in program order) 'IORef' operations, or after any later
+ 'IORef' operations.
+
+-}
-- | The type of immutable non-strict (boxed) arrays
-- with indices in @i@ and elements in @e@.
-data Ix i => Array i e
- = Array !i -- the lower bound, l
- !i -- the upper bound, u
- !Int -- a cache of (rangeSize (l,u))
- -- used to make sure an index is
- -- really in range
- (Array# e) -- The actual elements
+data Array i e
+ = Array !i -- the lower bound, l
+ !i -- the upper bound, u
+ !Int -- a cache of (rangeSize (l,u))
+ -- used to make sure an index is
+ -- really in range
+ (Array# e) -- The actual elements
-- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type
-- arguments are as follows:
allocation occurs. Some loops do not perform any memory allocation
inside the loop and therefore cannot be interrupted by a 'throwTo'.
-Blocked 'throwTo' is fair: if multiple threads are trying to throw an
-exception to the same target thread, they will succeed in FIFO order.
-
+If the target of 'throwTo' is the calling thread, then the behaviour
+is the same as 'Control.Exception.throwIO', except that the exception
+is thrown as an asynchronous exception. This means that if there is
+an enclosing pure computation, which would be the case if the current
+IO operation is inside 'unsafePerformIO' or 'unsafeInterleaveIO', that
+computation is not permanently replaced by the exception, but is
+suspended as if it had received an asynchronous exception.
+
+Note that if 'throwTo' is called with the current thread as the
+target, the exception will be thrown even if the thread is currently
+inside 'mask' or 'uninterruptibleMask'.
-}
throwTo :: Exception e => ThreadId -> e -> IO ()
throwTo (ThreadId tid) ex = IO $ \ s ->
foreign import ccall unsafe "getFullProgArgv"
getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
-#endif
\ No newline at end of file
+#endif
utf16, utf16le, utf16be,
utf32, utf32le, utf32be,
localeEncoding, fileSystemEncoding, foreignEncoding,
+ char8,
mkTextEncoding,
) where
foreignEncoding = CodePage.mkLocaleEncoding IgnoreCodingFailure
#endif
+-- | An encoding in which Unicode code points are translated to bytes
+-- by taking the code point modulo 256. When decoding, bytes are
+-- translated directly into the equivalent code point.
+--
+-- This encoding never fails in either direction. However, encoding
+-- discards informaiton, so encode followed by decode is not the
+-- identity.
+char8 :: TextEncoding
+char8 = Latin1.latin1
+
-- | Look up the named Unicode encoding. May fail with
--
-- * 'isDoesNotExistError' if the encoding is unknown
("unknown encoding:" ++ e) Nothing Nothing)
latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8)
-latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for binary
+latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8
--latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode
latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer)
-- | Select binary mode ('True') or text mode ('False') on a open handle.
-- (See also 'openBinaryFile'.)
--
--- This has the same effect as calling 'hSetEncoding' with 'latin1', together
+-- This has the same effect as calling 'hSetEncoding' with 'char8', together
-- with 'hSetNewlineMode' with 'noNewlineTranslation'.
--
hSetBinaryMode :: Handle -> Bool -> IO ()
\begin{code}
-- | Rational numbers, with numerator and denominator of some 'Integral' type.
-data (Integral a) => Ratio a = !a :% !a deriving (Eq)
+data Ratio a = !a :% !a deriving (Eq)
-- | Arbitrary-precision rational numbers, represented as a ratio of
-- two 'Integer' values. A rational number may be constructed using
utf16, utf16le, utf16be,
utf32, utf32le, utf32be,
localeEncoding,
+ char8,
mkTextEncoding,
#endif
--- /dev/null
+# This Makefile runs the tests using GHC's testsuite framework. It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
--- /dev/null
+
+test('readFloat', exit_code(1), compile_and_run, [''])
+test('enumDouble', normal, compile_and_run, [''])
+test('enumRatio', normal, compile_and_run, [''])
+test('tempfiles', normal, compile_and_run, [''])
+test('fixed', normal, compile_and_run, [''])
--- /dev/null
+
+main :: IO ()
+main = print (succ (1.0e20 :: Double))
--- /dev/null
+
+import Data.Ratio
+main = print [ 1, 4%(3::Int) .. 1 ]
--- /dev/null
+{-# OPTIONS_GHC -Wall -Werror #-}
+
+module Main where
+
+import Data.Fixed
+
+nums :: Fractional a => [a]
+nums = [0,7,7.1,7.01,7.9,7.09,5 + 7,3.2 - 7.8,5.75 * (-2)]
+
+main :: IO ()
+main = do mapM_ putStrLn $ doit (nums :: [Micro])
+ mapM_ putStrLn $ doit (nums :: [Pico])
+
+doit :: HasResolution a => [Fixed a] -> [String]
+doit xs = [ showFun (signFun x)
+ | showFun <- [show, showFixed True]
+ , signFun <- [id, negate]
+ , x <- xs ]
+
--- /dev/null
+0.000000
+7.000000
+7.100000
+7.010000
+7.900000
+7.090000
+12.000000
+-4.600000
+-11.500000
+0.000000
+-7.000000
+-7.100000
+-7.010000
+-7.900000
+-7.090000
+-12.000000
+4.600000
+11.500000
+0
+7
+7.1
+7.01
+7.9
+7.09
+12
+-4.6
+-11.5
+0
+-7
+-7.1
+-7.01
+-7.9
+-7.09
+-12
+4.6
+11.5
+0.000000000000
+7.000000000000
+7.100000000000
+7.010000000000
+7.900000000000
+7.090000000000
+12.000000000000
+-4.600000000000
+-11.500000000000
+0.000000000000
+-7.000000000000
+-7.100000000000
+-7.010000000000
+-7.900000000000
+-7.090000000000
+-12.000000000000
+4.600000000000
+11.500000000000
+0
+7
+7.1
+7.01
+7.9
+7.09
+12
+-4.6
+-11.5
+0
+-7
+-7.1
+-7.01
+-7.9
+-7.09
+-12
+4.6
+11.5
--- /dev/null
+
+import Numeric
+
+main :: IO ()
+main = putStrLn $ showFloat (read "" :: Float) ""
--- /dev/null
+readFloat: Prelude.read: no parse
--- /dev/null
+
+import Control.Exception
+import Data.List
+import System.FilePath
+import System.Directory
+import System.IO
+
+-- Checks that openTempFile returns filenames with the right structure
+main :: IO ()
+main = do
+ fp0 <- otf ".no_prefix.hs"
+ print (".hs" `isSuffixOf` fp0)
+ print (".no_prefix" `isPrefixOf` takeFileName fp0)
+
+ fp1 <- otf "no_suffix"
+ print (not ('.' `elem` fp1))
+ print ("no_suffix" `isPrefixOf` takeFileName fp1)
+
+ fp2 <- otf "one_suffix.hs"
+ print (".hs" `isSuffixOf` fp2)
+ print ("one_suffix" `isPrefixOf` takeFileName fp2)
+
+ fp3 <- otf "two_suffixes.hs.blah"
+ print (".blah" `isSuffixOf` fp3)
+ print ("two_suffixes.hs" `isPrefixOf` takeFileName fp3)
+
+otf :: FilePath -> IO FilePath
+otf fp = do putStrLn fp
+ bracket (openTempFile "." fp)
+ (\(fp', h) -> do hClose h
+ removeFile fp')
+ (\(fp', _) -> case fp' of
+ '.' : '/' : fp'' -> return fp''
+ '.' : '\\' : fp'' -> return fp''
+ _ -> return fp')
+
--- /dev/null
+.no_prefix.hs
+True
+True
+no_suffix
+True
+True
+one_suffix.hs
+True
+True
+two_suffixes.hs.blah
+True
+True
projects / ghc-base.git / commitdiff