Commit a943fcfe authored by sof's avatar sof
Browse files

[project @ 1997-11-24 20:04:49 by sof]

Misc changes to compile with new defns of ST, IO (and PrimIO)
parent 7417ce9a
......@@ -41,6 +41,10 @@ import ST
import ArrBase
import Maybe
# if __GLASGOW_HASKELL__ >= 209
import GlaExts ( thenST, returnST )
# endif
#else
#define ARR_ELT (:=)
......
......@@ -60,6 +60,14 @@ import PrelBase ( Char (..) )
#if __GLASGOW_HASKELL__ >= 206
import PackBase
#endif
#if __GLASGOW_HASKELL__ >= 209
import Addr
import IORef
# define newVar newIORef
# define readVar readIORef
# define writeVar writeIORef
#endif
#endif
import PrimPacked
......@@ -179,26 +187,32 @@ data FastStringTable =
Int#
(MutableArray# _RealWorld [FastString])
#if __GLASGOW_HASKELL__ < 209
type FastStringTableVar = MutableVar _RealWorld FastStringTable
#else
type FastStringTableVar = IORef FastStringTable
#endif
string_table :: FastStringTableVar
string_table =
unsafePerformPrimIO (
newArray (0::Int,hASH_TBL_SIZE) [] `thenPrimIO` \ (_MutableArray _ arr#) ->
ST_TO_PrimIO (newArray (0::Int,hASH_TBL_SIZE) []) `thenPrimIO` \ (_MutableArray _ arr#) ->
newVar (FastStringTable 0# arr#))
lookupTbl :: FastStringTable -> Int# -> PrimIO [FastString]
lookupTbl (FastStringTable _ arr#) i# =
MkST ( \ (S# s#) ->
ST_TO_PrimIO (
MkST ( \ STATE_TOK(s#) ->
case readArray# arr# i# s# of { StateAndPtr# s2# r ->
(r, S# s2#) })
ST_RET(r, STATE_TOK(s2#)) }))
updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> PrimIO ()
updTbl (_MutableArray _ var#) (FastStringTable uid# arr#) i# ls =
MkST ( \ (S# s#) ->
updTbl ref (FastStringTable uid# arr#) i# ls =
ST_TO_PrimIO (
MkST ( \ STATE_TOK(s#) ->
case writeArray# arr# i# ls s# of { s2# ->
case writeArray# var# 0# (FastStringTable (uid# +# 1#) arr#) s2# of { s3# ->
((), S# s3#) }})
ST_RET((), STATE_TOK(s2#)) })) `thenPrimIO` \ _ ->
writeVar ref (FastStringTable (uid# +# 1#) arr#)
mkFastString# :: Addr# -> Int# -> FastString
mkFastString# a# len# =
......
......@@ -35,6 +35,10 @@ module Outputable (
#if __GLASGOW_HASKELL__ >= 202
import IO
import GlaExts
# if __GLASGOW_HASKELL__ >= 209
import Addr
# endif
#else
import Ubiq ( Uniquable(..), Unique, Name ) -- FastString mentions it; todo: rm
......
......@@ -52,6 +52,10 @@ import PrelBase ( Char(..) )
import PackBase
# endif
# if __GLASGOW_HASKELL__ >= 209
import Addr
# endif
#endif
\end{code}
......@@ -73,21 +77,19 @@ Copying a char string prefix into a byte array,
NULs.
\begin{code}
copyPrefixStr :: _Addr -> Int -> _ByteArray Int
copyPrefixStr (A# a) len@(I# length#) =
unsafePerformPrimIO (
unsafePerformST (
{- allocate an array that will hold the string
(not forgetting the NUL at the end)
-}
(new_ps_array (length# +# 1#)) `thenPrimIO` \ ch_array ->
{- Revert back to Haskell-only solution for the moment.
_ccall_ memcpy ch_array (A# a) len `thenPrimIO` \ () ->
write_ps_array ch_array length# (chr# 0#) `seqPrimIO`
-}
new_ps_array (length# +# 1#) `thenStrictlyST` \ ch_array ->
-- fill in packed string from "addr"
fill_in ch_array 0# `seqPrimIO`
fill_in ch_array 0# `thenStrictlyST` \ _ ->
-- freeze the puppy:
freeze_ps_array ch_array)
freeze_ps_array ch_array `thenStrictlyST` \ barr ->
returnStrictlyST barr )
where
fill_in :: _MutableByteArray s Int -> Int# -> _ST s ()
......@@ -119,7 +121,7 @@ Copying a sub-string out of a ForeignObj
\begin{code}
copySubStrFO :: _ForeignObj -> Int -> Int -> _ByteArray Int
copySubStrFO (_ForeignObj fo) (I# start#) len@(I# length#) =
unsafePerformPrimIO (
unsafePerformST (
{- allocate an array that will hold the string
(not forgetting the NUL at the end)
-}
......@@ -159,7 +161,7 @@ addrOffset# a# i# =
copySubStrBA :: _ByteArray Int -> Int -> Int -> _ByteArray Int
copySubStrBA (_ByteArray _ barr#) (I# start#) len@(I# length#) =
unsafePerformPrimIO (
unsafePerformST (
{- allocate an array that will hold the string
(not forgetting the NUL at the end)
-}
......@@ -190,20 +192,20 @@ write_ps_array :: _MutableByteArray s Int -> Int# -> Char# -> _ST s ()
freeze_ps_array :: _MutableByteArray s Int -> _ST s (_ByteArray Int)
new_ps_array size =
MkST ( \ (S# s) ->
case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# ->
(_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, S# s2#)})
MkST ( \ STATE_TOK(s#) ->
case (newCharArray# size s#) of { StateAndMutableByteArray# s2# barr# ->
ST_RET(_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, STATE_TOK(s2#))})
write_ps_array (_MutableByteArray _ barr#) n ch =
MkST ( \ (S# s#) ->
MkST ( \ STATE_TOK(s#) ->
case writeCharArray# barr# n ch s# of { s2# ->
((), S# s2#)})
ST_RET((), STATE_TOK(s2#) )})
-- same as unsafeFreezeByteArray
freeze_ps_array (_MutableByteArray ixs arr#) =
MkST ( \ (S# s#) ->
MkST ( \ STATE_TOK(s#) ->
case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
(_ByteArray ixs frozen#, S# s2#) })
ST_RET((_ByteArray ixs frozen#), STATE_TOK(s2#))})
\end{code}
Compare two equal-length strings for equality:
......
......@@ -47,7 +47,7 @@ type SST s r = State# s -> SST_R s r
sstToST :: SST s r -> ST s r
stToSST :: ST s r -> SST s r
#if __GLASGOW_HASKELL__ >= 200
#if __GLASGOW_HASKELL__ >= 200 && __GLASGOW_HASKELL__ < 209
sstToST sst = ST $ \ (S# s) ->
case sst s of SST_R r s' -> (r, S# s')
......@@ -55,6 +55,14 @@ sstToST sst = ST $ \ (S# s) ->
stToSST (ST st) = \ s ->
case st (S# s) of (r, S# s') -> SST_R r s'
#elif __GLASGOW_HASKELL__ >= 209
sstToST sst = ST $ \ s ->
case sst s of SST_R r s' -> STret s' r
stToSST (ST st) = \ s ->
case st s of STret s' r -> SST_R r s'
#else
sstToST sst (S# s)
= case sst s of SST_R r s' -> (r, S# s')
......
......@@ -78,6 +78,9 @@ import PrelBase ( Char(..) )
# if __GLASGOW_HASKELL__ >= 206
import PackBase
# endif
# if __GLASGOW_HASKELL__ >= 209
import Addr
# endif
#endif
import PrimPacked
import FastString
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment