summaryrefslogtreecommitdiff
path: root/compiler/utils/FastFunctions.lhs
diff options
context:
space:
mode:
authorIsaac Dupree <id@isaac.cedarswampstudios.org>2008-01-17 01:13:12 +0000
committerIsaac Dupree <id@isaac.cedarswampstudios.org>2008-01-17 01:13:12 +0000
commit206b4dec78250efef3cd927d64dc6cbc54a16c3d (patch)
tree5c922e32a60500a0935e4bf378bb0bdd7819fef0 /compiler/utils/FastFunctions.lhs
parent1286da96dc65faa5992a8a34c5b3bf29dfe2be04 (diff)
downloadhaskell-206b4dec78250efef3cd927d64dc6cbc54a16c3d.tar.gz
lots of portability changes (#1405)
re-recording to avoid new conflicts was too hard, so I just put it all in one big patch :-( (besides, some of the changes depended on each other.) Here are what the component patches were: Fri Dec 28 11:02:55 EST 2007 Isaac Dupree <id@isaac.cedarswampstudios.org> * document BreakArray better Fri Dec 28 11:39:22 EST 2007 Isaac Dupree <id@isaac.cedarswampstudios.org> * properly ifdef BreakArray for GHCI Fri Jan 4 13:50:41 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * change ifs on __GLASGOW_HASKELL__ to account for... (#1405) for it not being defined. I assume it being undefined implies a compiler with relatively modern libraries but without most unportable glasgow extensions. Fri Jan 4 14:21:21 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * MyEither-->EitherString to allow Haskell98 instance Fri Jan 4 16:13:29 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * re-portabilize Pretty, and corresponding changes Fri Jan 4 17:19:55 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * Augment FastTypes to be much more complete Fri Jan 4 20:14:19 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * use FastFunctions, cleanup FastString slightly Fri Jan 4 21:00:22 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * Massive de-"#", mostly Int# --> FastInt (#1405) Fri Jan 4 21:02:49 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * miscellaneous unnecessary-extension-removal Sat Jan 5 19:30:13 EST 2008 Isaac Dupree <id@isaac.cedarswampstudios.org> * add FastFunctions
Diffstat (limited to 'compiler/utils/FastFunctions.lhs')
-rw-r--r--compiler/utils/FastFunctions.lhs80
1 files changed, 80 insertions, 0 deletions
diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs
new file mode 100644
index 0000000000..5d8ff23dbd
--- /dev/null
+++ b/compiler/utils/FastFunctions.lhs
@@ -0,0 +1,80 @@
+Z%
+% (c) The University of Glasgow, 2000-2006
+%
+\section{Fast functions}
+
+\begin{code}
+
+module FastFunctions (
+ unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO,
+ indexWord8OffFastPtr,
+ indexWord8OffFastPtrAsFastChar, indexWord8OffFastPtrAsFastInt,
+ global, Global
+ ) where
+
+#define COMPILING_FAST_STRING
+#include "HsVersions.h"
+
+import FastTypes
+import Data.IORef
+import System.IO.Unsafe
+
+#if defined(__GLASGOW_HASKELL__)
+
+import GHC.Exts
+import GHC.Word
+import GHC.IOBase (IO(..))
+--why not import it at __GLASGOW_HASKELL__==606 ?
+#if __GLASGOW_HASKELL__ >= 607
+import GHC.IOBase (unsafeDupableInterleaveIO)
+#endif
+import GHC.Base (unsafeChr)
+
+#if __GLASGOW_HASKELL__ < 607
+unsafeDupableInterleaveIO :: IO a -> IO a
+unsafeDupableInterleaveIO = unsafeInterleaveIO
+#endif
+
+-- Just like unsafePerformIO, but we inline it.
+{-# INLINE inlinePerformIO #-}
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+
+indexWord8OffFastPtr p i = W8# (indexWord8OffAddr# p i)
+indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
+indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
+-- or ord# (indexCharOffAddr# p i)
+
+#else /* ! __GLASGOW_HASKELL__ */
+
+import Foreign.Ptr
+import Data.Word
+
+-- hey, no harm inlining it, :-P
+{-# INLINE inlinePerformIO #-}
+inlinePerformIO :: IO a -> a
+inlinePerformIO = unsafePerformIO
+
+unsafeDupableInterleaveIO :: IO a -> IO a
+unsafeDupableInterleaveIO = unsafeInterleaveIO
+
+-- truly, these functions are unsafe: they assume
+-- a certain immutability of the pointer's target area.
+indexWord8OffFastPtr p i = inlinePerformIO (peekByteOff p n) :: Word8
+indexWord8OffFastPtrAsFastInt p i =
+ iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8))
+indexWord8OffFastPtrAsFastChar p i =
+ fastChr (iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8)))
+
+#endif /* ! __GLASGOW_HASKELL__ */
+
+--just so we can refer to the type clearly in a macro
+type Global a = IORef a
+global :: a -> Global a
+global a = unsafePerformIO (newIORef a)
+
+indexWord8OffFastPtr :: FastPtr Word8 -> FastInt -> Word8
+indexWord8OffFastPtrAsFastChar :: FastPtr Word8 -> FastInt -> FastChar
+indexWord8OffFastPtrAsFastInt :: FastPtr Word8 -> FastInt -> FastInt
+
+\end{code}