From 27c1aa882a537f27417bd14a27c7dac4be0ddbc3 Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 14 Mar 1997 05:24:15 +0000 Subject: [PATCH] [project @ 1997-03-14 05:24:14 by sof] OGI changes through 130397 --- ghc/lib/glaExts/Foreign.lhs | 3 ++- ghc/lib/glaExts/PackedString.lhs | 35 ++++++++++++++++++----------------- ghc/lib/glaExts/ST.lhs | 30 ++++++++++++++++++++++++++---- 3 files changed, 46 insertions(+), 22 deletions(-) diff --git a/ghc/lib/glaExts/Foreign.lhs b/ghc/lib/glaExts/Foreign.lhs index 88b200b..8273434 100644 --- a/ghc/lib/glaExts/Foreign.lhs +++ b/ghc/lib/glaExts/Foreign.lhs @@ -9,6 +9,7 @@ module Foreign ( module Foreign, + ForeignObj(..), Addr, Word ) where @@ -74,7 +75,7 @@ instance CReturnable () -- Why, exactly? %********************************************************* \begin{code} -data ForeignObj = ForeignObj ForeignObj# +--Defined in PrelBase: data ForeignObj = ForeignObj ForeignObj# instance CCallable ForeignObj instance CCallable ForeignObj# diff --git a/ghc/lib/glaExts/PackedString.lhs b/ghc/lib/glaExts/PackedString.lhs index 2159874..81521d4 100644 --- a/ghc/lib/glaExts/PackedString.lhs +++ b/ghc/lib/glaExts/PackedString.lhs @@ -11,15 +11,17 @@ Glorious hacking (all the hard work) by Bryan O'Sullivan. {-# OPTIONS -fno-implicit-prelude #-} module PackedString ( + PackedString, -- abstract - packString, -- :: [Char] -> PackedString - packStringST, -- :: [Char] -> ST s PackedString - nilPS, -- :: PackedString - consPS, -- :: Char -> PackedString -> PackedString + -- Creating the beasts + packString, -- :: [Char] -> PackedString + packStringST, -- :: [Char] -> ST s PackedString byteArrayToPS, -- :: ByteArray Int -> PackedString unsafeByteArrayToPS, -- :: ByteArray a -> Int -> PackedString + psToByteArray, -- :: PackedString -> ByteArray Int + psToByteArrayST, -- :: PackedString -> ST s (ByteArray Int) unpackPS, -- :: PackedString -> [Char] {-LATER: @@ -27,6 +29,8 @@ module PackedString ( putPS, -- :: FILE -> PackedString -> PrimIO () -- ToDo: more sensible type getPS, -- :: FILE -> Int -> PrimIO PackedString -} + nilPS, -- :: PackedString + consPS, -- :: Char -> PackedString -> PackedString headPS, -- :: PackedString -> Char tailPS, -- :: PackedString -> PackedString nullPS, -- :: PackedString -> Bool @@ -63,7 +67,7 @@ module PackedString ( comparePS, - -- Converting to C strings + -- Converting to C strings packCString#, unpackCString#, unpackCString2#, unpackAppendCString#, unpackFoldrCString#, packCBytesST, unpackCString @@ -76,6 +80,7 @@ import STBase import ArrBase import PrelBase import GHC + \end{code} %************************************************************************ @@ -763,9 +768,6 @@ char_pos_that_dissatisfies p ps len pos char_pos_that_dissatisfies p ps len (pos +# 1#) | otherwise = pos -- predicate not satisfied -char_pos_that_dissatisfies p ps len pos -- dead code: HACK to avoid badly-typed error msg - = 0# - first_char_pos_that_satisfies :: (Char# -> Bool) -> PackedString -> Int# -> Int# -> Int# first_char_pos_that_satisfies p ps len pos | pos >=# len = pos -- end @@ -987,7 +989,7 @@ unpackCString :: Addr -> [Char] -- to deal with literal strings packCString# :: [Char] -> ByteArray# unpackCString# :: Addr# -> [Char] -unpackCString2# :: Addr# -> Int -> [Char] +unpackCString2# :: Addr# -> Int# -> [Char] unpackAppendCString# :: Addr# -> [Char] -> [Char] unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a @@ -1000,20 +1002,20 @@ unpackCString# addr where unpack nh | ch `eqChar#` '\0'# = [] - | True = C# ch : unpack (nh +# 1#) + | otherwise = C# ch : unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh unpackCString2# addr len -- This one is called by the compiler to unpack literal strings with NULs in them; rare. - = unpackPS (packCBytes len (A# addr)) + = unpackPS (packCBytes (I# len) (A# addr)) unpackAppendCString# addr rest = unpack 0# where unpack nh | ch `eqChar#` '\0'# = rest - | True = C# ch : unpack (nh +# 1#) + | otherwise = C# ch : unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh @@ -1022,7 +1024,7 @@ unpackFoldrCString# addr f z where unpack nh | ch `eqChar#` '\0'# = z - | True = C# ch `f` unpack (nh +# 1#) + | otherwise = C# ch `f` unpack (nh +# 1#) where ch = indexCharOffAddr# addr nh @@ -1036,8 +1038,8 @@ cStringToPS (A# a#) = -- the easy one; we just believe the caller packBytesForC :: [Char] -> ByteArray Int packBytesForC str = psToByteArray (packString str) -packBytesForCST :: [Char] -> ST s (ByteArray Int) -packBytesForCST str = +psToByteArrayST :: [Char] -> ST s (ByteArray Int) +psToByteArrayST str = packStringST str >>= \ (PS bytes n has_null) -> --later? ASSERT(not has_null) return (ByteArray (0, I# (n -# 1#)) bytes) @@ -1074,6 +1076,5 @@ packCBytesST len@(I# length#) (A# addr) = = case (indexCharOffAddr# addr idx) of { ch -> write_ps_array arr_in# idx ch >> fill_in arr_in# (idx +# 1#) } -\end{code} - +\end{code} diff --git a/ghc/lib/glaExts/ST.lhs b/ghc/lib/glaExts/ST.lhs index fe03258..275b24e 100644 --- a/ghc/lib/glaExts/ST.lhs +++ b/ghc/lib/glaExts/ST.lhs @@ -6,13 +6,35 @@ \begin{code} {-# OPTIONS -fno-implicit-prelude #-} -module ST where +module ST ( + + -- ToDo: review this interface; I'm avoiding gratuitous changes for now + -- SLPJ Jan 97 + + + ST, + + -- ST is one, so you'll likely need some Monad bits + module Monad, + + thenST, seqST, returnST, listST, fixST, runST, unsafeInterleaveST, + mapST, mapAndUnzipST, + + MutableVar, + newVar, readVar, writeVar, sameVar, + + MutableArray, + newArray, readArray, writeArray, sameMutableArray + + ) where import IOBase ( error ) -- [Source not needed] import ArrBase import STBase import PrelBase ( Int, Bool, ($), ()(..) ) -import GHC ( newArray#, readArray#, writeArray#, sameMutableArray# ) +import GHC ( newArray#, readArray#, writeArray#, sameMutableArray#, sameMutableByteArray# ) +import Monad + \end{code} %********************************************************* @@ -22,7 +44,7 @@ import GHC ( newArray#, readArray#, writeArray#, sameMutableArray# ) %********************************************************* \begin{code} -type MutableVar s a = MutableArray s Int a +-- in ArrBase: type MutableVar s a = MutableArray s Int a newVar :: a -> ST s (MutableVar s a) readVar :: MutableVar s a -> ST s a @@ -48,7 +70,7 @@ sameVar (MutableArray _ var1#) (MutableArray _ var2#) \end{code} - +\begin{code} sameMutableArray :: MutableArray s ix elt -> MutableArray s ix elt -> Bool sameMutableByteArray :: MutableByteArray s ix -> MutableByteArray s ix -> Bool -- 1.7.10.4