%
\begin{code}
-#include "HsVersions.h"
-
module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(NcgLoop) -- paranoia checking only
+#include "HsVersions.h"
import MachMisc
import MachRegs
)
import PrimRep ( PrimRep(..), isFloatingRep )
import OrdList ( OrdList )
-import PprStyle ( PprStyle(..) )
import SMRep ( SMRep(..), SMSpecRepKind, SMUpdateKind )
import Stix
import StixMacro ( heapCheck )
import StixInteger {- everything -}
-import UniqSupply ( returnUs, thenUs, SYN_IE(UniqSM) )
-import Unpretty ( uppBeside, uppPStr, uppInt )
-import Util ( panic )
+import UniqSupply ( returnUs, thenUs, UniqSM )
+import Outputable
#ifdef REALLY_HASKELL_1_3
ord = fromEnum :: Char -> Int
in
returnUs (\xs -> assign : xs)
-primCode [lhs] WriteArrayOp [obj, ix, v]
+primCode [] WriteArrayOp [obj, ix, v]
= let
obj' = amodeToStix obj
ix' = amodeToStix ix
in
returnUs (\xs -> assign : xs)
+primCode [lhs] (IndexOffForeignObjOp pk) [obj, ix]
+ = let
+ lhs' = amodeToStix lhs
+ obj' = amodeToStix obj
+ ix' = amodeToStix ix
+ obj'' = StIndex PtrRep obj' foHS
+ assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
+ in
+ returnUs (\xs -> assign : xs)
+
primCode [] (WriteByteArrayOp pk) [obj, ix, v]
= let
obj' = amodeToStix obj
let base = amodeToStix' x
in
case getAmodeRep x of
- ArrayRep -> StIndex PtrRep base mutHS
- ByteArrayRep -> StIndex IntRep base dataHS
- ForeignObjRep -> error "ERROR: native-code generator can't handle ForeignObjs (yet): use -fvia-C!"
+ ArrayRep -> StIndex PtrRep base mutHS
+ ByteArrayRep -> StIndex IntRep base dataHS
+ ForeignObjRep -> StIndex PtrRep base foHS
+ {-error "ERROR: native-code generator can't handle ForeignObjs (yet): use -fvia-C!"-}
_ -> base
\end{code}
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")
+ = error ("ERROR: primitive operation `"++showPrimOp 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")
\end{code}
%---------------------------------------------------------------------
-- 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
flushStderr = StCall SLIT("fflush") VoidRep [StLitLit SLIT("stderr")]
errorIO = StJump (StInd PtrRep (sStLitLbl SLIT("ErrorIO_innards")))
\end{code}
-