Commit 94084171 authored by simonpj's avatar simonpj
Browse files

[project @ 2000-04-10 12:12:27 by simonpj]

Make it so that

(A) All modules imported by Prelude are PrelXXX modules,
    not library modules (notably Ix, Monad were culprits).

    This lines up with the Hugs story, and is more intuitive.

(B) All things needed implicitly by syntax (e.g. do-notation
    needs Monad) come from PrelXXX modules, even if they aren't
    visible when you say 'import Prelude'.

These changes simplify the story, and fix the 'looking for [boot]
interface for Ix' problem.


This change is not quite complete.  I'm committing it so
Simon can finish it off.
parent 9957de2f
......@@ -138,7 +138,6 @@ module Unique (
ordClassKey,
orderingTyConKey,
otherwiseIdKey,
packCStringIdKey,
parErrorIdKey,
parIdKey,
patErrorIdKey,
......@@ -618,7 +617,6 @@ irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
lexIdKey = mkPreludeMiscIdUnique 16
noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
packCStringIdKey = mkPreludeMiscIdUnique 19
parErrorIdKey = mkPreludeMiscIdUnique 20
parIdKey = mkPreludeMiscIdUnique 21
patErrorIdKey = mkPreludeMiscIdUnique 22
......
......@@ -52,7 +52,7 @@ import Type ( Type, UsageAnn, mkTyVarTy, isUnLiftedType, seqType )
import Literal ( Literal(MachStr), mkMachInt )
import PrimOp ( PrimOp )
import DataCon ( DataCon, dataConId )
import ThinAir ( unpackCStringId, unpackCString2Id, addr2IntegerId )
import ThinAir ( unpackCStringId, unpackCString2Id )
import VarSet
import Outputable
\end{code}
......
......@@ -23,7 +23,6 @@ import CoreUtils ( exprType, mkCoerce )
import Id ( Id, mkWildId )
import MkId ( mkCCallOpId, realWorldPrimId )
import Maybes ( maybeToBool )
import PrelInfo ( packStringForCId )
import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) )
import DataCon ( DataCon, splitProductType_maybe, dataConSourceArity, dataConWrapId )
import CallConv
......
......@@ -418,10 +418,10 @@ floatingClass_RDR = clsQual pREL_FLOAT_Name SLIT("Floating")
realFloatClass_RDR = clsQual pREL_FLOAT_Name SLIT("RealFloat")
-- Class Ix
ixClass_RDR = clsQual iX_Name SLIT("Ix")
range_RDR = varQual iX_Name SLIT("range")
index_RDR = varQual iX_Name SLIT("index")
inRange_RDR = varQual iX_Name SLIT("inRange")
ixClass_RDR = clsQual pREL_ARR_Name SLIT("Ix")
range_RDR = varQual pREL_ARR_Name SLIT("range")
index_RDR = varQual pREL_ARR_Name SLIT("index")
inRange_RDR = varQual pREL_ARR_Name SLIT("inRange")
-- Class CCallable and CReturnable
ccallableClass_RDR = clsQual pREL_GHC_Name SLIT("CCallable")
......
......@@ -17,8 +17,8 @@ module PrelMods
pREL_GHC, pREL_BASE, pREL_ADDR, pREL_STABLE,
pREL_IO_BASE, pREL_PACK, pREL_ERR, pREL_NUM, pREL_FLOAT, pREL_REAL,
pREL_GHC_Name, pRELUDE_Name, mONAD_Name, rATIO_Name,
iX_Name, mAIN_Name, pREL_MAIN_Name, pREL_ERR_Name,
pREL_GHC_Name, pRELUDE_Name,
mAIN_Name, pREL_MAIN_Name, pREL_ERR_Name,
pREL_BASE_Name, pREL_NUM_Name, pREL_LIST_Name,
pREL_TUP_Name, pREL_ADDR_Name, pREL_READ_Name,
pREL_PACK_Name, pREL_CONC_Name, pREL_IO_BASE_Name,
......@@ -57,9 +57,6 @@ pREL_ERR_Name = mkSrcModule "PrelErr"
pREL_REAL_Name = mkSrcModule "PrelReal"
pREL_FLOAT_Name = mkSrcModule "PrelFloat"
mONAD_Name = mkSrcModule "Monad"
rATIO_Name = mkSrcModule "Ratio"
iX_Name = mkSrcModule "Ix"
pREL_MAIN_Name = mkSrcModule "PrelMain"
mAIN_Name = mkSrcModule "Main"
iNT_Name = mkSrcModule "Int"
......
......@@ -12,7 +12,7 @@ module ThinAir (
-- mentioned. Subset of builtinNames.
-- Here are the thin-air Ids themselves
addr2IntegerId,
packStringForCId, unpackCStringId, unpackCString2Id,
unpackCStringId, unpackCString2Id,
unpackCStringAppendId, unpackCStringFoldrId,
foldrId, buildId,
......@@ -57,9 +57,6 @@ thinAirIdNames
-- Needed for converting literals to Integers (used in tidyCoreExpr)
(varQual pREL_NUM_Name SLIT("addr2Integer"), addr2IntegerIdKey)
-- String literals
, (varQual pREL_PACK_Name SLIT("packCString#"), packCStringIdKey)
-- Folds and builds; introduced by desugaring list comprehensions
, (varQual pREL_BASE_Name SLIT("unpackNBytes#"), unpackCString2IdKey)
, (varQual pREL_BASE_Name SLIT("unpackCString#"), unpackCStringIdKey)
......@@ -81,7 +78,6 @@ noRepStrIds = [unpackCString2Id, unpackCStringId]
addr2IntegerId = lookupThinAirId addr2IntegerIdKey
packStringForCId = lookupThinAirId packCStringIdKey
unpackCStringId = lookupThinAirId unpackCStringIdKey
unpackCString2Id = lookupThinAirId unpackCString2IdKey
unpackCStringAppendId = lookupThinAirId unpackCStringAppendIdKey
......
......@@ -43,7 +43,6 @@ import Name ( mkLocalName, tidyOccName, tidyTopName,
NamedThing(..), OccName
)
import TyCon ( TyCon, isDataTyCon )
import PrelInfo ( unpackCStringId, unpackCString2Id, addr2IntegerId )
import PrelRules ( builtinRules )
import Type ( Type,
isUnLiftedType,
......
......@@ -643,65 +643,13 @@ bracket_ before after m = do
Left e -> ioError e
\end{code}
%*********************************************************
%* *
\subsection{Standard IO}
%* *
%*********************************************************
The Prelude has from Day 1 provided a collection of common
IO functions. We define these here, but let the Prelude
export them.
\begin{code}
putChar :: Char -> IO ()
putChar c = hPutChar stdout c
putStr :: String -> IO ()
putStr s = hPutStr stdout s
putStrLn :: String -> IO ()
putStrLn s = do putStr s
putChar '\n'
print :: Show a => a -> IO ()
print x = putStrLn (show x)
getChar :: IO Char
getChar = hGetChar stdin
getLine :: IO String
getLine = hGetLine stdin
getContents :: IO String
getContents = hGetContents stdin
interact :: (String -> String) -> IO ()
interact f = do s <- getContents
putStr (f s)
readFile :: FilePath -> IO String
readFile name = openFile name ReadMode >>= hGetContents
writeFile :: FilePath -> String -> IO ()
writeFile name str = do
hdl <- openFile name WriteMode
hPutStr hdl str
hClose hdl
appendFile :: FilePath -> String -> IO ()
appendFile name str = do
hdl <- openFile name AppendMode
hPutStr hdl str
hClose hdl
readLn :: Read a => IO a
readLn = do l <- getLine
r <- readIO l
return r
\end{code}
%*********************************************************
%* *
\subsection{The HUGS version of IO
%* *
%*********************************************************
#else /* __HUGS__ */
......
......@@ -5,8 +5,6 @@
\section[Ix]{Module @Ix@}
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module Ix
(
Ix
......@@ -29,251 +27,11 @@ module Ix
-- Implementation checked wrt. Haskell 98 lib report, 1/99.
) where
#ifndef __HUGS__
import {-# SOURCE #-} PrelErr ( error )
import PrelTup
import PrelBase
import PrelList( null )
import PrelEnum
import PrelShow
import PrelNum
default()
\end{code}
%*********************************************************
%* *
\subsection{The @Ix@ class}
%* *
%*********************************************************
\begin{code}
class (Ord a) => Ix a where
range :: (a,a) -> [a]
index, unsafeIndex :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
-- 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}
%*********************************************************
%* *
\subsection{Instances of @Ix@}
%* *
%*********************************************************
\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
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
{-# INLINE range #-}
-- The INLINE stops the build in the RHS from getting inlined,
-- so that callers can fuse with the result of range
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = i - m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
{-# INLINE inRange #-}
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
----------------------------------------------------------------------
instance Ix Integer where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
----------------------------------------------------------------------
instance Ix Ordering where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
import Prelude
{-# INLINE unsafeIndex #-}
unsafeIndex (l,_) i = fromEnum i - fromEnum l
-- This module is empty, because Ix is defined in PrelArr.
-- Reason: it's needed internally in the Prelude.
-- This module serves solely to export it to the user.
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 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 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)]
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),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4)]
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),
i2 <- range (l2,u2),
i3 <- range (l3,u3),
i4 <- range (l4,u4),
i5 <- range (l5,u5)]
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}
%********************************************************
%* *
\subsection{Size of @Ix@ interval}
%* *
%********************************************************
The @rangeSize@ operator returns the number of elements
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) | 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}
\begin{code}
#else
-- This module is empty; Ix is currently defined in the prelude, but should
-- eventually be moved to this library file instead.
#endif
\end{code}
......@@ -4,8 +4,6 @@
\section[Monad]{Module @Monad@}
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
module Monad
( MonadPlus ( -- class context: Monad
mzero -- :: (MonadPlus m) => m a
......@@ -39,14 +37,7 @@ module Monad
, (=<<) -- :: (Monad m) => (a -> m b) -> m a -> m b
) where
#ifndef __HUGS__
import PrelList
import PrelTup
import PrelBase
import PrelMaybe ( Maybe(..) )
infixr 1 =<<
#endif
import Prelude
\end{code}
%*********************************************************
......@@ -80,32 +71,6 @@ instance MonadPlus Maybe where
%*********************************************************
\begin{code}
#ifdef __HUGS__
-- These functions are defined in the Prelude.
-- sequence :: Monad m => [m a] -> m [a]
-- sequence_ :: Monad m => [m a] -> m ()
-- mapM :: Monad m => (a -> m b) -> [a] -> m [b]
-- mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
#else
sequence :: Monad m => [m a] -> m [a]
{-# INLINE sequence #-}
sequence ms = foldr k (return []) ms
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
sequence_ :: Monad m => [m a] -> m ()
{-# INLINE sequence_ #-}
sequence_ ms = foldr (>>) (return ()) ms
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
{-# INLINE mapM #-}
mapM f as = sequence (map f as)
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
{-# INLINE mapM_ #-}
mapM_ f as = sequence_ (map f as)
#endif
guard :: MonadPlus m => Bool -> m ()
guard pred
| pred = return ()
......@@ -125,15 +90,6 @@ filterM predM (x:xs) = do
msum :: MonadPlus m => [m a] -> m a
{-# INLINE msum #-}
msum = foldr mplus mzero
#ifdef __HUGS__
-- This function is defined in the Prelude.
--(=<<) :: Monad m => (a -> m b) -> m a -> m b
#else
{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
#endif
\end{code}
......
......@@ -14,8 +14,9 @@ For byte-arrays see @PrelByteArr@.
module PrelArr where
import {-# SOURCE #-} PrelErr ( error )
import Ix
import PrelList (foldl)
import PrelEnum
import PrelNum
import PrelST
import PrelBase
import PrelAddr
......@@ -27,28 +28,241 @@ infixl 9 !, //
default ()
\end{code}
%*********************************************************
%* *
\subsection{The @Ix@ class}
%* *
%*********************************************************
\begin{code}
{-# SPECIALISE array :: (Int,Int) -> [(Int,b)] -> Array Int b #-}
array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
class (Ord a) => Ix a where
range :: (a,a) -> [a]
index, unsafeIndex :: (a,a) -> a -> Int
inRange :: (a,a) -> a -> Bool
-- 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}
{-# SPECIALISE (!) :: Array Int b -> Int -> b #-}
(!) :: (Ix a) => Array a b -> a -> b
{-# SPECIALISE (//) :: Array Int b -> [(Int,b)] -> Array Int b #-}
(//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
%*********************************************************
%* *
\subsection{Instances of @Ix@}
%* *
%*********************************************************
{-# SPECIALISE accum :: (b -> c -> b) -> Array Int b -> [(Int,c)] -> Array Int b #-}
accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
\begin{code}
-- abstract these errors from the relevant index functions so that
-- the guts of the function will be small enough to inline.
{-# SPECIALISE accumArray :: (b -> c -> b) -> b -> (Int,Int) -> [(Int,c)] -> Array Int b #-}
accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
{-# 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) "")
bounds :: (Ix a) => Array a b -> (a,a)
assocs :: (Ix a) => Array a b -> [(a,b)]
indices :: (Ix a) => Array a b -> [a]
----------------------------------------------------------------------
instance Ix Char where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
{-# INLINE range #-}
-- The INLINE stops the build in the RHS from getting inlined,
-- so that callers can fuse with the result of range
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
unsafeIndex (m,_n) i = i - m
index b i | inRange b i = unsafeIndex b i
| otherwise = indexError b i "Int"
{-# INLINE inRange #-}
inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
----------------------------------------------------------------------
instance Ix Integer where
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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
----------------------------------------------------------------------
instance Ix Ordering where -- as derived
{-# INLINE range #-}
range (m,n) = [m..n]
{-# INLINE unsafeIndex #-}
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