[project @ 1997-05-19 00:12:10 by sof]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixPrim.lhs

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index d8e1bf6..ad04c1d 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -7,15 +7,19 @@
 
 module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
 
-import Ubiq{-uitous-}
-import NcgLoop         -- paranoia checking only
+IMP_Ubiq(){-uitous-}
+IMPORT_DELOOPER(NcgLoop)               -- paranoia checking only
 
 import MachMisc
+#if __GLASGOW_HASKELL__ >= 202
+import MachRegs hiding (Addr)
+#else
 import MachRegs
+#endif
 
 import AbsCSyn
 import AbsCUtils       ( getAmodeRep, mixedTypeLocn )
-import CgCompInfo      ( spARelToInt, spBRelToInt )
+import Constants       ( spARelToInt, spBRelToInt )
 import CostCentre      ( noCostCentreAttached )
 import HeapOffs                ( hpRelToInt, subOff )
 import Literal         ( Literal(..) )
@@ -27,11 +31,15 @@ import OrdList              ( OrdList )
 import PprStyle                ( PprStyle(..) )
 import SMRep           ( SMRep(..), SMSpecRepKind, SMUpdateKind )
 import Stix
-import StixMacro       ( heapCheck, smStablePtrTable )
+import StixMacro       ( heapCheck )
 import StixInteger     {- everything -}
-import UniqSupply      ( returnUs, thenUs, UniqSM(..) )
-import Unpretty                ( uppBeside, uppPStr, uppInt )
+import UniqSupply      ( returnUs, thenUs, SYN_IE(UniqSM) )
+import Pretty          ( (<>), ptext, int )
 import Util            ( panic )
+
+#ifdef REALLY_HASKELL_1_3
+ord = fromEnum :: Char -> Int
+#endif
 \end{code}
 
 The main honcho here is primCode, which handles the guts of COpStmts.
@@ -52,7 +60,7 @@ First, the dreaded @ccall@.  We can't handle @casm@s.
 Usually, this compiles to an assignment, but when the left-hand side
 is empty, we just perform the call and ignore the result.
 
-ToDo ADR: modify this to handle Malloc Ptrs.
+ToDo ADR: modify this to handle ForeignObjs.
 
 btw Why not let programmer use casm to provide assembly code instead
 of C code?  ADR
@@ -229,7 +237,7 @@ primCode [lhs] ReadArrayOp [obj, ix]
     in
     returnUs (\xs -> assign : xs)
 
-primCode [lhs] WriteArrayOp [obj, ix, v]
+primCode [] WriteArrayOp [obj, ix, v]
   = let
        obj' = amodeToStix obj
        ix' = amodeToStix ix
@@ -414,7 +422,7 @@ primCode lhs (CCallOp fn is_asm may_gc arg_tys result_ty) rhs
            case getAmodeRep x of
              ArrayRep -> StIndex PtrRep base mutHS
              ByteArrayRep -> StIndex IntRep base dataHS
-             MallocPtrRep -> error "ERROR: native-code generator can't handle Malloc Ptrs (yet): use -fvia-C!"
+             ForeignObjRep -> error "ERROR: native-code generator can't handle ForeignObjs (yet): use -fvia-C!"
              _ -> base
 \end{code}
 
@@ -465,7 +473,7 @@ simplePrim [lhs] op rest
               ReturnsPrim pk -> pk
               _ -> simplePrim_error op
 
-simplePrim _ op _ = simplePrim_error op
+simplePrim as op bs = simplePrim_error op
 
 simplePrim_error op
     = error ("ERROR: primitive operation `"++showPrimOp PprDebug op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
@@ -519,7 +527,7 @@ amodeToStix (CTableEntry base off pk)
  -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 
 amodeToStix (CCharLike (CLit (MachChar c)))
-  = StLitLbl (uppBeside (uppPStr SLIT("CHARLIKE_closures+")) (uppInt off))
+  = StLitLbl ((<>) (ptext SLIT("CHARLIKE_closures+")) (int off))
   where
     off = charLikeSize * ord c