[project @ 1997-07-05 03:02:04 by sof]

[ghc-hetmet.git] / ghc / compiler / parser / UgenUtil.lhs

diff --git a/ghc/compiler/parser/UgenUtil.lhs b/ghc/compiler/parser/UgenUtil.lhs
index 7018511..11f6c59 100644 (file)
--- a/ghc/compiler/parser/UgenUtil.lhs
+++ b/ghc/compiler/parser/UgenUtil.lhs
@@ -9,16 +9,35 @@ module UgenUtil (
        returnPrimIO, thenPrimIO,
 
        -- stuff defined here
-       UgenUtil..
+       EXP_MODULE(UgenUtil)
     ) where
 
-import PreludeGlaST
-
-import Ubiq
+IMP_Ubiq()
 
-import MainMonad       ( MainIO(..) )          
-import Name            ( RdrName(..) )
-import SrcLoc          ( mkSrcLoc2, mkUnknownSrcLoc )
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+import PreludeGlaST
+#else
+import GlaExts
+import Name
+#endif
+
+#if __GLASGOW_HASKELL__ == 201
+# define ADDR      GHCbase.Addr
+# define PACK_STR   packCString
+# define PACK_BYTES packCBytes
+#elif __GLASGOW_HASKELL >= 202
+# define ADDR       GHC.Addr
+# define PACK_STR   mkFastCharString
+# define PACK_BYTES mkFastCharString2
+#else
+# define ADDR      _Addr
+# define PACK_STR   mkFastCharString
+# define PACK_BYTES mkFastCharString2
+#endif
+
+import RdrHsSyn                ( RdrName(..) )
+import BasicTypes      ( IfaceFlavour )
+import SrcLoc          ( mkSrcLoc, noSrcLoc, SrcLoc )
 \end{code}
 
 \begin{code}
@@ -35,20 +54,27 @@ thenUgn x y stuff
   = x stuff    `thenPrimIO` \ z ->
     y z stuff
 
-initUgn :: UgnM a -> MainIO a
+initUgn :: UgnM a -> IO a
 initUgn action
-  = action (SLIT(""),SLIT(""),mkUnknownSrcLoc) `thenPrimIO` \ result ->
+  = let
+       do_it = action (SLIT(""),SLIT(""),noSrcLoc)
+    in
+#if __GLASGOW_HASKELL__ >= 200
+    primIOToIO do_it
+#else
+    do_it      `thenPrimIO` \ result ->
     return result
+#endif
 
 ioToUgnM :: PrimIO a -> UgnM a
 ioToUgnM x stuff = x
 \end{code}
 
 \begin{code}
-type ParseTree = _Addr
+type ParseTree = ADDR
 
-type U_VOID_STAR = _Addr
-rdU_VOID_STAR ::  _Addr -> UgnM U_VOID_STAR
+type U_VOID_STAR = ADDR
+rdU_VOID_STAR ::  ADDR -> UgnM U_VOID_STAR
 rdU_VOID_STAR x = returnUgn x
 
 type U_long = Int
@@ -56,22 +82,20 @@ rdU_long ::  Int -> UgnM U_long
 rdU_long x = returnUgn x
 
 type U_stringId = FAST_STRING
-rdU_stringId :: _Addr -> UgnM U_stringId
+rdU_stringId :: ADDR -> UgnM U_stringId
 {-# INLINE rdU_stringId #-}
-rdU_stringId s
-  = -- ToDo (sometime): ioToUgnM (_ccall_ hash_index s) `thenUgn` \ (I# i) ->
-    returnUgn (_packCString s)
+rdU_stringId s = returnUgn (PACK_STR s)
 
 type U_numId = Int -- ToDo: Int
-rdU_numId :: _Addr -> UgnM U_numId
+rdU_numId :: ADDR -> UgnM U_numId
 rdU_numId i = rdU_stringId i `thenUgn` \ y -> returnUgn ((read (_UNPK_ y))::Int)
 
 type U_hstring = FAST_STRING
-rdU_hstring :: _Addr -> UgnM U_hstring
+rdU_hstring :: ADDR -> UgnM U_hstring
 rdU_hstring x
   = ioToUgnM (_ccall_ get_hstring_len   x)  `thenUgn` \ len ->
     ioToUgnM (_ccall_ get_hstring_bytes x)  `thenUgn` \ bytes ->
-    returnUgn (_packCBytes len bytes)
+    returnUgn (PACK_BYTES bytes len)
 \end{code}
 
 \begin{code}
@@ -91,7 +115,7 @@ mkSrcLocUgn :: U_long -> (SrcLoc -> UgnM a) -> UgnM a
 mkSrcLocUgn ln action (file,mod,_)
   = action loc (file,mod,loc)
   where
-    loc = mkSrcLoc2 file ln
+    loc = mkSrcLoc file ln
 
 getSrcLocUgn :: UgnM SrcLoc
 getSrcLocUgn stuff@(file,mod,loc) = returnUgn loc stuff