Commit c415cd35 authored by simonpj's avatar simonpj
Browse files

[project @ 1999-05-18 14:59:04 by simonpj]

../compiler/msg_prel
parent 0d8269cc
......@@ -50,6 +50,9 @@ module GlaExts
-- the representation of some basic types:
Int(..),Addr(..),Word(..),Float(..),Double(..),Integer(..),Char(..),
-- Fusion
build, augment,
-- misc bits
trace,
......
......@@ -31,7 +31,8 @@ import Char (ord, chr)
import PreludeBuiltin
ord_0 = ord '0'
#else
import PrelBase (ord_0, showList__)
import PrelNum ( ord_0 )
import PrelShow( showList__ )
import GlaExts
#endif
\end{code}
......
......@@ -74,7 +74,7 @@ module PackedString (
) where
import GlaExts
import PrelBase ( showList__ ) -- ToDo: better
import PrelShow ( showList__ ) -- ToDo: better
import PrelPack
( new_ps_array
, freeze_ps_array
......
......@@ -34,7 +34,7 @@ import PrintfPrims
#if defined(__GLASGOW_HASKELL__)
import GlaExts
import PrelArr (Array(..), ByteArray(..))
import PrelBase hiding (itos)
import PrelBase
#endif
data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double
......
......@@ -201,7 +201,7 @@ nOfThem :: Int -> a -> [a]
nOfThem = replicate -- deprecated.
lengthExceeds :: [a] -> Int -> Bool
-- (lengthExceeds xs n) is True if length xs > n
[] `lengthExceeds` n = 0 > n
(x:xs) `lengthExceeds` n = (1 > n) || (xs `lengthExceeds` (n - 1))
......@@ -719,12 +719,6 @@ cmpString (x:xs) (y:ys) = if x == y then cmpString xs ys
else GT_
cmpString [] ys = LT_
cmpString xs [] = GT_
#ifdef COMPILING_GHC
cmpString _ _ = panic# "cmpString"
#else
cmpString _ _ = error "cmpString"
#endif
\end{code}
\begin{code}
......
......@@ -77,7 +77,7 @@ import CString ( packStringIO, allocChars,
)
import Addr
import CCall
import PrelBase
import PrelBase hiding( append )
import ByteArray
import PosixErr
......
......@@ -40,6 +40,7 @@ module Array
import Ix
import PrelList
import PrelShow
import PrelArr -- Most of the hard work is done here
import PrelBase
......
......@@ -33,7 +33,9 @@ module Char
) where
import PrelBase
import PrelShow
import PrelEnum
import PrelNum
import PrelRead (readLitChar, lexLitChar, digitToInt)
import {-# SOURCE #-} PrelErr ( error )
import PrelErr ( error )
\end{code}
......@@ -108,9 +108,8 @@ import PrelHandle -- much of the real stuff is in here
import PrelRead ( readParen, Read(..), reads, lex,
readIO
)
--import PrelNum ( toInteger )
import PrelBounded () -- Bounded Int instance.
import PrelEither ( Either(..) )
import PrelShow
import PrelMaybe ( Either(..) )
import PrelAddr ( Addr(..), nullAddr )
import PrelArr ( ByteArray )
import PrelPack ( unpackNBytesAccST )
......
......@@ -32,6 +32,10 @@ module Ix
import {-# SOURCE #-} PrelErr ( error )
import PrelTup
import PrelBase
import PrelList( null )
import PrelEnum
import PrelShow
import PrelNum
\end{code}
%*********************************************************
......@@ -43,10 +47,14 @@ import PrelBase
\begin{code}
class (Ord a) => Ix a where
range :: (a,a) -> [a]
index :: (a,a) -> a -> Int
index, unsafeIndex :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
\end{code}
-- Must specify one of index, unsafeIndex
index b i | inRange b i = unsafeIndex b i
| otherwise = error "Error in array index"
unsafeIndex b i = index b i
\end{code}
%*********************************************************
%* *
......@@ -55,43 +63,69 @@ class (Ord a) => Ix a where
%*********************************************************
\begin{code}
-- abstract these errors from the relevant index functions so that
-- the guts of the function will be small enough to inline.
{-# NOINLINE indexError #-}
indexError :: Show a => (a,a) -> a -> String -> b
indexError rng i tp
= error (showString "Ix{" . showString tp . showString "}.index: Index " .
showParen True (showsPrec 0 i) .
showString " out of range " $
showParen True (showsPrec 0 rng) "")
----------------------------------------------------------------------
instance Ix Char where
range (m,n)
| m <= n = [m..n]
| otherwise = []
index b@(m,_) i
| inRange b i = fromEnum i - fromEnum m
| otherwise = indexError i b "Char"
unsafeIndex (m,n) i = fromEnum i - fromEnum m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Char"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Int where
range (m,n)
| m <= n = [m..n]
| otherwise = []
index b@(m,_) i
| inRange b i = i - m
| otherwise = indexError i b "Int"
unsafeIndex (m,n) i = i - m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
inRange (m,n) i = m <= i && i <= n
-- abstract these errors from the relevant index functions so that
{-# NOINLINE indexError #-}
indexError :: Show a => a -> (a,a) -> String -> b
indexError i rng tp
= error (showString "Ix{" . showString tp . showString "}.index: Index " .
showParen True (showsPrec 0 i) .
showString " out of range " $
----------------------------------------------------------------------
instance Ix Integer where
range (m,n)
| m <= n = [m..n]
| otherwise = []
unsafeIndex (m,n) i = fromInteger (i - m)
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Integer"
inRange (m,n) i = m <= i && i <= n
----------------------------------------------------------------------
instance Ix Bool where -- as derived
range (l,u)
| l <= u = map toEnum [fromEnum l .. fromEnum u]
| otherwise = []
| otherwise = []
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Bool"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
......@@ -99,47 +133,62 @@ instance Ix Ordering where -- as derived
range (l,u)
| l <= u = map toEnum [fromEnum l .. fromEnum u]
| otherwise = []
index (l,_) i = fromEnum i - fromEnum l
unsafeIndex (l,_) i = fromEnum i - fromEnum l
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Ordering"
inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
----------------------------------------------------------------------
instance Ix () where
{-# INLINE range #-}
range ((), ()) = [()]
{-# INLINE index #-}
index ((), ()) () = 0
{-# INLINE unsafeIndex #-}
unsafeIndex ((), ()) () = 0
{-# INLINE inRange #-}
inRange ((), ()) () = True
{-# INLINE index #-}
index b i = unsafeIndex b i
----------------------------------------------------------------------
instance (Ix a, Ix b) => Ix (a, b) where -- as derived
{-# SPECIALISE instance Ix (Int,Int) #-}
{- INLINE range #-}
range ((l1,l2),(u1,u2)) =
[ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
{- INLINE index #-}
index ((l1,l2),(u1,u2)) (i1,i2) =
index (l1,u1) i1 * rangeSize (l2,u2) + index (l2,u2) i2
{- INLINE unsafeIndex #-}
unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
{- INLINE inRange #-}
inRange ((l1,l2),(u1,u2)) (i1,i2) =
inRange (l1,u1) i1 && inRange (l2,u2) i2
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
{-# SPECIALISE instance Ix (Int,Int,Int) #-}
range ((l1,l2,l3),(u1,u2,u3)) =
[(i1,i2,i3) | i1 <- range (l1,u1),
i2 <- range (l2,u2),
i3 <- range (l3,u3)]
index ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
index (l3,u3) i3 + rangeSize (l3,u3) * (
index (l2,u2) i2 + rangeSize (l2,u2) * (
index (l1,u1) i1))
unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))
inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3
-- Default method for index
----------------------------------------------------------------------
instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
[(i1,i2,i3,i4) | i1 <- range (l1,u1),
......@@ -147,16 +196,18 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
i3 <- range (l3,u3),
i4 <- range (l4,u4)]
index ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
index (l4,u4) i4 + rangeSize (l4,u4) * (
index (l3,u3) i3 + rangeSize (l3,u3) * (
index (l2,u2) i2 + rangeSize (l2,u2) * (
index (l1,u1) i1)))
unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1)))
inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4
-- Default method for index
instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
[(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
......@@ -165,17 +216,19 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
i4 <- range (l4,u4),
i5 <- range (l5,u5)]
index ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
index (l5,u5) i5 + rangeSize (l5,u5) * (
index (l4,u4) i4 + rangeSize (l4,u4) * (
index (l3,u3) i3 + rangeSize (l3,u3) * (
index (l2,u2) i2 + rangeSize (l2,u2) * (
index (l1,u1) i1))))
unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
unsafeIndex (l1,u1) i1))))
inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
inRange (l5,u5) i5
-- Default method for index
\end{code}
%********************************************************
......@@ -185,16 +238,27 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
%********************************************************
The @rangeSize@ operator returns the number of elements
in the range for an @Ix@ pair:
in the range for an @Ix@ pair.
\begin{code}
{-# SPECIALISE unsafeRangeSize :: (Int,Int) -> Int #-}
{-# SPECIALISE unsafeRangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
unsafeRangeSize :: (Ix a) => (a,a) -> Int
unsafeRangeSize b@(l,h) = unsafeIndex b h + 1
{-# SPECIALISE rangeSize :: (Int,Int) -> Int #-}
{-# SPECIALISE rangeSize :: ((Int,Int),(Int,Int)) -> Int #-}
rangeSize :: (Ix a) => (a,a) -> Int
rangeSize b@(l,h)
| l > h || isnull (range b) = 0
| otherwise = index b h + 1
where
isnull [] = True
isnull _ = False
rangeSize b@(l,h) | inRange b h = unsafeIndex b h + 1
| otherwise = 0
-- Note that the following is NOT right
-- rangeSize (l,h) | l <= h = index b h + 1
-- | otherwise = 0
--
-- Because it might be the case that l<h, but the range
-- is nevertheless empty. Consider
-- ((1,2),(2,1))
-- Here l<h, but the second index ranges from 2..1 and
-- hence is empty
\end{code}
......@@ -127,6 +127,7 @@ module List
) where
import Prelude
import PrelShow ( lines, words, unlines, unwords )
import Maybe ( listToMaybe )
import PrelBase ( Int(..), map, (++) )
import PrelGHC ( (+#) )
......
......@@ -7,6 +7,7 @@
---------------------------------------------------------------------------
__interface Main 1 where
__export ! Main main ;
__export Main main ;
1 main :: __forall [a] => PrelIOBase.IO a; -- wish this could be __o. KSW 1999-04.
......@@ -36,6 +36,7 @@ module Numeric
import PrelBase
import PrelMaybe
import PrelShow
import PrelArr
import PrelNum
import PrelNumExtra
......
......@@ -22,6 +22,7 @@ module PrelAddr (
import PrelGHC
import PrelBase
import PrelShow
import PrelCCall
\end{code}
......
......@@ -119,34 +119,30 @@ bounds (Array b _) = b
case (indexArray# arr# n#) of
(# v #) -> v
#ifdef USE_FOLDR_BUILD
{-# INLINE array #-}
#endif
array ixs ivs =
runST ( ST $ \ s ->
case (newArray ixs arrEleBottom) of { ST new_array_thing ->
case (new_array_thing s) of { (# s#, arr@(MutableArray _ arr#) #) ->
let
fill_in s1# [] = s1#
fill_in s1# ((i,v) : is) =
case (index ixs i) of { I# n# ->
case writeArray# arr# n# v s1# of { s2# ->
fill_in s2# is }}
in
case (fill_in s# ivs) of { s1# ->
case (freezeArray arr) of { ST freeze_array_thing ->
freeze_array_thing s1# }}}})
array ixs ivs
= case rangeSize ixs of { I# n ->
runST ( ST $ \ s1 ->
case newArray# n arrEleBottom s1 of { (# s2, marr #) ->
foldr (fill ixs marr) (done ixs marr) ivs s2
})}
fill :: Ix ix => (ix,ix) -> MutableArray# s elt
-> (ix,elt) -> STRep s a -> STRep s a
{-# INLINE fill #-}
fill ixs marr (i,v) next = \s1 -> case index ixs i of { I# n ->
case writeArray# marr n v s1 of { s2 ->
next s2 }}
done :: Ix ix => (ix,ix) -> MutableArray# s elt
-> STRep s (Array ix elt)
{-# INLINE done #-}
done ixs marr = \s1 -> case unsafeFreezeArray# marr s1 of { (# s2, arr #) ->
(# s2, Array ixs arr #) }
arrEleBottom :: a
arrEleBottom = error "(Array.!): undefined array element"
fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
fill_it_in arr lst
= foldr fill_one_in (return ()) lst
where -- **** STRICT **** (but that's OK...)
fill_one_in (i, v) rst
= writeArray arr i v >> rst
-----------------------------------------------------------------------
-- these also go better with magic: (//), accum, accumArray
......@@ -160,6 +156,13 @@ old_array // ivs
freezeArray arr
)
fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
fill_it_in arr lst
= foldr fill_one_in (return ()) lst
where -- **** STRICT **** (but that's OK...)
fill_one_in (i, v) rst
= writeArray arr i v >> rst
zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
-- zap_with_f: reads an elem out first, then uses "f" on that and the new value
......
This diff is collapsed.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[PrelBounded]{Module @PrelBounded@}
Instances of Bounded for various datatypes.
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module PrelBounded where
import PrelBase
instance Bounded () where
minBound = ()
maxBound = ()
instance Bounded Char where
minBound = '\0'
maxBound = '\255'
\end{code}
......@@ -56,7 +56,7 @@ data ThreadId = ThreadId ThreadId#
-- But since ThreadId# is unlifted, the Weak type must use open
-- type variables.
--forkIO has now been hoisted out into the concurrent library.
--forkIO has now been hoisted out into the Concurrent library.
killThread :: ThreadId -> IO ()
killThread (ThreadId id) = IO $ \ s ->
......@@ -97,7 +97,6 @@ par x y = case (par# x) of { 0# -> parError; _ -> y }
#else
par _ y = y
#endif
\end{code}
%************************************************************************
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
%
\section[PrelEither]{Module @PrelEither@}
The @Either@ Type.
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module PrelEither where
import PrelBase
data Either a b = Left a | Right b deriving (Eq, Ord, Show {- Read -} )
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f _ (Left x) = f x
either _ g (Right y) = g y
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[PrelBounded]{Module @PrelBounded@}
Instances of Bounded for various datatypes.
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module PrelEnum(
Bounded(..), Enum(..),
enumFromBounded, enumFromThenBounded,
-- Instances for Bounded and Eum: (), Char, Int
) where
import {-# SOURCE #-} PrelErr ( error )
import PrelBase
import PrelTup () -- To make sure we look for the .hi file
\end{code}
%*********************************************************
%* *
\subsection{Class declarations}
%* *
%*********************************************************
\begin{code}
class Bounded a where
minBound, maxBound :: a
class Enum a where
succ, pred :: a -> a
toEnum :: Int -> a
fromEnum :: a -> Int
enumFrom :: a -> [a] -- [n..]
enumFromThen :: a -> a -> [a] -- [n,n'..]
enumFromTo :: a -> a -> [a] -- [n..m]
enumFromThenTo :: a -> a -> a -> [a] -- [n,n'..m]
succ = toEnum . (`plusInt` oneInt) . fromEnum
pred = toEnum . (`minusInt` oneInt) . fromEnum
enumFromTo n m = map toEnum [fromEnum n .. fromEnum m]
enumFromThenTo n1 n2 m = map toEnum [fromEnum n1, fromEnum n2 .. fromEnum m]
-- Default methods for bounded enumerations
enumFromBounded :: (Enum a, Bounded a) => a -> [a]
enumFromBounded n = enumFromTo n maxBound
enumFromThenBounded :: (Enum a, Bounded a) => a -> a -> [a]
enumFromThenBounded n1 n2 = enumFromThenTo n1 n2 maxBound
\end{code}
%*********************************************************
%* *
\subsection{Tuples}
%* *
%*********************************************************
\begin{code}
instance Bounded () where
minBound = ()
maxBound = ()
instance Enum () where
succ x = error "Prelude.Enum.().succ: bad argment"
pred x = error "Prelude.Enum.().pred: bad argument"
toEnum x | x == zeroInt = ()
| otherwise = error "Prelude.Enum.().toEnum: bad argument"
fromEnum () = zeroInt
enumFrom () = [()]
enumFromThen () () = [()]
enumFromTo () () = [()]
enumFromThenTo () () () = [()]
\end{code}
\begin{code}
instance (Bounded a, Bounded b) => Bounded (a,b) where
minBound = (minBound, minBound)
maxBound = (maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where
minBound = (minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where
minBound = (minBound, minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound, maxBound)
\end{code}
%*********************************************************
%* *
\subsection{Type @Bool@}
%* *
%*********************************************************
\begin{code}
instance Bounded Bool where