Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
27c1aa88
Commit
27c1aa88
authored
Mar 14, 1997
by
sof
Browse files
[project @ 1997-03-14 05:24:14 by sof]
OGI changes through 130397
parent
3c44399a
Changes
3
Hide whitespace changes
Inline
Side-by-side
ghc/lib/glaExts/Foreign.lhs
View file @
27c1aa88
...
...
@@ -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#
...
...
ghc/lib/glaExts/PackedString.lhs
View file @
27c1aa88
...
...
@@ -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)
p
ack
Byte
sForC
ST :: [Char] -> ST s (ByteArray Int)
p
ack
Byte
sForC
ST str =
p
sTo
Byte
Array
ST :: [Char] -> ST s (ByteArray Int)
p
sTo
Byte
Array
ST 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}
ghc/lib/glaExts/ST.lhs
View file @
27c1aa88
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment