getAmodeRep,
mixedTypeLocn, mixedPtrLocn,
flattenAbsC,
- mkAbsCStmtList
+ mkAbsCStmtList,
+ shimFCallArg
-- printing/forcing stuff comes from PprAbsC
) where
#include "HsVersions.h"
+#include "../includes/config.h"
import AbsCSyn
+import Type ( tyConAppTyCon, repType )
+import TysPrim ( foreignObjPrimTyCon, arrayPrimTyCon,
+ byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
+ mutableArrayPrimTyCon )
import CLabel ( mkMAP_FROZEN_infoLabel )
import Digraph ( stronglyConnComp, SCC(..) )
-import DataCon ( fIRST_TAG, ConTag )
+import DataCon ( fIRST_TAG, dataConTag )
import Literal ( literalPrimRep, mkMachWord, mkMachInt )
import PrimRep ( getPrimRepSize, PrimRep(..) )
import PrimOp ( PrimOp(..) )
import Unique ( Unique{-instance Eq-} )
import UniqSupply ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
UniqSupply )
-import CmdLineOpts ( opt_EmitCExternDecls )
-import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..),
- isDynamicTarget, isCasmTarget, defaultCCallConv )
-import StgSyn ( StgOp(..) )
+import CmdLineOpts ( opt_EmitCExternDecls, opt_Unregisterised )
+import ForeignCall ( ForeignCall(..), CCallSpec(..), isDynamicTarget )
+import StgSyn ( StgOp(..), stgArgType )
+import CoreSyn ( AltCon(..) )
import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
import Outputable
import Panic ( panic )
import FastTypes
-
-import Maybe ( isJust, maybeToList )
+import Constants ( wORD_SIZE, wORD_SIZE_IN_BITS )
infixr 9 `thenFlt`
\end{code}
\end{code}
\begin{code}
-mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC
+mkAlgAltsCSwitch :: CAddrMode -> [(AltCon, AbstractC)] -> AbstractC
-mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
- | isJust (nonemptyAbsC deflt_absc)
- = CSwitch scrutinee (adjust tagged_alts) deflt_absc
- | otherwise
- = CSwitch scrutinee (adjust rest) first_alt
+mkAlgAltsCSwitch scrutinee ((_,first_alt) : rest_alts)
+ = CSwitch scrutinee (adjust rest_alts) first_alt
where
- -- it's ok to convert one of the alts into a default if we don't already have
- -- one, because this is an algebraic case and we're guaranteed that the tag
- -- will match one of the branches.
- ((_,first_alt):rest) = tagged_alts
+ -- We use the first alt as the default. Either it *is* the DEFAULT,
+ -- (which is always first if present), or the case is exhaustive,
+ -- in which case we can use the first as the default anyway
-- Adjust the tags in the switch to start at zero.
-- This is the convention used by primitive ops which return algebraic
-- We also need to convert to Literals to keep the CSwitch happy
adjust tagged_alts
- = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c)
- | (tag, abs_c) <- tagged_alts ]
+ = [ (mkMachWord (toInteger (dataConTag dc - fIRST_TAG)), abs_c)
+ | (DataAlt dc, abs_c) <- tagged_alts ]
\end{code}
%************************************************************************
magicIdPrimRep (DoubleReg _) = DoubleRep
magicIdPrimRep (LongReg kind _) = kind
magicIdPrimRep Sp = PtrRep
-magicIdPrimRep Su = PtrRep
magicIdPrimRep SpLim = PtrRep
magicIdPrimRep Hp = PtrRep
magicIdPrimRep HpLim = PtrRep
magicIdPrimRep CurCostCentre = CostCentreRep
magicIdPrimRep VoidReg = VoidRep
-magicIdPrimRep CurrentTSO = ThreadIdRep
+magicIdPrimRep CurrentTSO = PtrRep
magicIdPrimRep CurrentNursery = PtrRep
+magicIdPrimRep HpAlloc = WordRep
\end{code}
%************************************************************************
getAmodeRep (CLit lit) = literalPrimRep lit
getAmodeRep (CMacroExpr kind _ _) = kind
getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint"
-getAmodeRep (CMem rep addr) = rep
\end{code}
@mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
returnFlt (mkAbsCStmts inline_s1 inline_s2,
mkAbsCStmts top_s1 top_s2)
-flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
- = flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) ->
- flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) ->
- returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
- CClosureInfoAndCode cl_info slow_heres fast_heres descr]
+flatAbsC (CClosureInfoAndCode cl_info entry)
+ = flatAbsC entry `thenFlt` \ (entry_heres, entry_tops) ->
+ returnFlt (AbsCNop, mkAbstractCs [entry_tops,
+ CClosureInfoAndCode cl_info entry_heres]
)
flatAbsC (CCodeBlock lbl abs_C)
returnFlt ( (tag, alt_heres), alt_tops )
flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _)
- | is_dynamic -- Emit a typedef if its a dynamic call
- || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls
+ | is_dynamic -- Emit a typedef if its a dynamic call
+ || (opt_EmitCExternDecls) -- or we want extern decls
= returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args)
where
is_dynamic = isDynamicTarget target
-- the TICKY_CTR macro always needs to be hoisted out to the top level.
-- This is a HACK.
flatAbsC stmt@(CCallProfCtrMacro str amodes)
- | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
+ | str == FSLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
| otherwise = returnFlt (stmt, AbsCNop)
-- Some statements need no flattening at all:
= COpStmt
[]
(StgFCallOp
- (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str)))
- defaultCCallConv PlaySafe))
+ (CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str)))
+ defaultCCallConv (PlaySafe False)))
uu
)
[CReg VoidReg]
-- Some statements only make sense at the top level, so we always float
-- them. This probably isn't necessary.
-flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
-flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CSRTDesc _ _ _ _ _) = returnFlt (AbsCNop, stmt)
+flatAbsC stmt@(CBitmap _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CRetVector _ _ _ _) = returnFlt (AbsCNop, stmt)
-flatAbsC stmt@(CModuleInitBlock _ _) = returnFlt (AbsCNop, stmt)
-\end{code}
-
-\begin{code}
-flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
-flat_maybe Nothing = returnFlt (Nothing, AbsCNop)
-flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
- returnFlt (Just heres, tops)
+flatAbsC stmt@(CModuleInitBlock _ _ _) = returnFlt (AbsCNop, stmt)
\end{code}
%************************************************************************
-- why it needs to take into account endianness.
--
mkHalfWord_HIADDR res arg
- = mkTemp IntRep `thenFlt` \ t_hw_shift ->
- mkTemp WordRep `thenFlt` \ t_hw_mask1 ->
+ = mkTemp WordRep `thenFlt` \ t_hw_mask1 ->
mkTemp WordRep `thenFlt` \ t_hw_mask2 ->
- let a_hw_shift
- = CMachOpStmt (Just t_hw_shift)
- MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing
+ let
+ hw_shift = mkIntCLit (wORD_SIZE_IN_BITS `quot` 2)
+
+# if WORDS_BIGENDIAN
a_hw_mask1
- = CMachOpStmt (Just t_hw_mask1)
- MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing
+ = CMachOpStmt t_hw_mask1
+ MO_Nat_Shl [CLit (mkMachWord 1), hw_shift] Nothing
a_hw_mask2
- = CMachOpStmt (Just t_hw_mask2)
+ = CMachOpStmt t_hw_mask2
MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing
final
-# if WORDS_BIGENDIAN
- = CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2,
- CMachOpStmt (Just res) MO_Nat_And [arg, t_hw_mask2] Nothing
+ = CSequential [ a_hw_mask1, a_hw_mask2,
+ CMachOpStmt res MO_Nat_And [arg, t_hw_mask2] Nothing
]
# else
- = CSequential [ a_hw_shift,
- CMachOpStmt (Just res) MO_Nat_Shr [arg, t_hw_shift] Nothing
- ]
+ final = CMachOpStmt res MO_Nat_Shr [arg, hw_shift] Nothing
# endif
in
returnFlt final
mkTemps = mapFlt mkTemp
-mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
-mkDerefOff rep base off
- | off == 0 -- optimisation
- = CMem rep base
- | otherwise
- = CMem rep (CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep))
-
-mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
-mkNoDerefOff rep base off
- = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep)
-
-- Sigh. This is done in 3 seperate places. Should be
-- commoned up (here, in pprAbsC of COpStmt, and presumably
-- somewhere in the NCG).
-- Helpers for translating various minor variants of array indexing.
+mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
+mkDerefOff rep base off
+ = CVal (CIndex base (CLit (mkMachInt (toInteger off))) rep) rep
+
+mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
+mkNoDerefOff rep base off
+ = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep)
+
+
+-- Generates an address as follows
+-- base + sizeof(machine_word)*offw + sizeof(rep)*idx
+mk_OSBI_addr :: Int -> PrimRep -> CAddrMode -> CAddrMode -> RegRelative
+mk_OSBI_addr offw rep base idx
+ = CIndex (CAddr (CIndex base idx rep))
+ (CLit (mkMachWord (fromIntegral offw)))
+ PtrRep
+
+mk_OSBI_ref :: Int -> PrimRep -> CAddrMode -> CAddrMode -> CAddrMode
+mk_OSBI_ref offw rep base idx
+ = CVal (mk_OSBI_addr offw rep base idx) rep
+
+
doIndexOffForeignObjOp maybe_post_read_cast rep res addr idx
- = mkBasicIndexedRead fixedHdrSize maybe_post_read_cast rep res addr idx
+ = mkBasicIndexedRead 0 maybe_post_read_cast rep res (mkDerefOff WordRep addr fixedHdrSize) idx
doIndexOffAddrOp maybe_post_read_cast rep res addr idx
= mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
mkBasicIndexedRead offw Nothing read_rep res base idx
= returnFlt (
- CMachOpStmt (Just res) (MO_ReadOSBI offw read_rep) [base,idx] Nothing
+ CAssign res (mk_OSBI_ref offw read_rep base idx)
)
mkBasicIndexedRead offw (Just cast_to_mop) read_rep res base idx
= mkTemp read_rep `thenFlt` \ tmp ->
(returnFlt . CSequential) [
- CMachOpStmt (Just tmp) (MO_ReadOSBI offw read_rep) [base,idx] Nothing,
- CMachOpStmt (Just res) cast_to_mop [tmp] Nothing
+ CAssign tmp (mk_OSBI_ref offw read_rep base idx),
+ CMachOpStmt res cast_to_mop [tmp] Nothing
]
mkBasicIndexedWrite offw Nothing write_rep base idx val
= returnFlt (
- CMachOpStmt Nothing (MO_WriteOSBI offw write_rep) [base,idx,val] Nothing
+ CAssign (mk_OSBI_ref offw write_rep base idx) val
)
mkBasicIndexedWrite offw (Just cast_to_mop) write_rep base idx val
= mkTemp write_rep `thenFlt` \ tmp ->
(returnFlt . CSequential) [
- CMachOpStmt (Just tmp) cast_to_mop [val] Nothing,
- CMachOpStmt Nothing (MO_WriteOSBI offw write_rep) [base,idx,tmp] Nothing
+ CMachOpStmt tmp cast_to_mop [val] Nothing,
+ CAssign (mk_OSBI_ref offw write_rep base idx) tmp
]
= mkTemp cast_arg1_to `thenFlt` \ arg1casted ->
(returnFlt . CSequential) [
CAssign arg1casted arg1,
- CMachOpStmt (Just res) mop [arg1casted,arg2]
+ CMachOpStmt res mop [arg1casted,arg2]
(if isDefinitelyInlineMachOp mop then Nothing else Just vols)
]
-getBitsPerWordMinus1 :: FlatM (AbstractC, CAddrMode)
-getBitsPerWordMinus1
- = mkTemps [IntRep, IntRep] `thenFlt` \ [t1,t2] ->
- returnFlt (
- CSequential [
- CMachOpStmt (Just t1) MO_Nat_Shl
- [CBytesPerWord, CLit (mkMachInt 3)] Nothing,
- CMachOpStmt (Just t2) MO_Nat_Sub
- [t1, CLit (mkMachInt 1)] Nothing
- ],
- t2
- )
+-- IA64 mangler doesn't place tables next to code
+tablesNextToCode :: Bool
+#ifdef ia64_TARGET_ARCH
+tablesNextToCode = False
+#else
+tablesNextToCode = not opt_Unregisterised
+#endif
------------------------------------------------------------------------------
c = t4 >>unsigned BITS_IN(I_)-1
-}
= mkTemps [IntRep,IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3,t4] ->
- getBitsPerWordMinus1 `thenFlt` \ (bpw1_code,bpw1_t) ->
+ let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
(returnFlt . CSequential) [
- CMachOpStmt (Just res_r) MO_Nat_Add [aa,bb] Nothing,
- CMachOpStmt (Just t1) MO_Nat_Xor [aa,bb] Nothing,
- CMachOpStmt (Just t2) MO_Nat_Not [t1] Nothing,
- CMachOpStmt (Just t3) MO_Nat_Xor [aa,res_r] Nothing,
- CMachOpStmt (Just t4) MO_Nat_And [t2,t3] Nothing,
- bpw1_code,
- CMachOpStmt (Just res_c) MO_Nat_Shr [t4, bpw1_t] Nothing
+ CMachOpStmt res_r MO_Nat_Add [aa,bb] Nothing,
+ CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
+ CMachOpStmt t2 MO_Nat_Not [t1] Nothing,
+ CMachOpStmt t3 MO_Nat_Xor [aa,res_r] Nothing,
+ CMachOpStmt t4 MO_Nat_And [t2,t3] Nothing,
+ CMachOpStmt res_c MO_Nat_Shr [t4, bpw1] Nothing
]
c = t3 >>unsigned BITS_IN(I_)-1
-}
= mkTemps [IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3] ->
- getBitsPerWordMinus1 `thenFlt` \ (bpw1_code,bpw1_t) ->
+ let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
(returnFlt . CSequential) [
- CMachOpStmt (Just res_r) MO_Nat_Add [aa,bb] Nothing,
- CMachOpStmt (Just t1) MO_Nat_Xor [aa,bb] Nothing,
- CMachOpStmt (Just t2) MO_Nat_Xor [aa,res_r] Nothing,
- CMachOpStmt (Just t3) MO_Nat_And [t2,t3] Nothing,
- bpw1_code,
- CMachOpStmt (Just res_c) MO_Nat_Shr [t3, bpw1_t] Nothing
+ CMachOpStmt res_r MO_Nat_Sub [aa,bb] Nothing,
+ CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
+ CMachOpStmt t2 MO_Nat_Xor [aa,res_r] Nothing,
+ CMachOpStmt t3 MO_Nat_And [t1,t2] Nothing,
+ CMachOpStmt res_c MO_Nat_Shr [t3, bpw1] Nothing
]
= mkTemp WordRep `thenFlt` \ w ->
(returnFlt . CSequential) [
CAssign w (mkDerefOff WordRep arg fixedHdrSize),
- CMachOpStmt (Just w)
- MO_NatU_Mul [w, CBytesPerWord] (Just vols),
+ CMachOpStmt w MO_NatU_Mul [w, mkIntCLit wORD_SIZE] (Just vols),
CAssign res w
]
dscCOpStmt [res] ByteArrayContents_Char [arg] vols
= mkTemp PtrRep `thenFlt` \ ptr ->
(returnFlt . CSequential) [
- CMachOpStmt (Just ptr) MO_NatU_to_NatP [arg] Nothing,
+ CMachOpStmt ptr MO_NatU_to_NatP [arg] Nothing,
CAssign ptr (mkNoDerefOff WordRep ptr arrWordsHdrSize),
CAssign res ptr
]
(returnFlt . CSequential) [
CAssign sn1 (mkDerefOff WordRep arg1 fixedHdrSize),
CAssign sn2 (mkDerefOff WordRep arg2 fixedHdrSize),
- CMachOpStmt (Just res) MO_Nat_Eq [sn1,sn2] Nothing
+ CMachOpStmt res MO_Nat_Eq [sn1,sn2] Nothing
+ ]
+
+dscCOpStmt [res] ReallyUnsafePtrEqualityOp [arg1,arg2] vols
+ = mkTemps [WordRep, WordRep] `thenFlt` \ [w1,w2] ->
+ (returnFlt . CSequential) [
+ CMachOpStmt w1 MO_NatP_to_NatU [arg1] Nothing,
+ CMachOpStmt w2 MO_NatP_to_NatU [arg2] Nothing,
+ CMachOpStmt res MO_Nat_Eq [w1,w2] Nothing{- because it's inline? -}
]
-- #define addrToHValuezh(r,a) r=(P_)a
(CAssign res arg)
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
+--
+-- In the unregisterised case, we don't attempt to compute the location
+-- of the tag halfword, just a macro. For this build, fixing on layout
+-- info has only got drawbacks.
+--
+-- Should this arrangement deeply offend you for some reason, code which
+-- computes the offset can be found below also.
+-- -- sof 3/02
+--
dscCOpStmt [res] DataToTagOp [arg] vols
+ | not tablesNextToCode
+ = returnFlt (CMacroStmt DATA_TO_TAGZH [res,arg])
+ | otherwise
= mkTemps [PtrRep, WordRep] `thenFlt` \ [t_infoptr, t_theword] ->
mkHalfWord_HIADDR res t_theword `thenFlt` \ select_ops ->
(returnFlt . CSequential) [
CAssign t_infoptr (mkDerefOff PtrRep arg 0),
+ {-
+ Get at the tag within the info table; two cases to consider:
+
+ - reversed info tables next to the entry point code;
+ one word above the end of the info table (which is
+ what t_infoptr is really pointing to).
+ - info tables with their entry points stored somewhere else,
+ which is how the unregisterised (nee TABLES_NEXT_TO_CODE)
+ world operates.
+
+ The t_infoptr points to the start of the info table, so add
+ the length of the info table & subtract one word.
+ -}
CAssign t_theword (mkDerefOff WordRep t_infoptr (-1)),
+{- UNUSED - see above comment.
+ (if opt_Unregisterised then
+ (fixedItblSize - 1)
+ else (-1))),
+-}
select_ops
]
dscCOpStmt [r] AddrRemOp [a1,a2] vols
= mkTemp WordRep `thenFlt` \ a1casted ->
(returnFlt . CSequential) [
- CMachOpStmt (Just a1casted) MO_NatP_to_NatU [a1] Nothing,
- CMachOpStmt (Just r) MO_NatU_Rem [a1casted,a2] Nothing
+ CMachOpStmt a1casted MO_NatP_to_NatU [a1] Nothing,
+ CMachOpStmt r MO_NatU_Rem [a1casted,a2] Nothing
]
-- not handled by translateOp because they need casts
dscCOpStmt [] WriteOffAddrOp_Word [a,i,x] vols = doWriteOffAddrOp Nothing WordRep a i x
dscCOpStmt [] WriteOffAddrOp_Addr [a,i,x] vols = doWriteOffAddrOp Nothing AddrRep a i x
dscCOpStmt [] WriteOffAddrOp_Float [a,i,x] vols = doWriteOffAddrOp Nothing FloatRep a i x
-dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing ForeignObjRep a i x
+dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing PtrRep a i x
dscCOpStmt [] WriteOffAddrOp_Double [a,i,x] vols = doWriteOffAddrOp Nothing DoubleRep a i x
dscCOpStmt [] WriteOffAddrOp_StablePtr [a,i,x] vols = doWriteOffAddrOp Nothing StablePtrRep a i x
-- Native word signless ops
-translateOp [r] IntAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2])
-translateOp [r] IntSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2])
-translateOp [r] WordAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2])
-translateOp [r] WordSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2])
-translateOp [r] AddrAddOp [a1,a2] = Just (Just r, MO_Nat_Add, [a1,a2])
-translateOp [r] AddrSubOp [a1,a2] = Just (Just r, MO_Nat_Sub, [a1,a2])
-
-translateOp [r] IntEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] IntNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2])
-translateOp [r] WordEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] WordNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2])
-translateOp [r] AddrEqOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] AddrNeOp [a1,a2] = Just (Just r, MO_Nat_Ne, [a1,a2])
-
-translateOp [r] AndOp [a1,a2] = Just (Just r, MO_Nat_And, [a1,a2])
-translateOp [r] OrOp [a1,a2] = Just (Just r, MO_Nat_Or, [a1,a2])
-translateOp [r] XorOp [a1,a2] = Just (Just r, MO_Nat_Xor, [a1,a2])
-translateOp [r] NotOp [a1] = Just (Just r, MO_Nat_Not, [a1])
+translateOp [r] IntAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2])
+translateOp [r] IntSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2])
+translateOp [r] WordAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2])
+translateOp [r] WordSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2])
+translateOp [r] AddrAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2])
+translateOp [r] AddrSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2])
+
+translateOp [r] IntEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] IntNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2])
+translateOp [r] WordEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] WordNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2])
+translateOp [r] AddrEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] AddrNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2])
+
+translateOp [r] AndOp [a1,a2] = Just (r, MO_Nat_And, [a1,a2])
+translateOp [r] OrOp [a1,a2] = Just (r, MO_Nat_Or, [a1,a2])
+translateOp [r] XorOp [a1,a2] = Just (r, MO_Nat_Xor, [a1,a2])
+translateOp [r] NotOp [a1] = Just (r, MO_Nat_Not, [a1])
-- Native word signed ops
-translateOp [r] IntMulOp [a1,a2] = Just (Just r, MO_NatS_Mul, [a1,a2])
-translateOp [r] IntMulMayOfloOp [a1,a2] = Just (Just r, MO_NatS_MulMayOflo, [a1,a2])
-translateOp [r] IntQuotOp [a1,a2] = Just (Just r, MO_NatS_Quot, [a1,a2])
-translateOp [r] IntRemOp [a1,a2] = Just (Just r, MO_NatS_Rem, [a1,a2])
-translateOp [r] IntNegOp [a1] = Just (Just r, MO_NatS_Neg, [a1])
+translateOp [r] IntMulOp [a1,a2] = Just (r, MO_NatS_Mul, [a1,a2])
+translateOp [r] IntMulMayOfloOp [a1,a2] = Just (r, MO_NatS_MulMayOflo, [a1,a2])
+translateOp [r] IntQuotOp [a1,a2] = Just (r, MO_NatS_Quot, [a1,a2])
+translateOp [r] IntRemOp [a1,a2] = Just (r, MO_NatS_Rem, [a1,a2])
+translateOp [r] IntNegOp [a1] = Just (r, MO_NatS_Neg, [a1])
-translateOp [r] IntGeOp [a1,a2] = Just (Just r, MO_NatS_Ge, [a1,a2])
-translateOp [r] IntLeOp [a1,a2] = Just (Just r, MO_NatS_Le, [a1,a2])
-translateOp [r] IntGtOp [a1,a2] = Just (Just r, MO_NatS_Gt, [a1,a2])
-translateOp [r] IntLtOp [a1,a2] = Just (Just r, MO_NatS_Lt, [a1,a2])
+translateOp [r] IntGeOp [a1,a2] = Just (r, MO_NatS_Ge, [a1,a2])
+translateOp [r] IntLeOp [a1,a2] = Just (r, MO_NatS_Le, [a1,a2])
+translateOp [r] IntGtOp [a1,a2] = Just (r, MO_NatS_Gt, [a1,a2])
+translateOp [r] IntLtOp [a1,a2] = Just (r, MO_NatS_Lt, [a1,a2])
-- Native word unsigned ops
-translateOp [r] WordGeOp [a1,a2] = Just (Just r, MO_NatU_Ge, [a1,a2])
-translateOp [r] WordLeOp [a1,a2] = Just (Just r, MO_NatU_Le, [a1,a2])
-translateOp [r] WordGtOp [a1,a2] = Just (Just r, MO_NatU_Gt, [a1,a2])
-translateOp [r] WordLtOp [a1,a2] = Just (Just r, MO_NatU_Lt, [a1,a2])
+translateOp [r] WordGeOp [a1,a2] = Just (r, MO_NatU_Ge, [a1,a2])
+translateOp [r] WordLeOp [a1,a2] = Just (r, MO_NatU_Le, [a1,a2])
+translateOp [r] WordGtOp [a1,a2] = Just (r, MO_NatU_Gt, [a1,a2])
+translateOp [r] WordLtOp [a1,a2] = Just (r, MO_NatU_Lt, [a1,a2])
-translateOp [r] WordMulOp [a1,a2] = Just (Just r, MO_NatU_Mul, [a1,a2])
-translateOp [r] WordQuotOp [a1,a2] = Just (Just r, MO_NatU_Quot, [a1,a2])
-translateOp [r] WordRemOp [a1,a2] = Just (Just r, MO_NatU_Rem, [a1,a2])
+translateOp [r] WordMulOp [a1,a2] = Just (r, MO_NatU_Mul, [a1,a2])
+translateOp [r] WordQuotOp [a1,a2] = Just (r, MO_NatU_Quot, [a1,a2])
+translateOp [r] WordRemOp [a1,a2] = Just (r, MO_NatU_Rem, [a1,a2])
-translateOp [r] AddrGeOp [a1,a2] = Just (Just r, MO_NatU_Ge, [a1,a2])
-translateOp [r] AddrLeOp [a1,a2] = Just (Just r, MO_NatU_Le, [a1,a2])
-translateOp [r] AddrGtOp [a1,a2] = Just (Just r, MO_NatU_Gt, [a1,a2])
-translateOp [r] AddrLtOp [a1,a2] = Just (Just r, MO_NatU_Lt, [a1,a2])
+translateOp [r] AddrGeOp [a1,a2] = Just (r, MO_NatU_Ge, [a1,a2])
+translateOp [r] AddrLeOp [a1,a2] = Just (r, MO_NatU_Le, [a1,a2])
+translateOp [r] AddrGtOp [a1,a2] = Just (r, MO_NatU_Gt, [a1,a2])
+translateOp [r] AddrLtOp [a1,a2] = Just (r, MO_NatU_Lt, [a1,a2])
-- 32-bit unsigned ops
-translateOp [r] CharEqOp [a1,a2] = Just (Just r, MO_32U_Eq, [a1,a2])
-translateOp [r] CharNeOp [a1,a2] = Just (Just r, MO_32U_Ne, [a1,a2])
-translateOp [r] CharGeOp [a1,a2] = Just (Just r, MO_32U_Ge, [a1,a2])
-translateOp [r] CharLeOp [a1,a2] = Just (Just r, MO_32U_Le, [a1,a2])
-translateOp [r] CharGtOp [a1,a2] = Just (Just r, MO_32U_Gt, [a1,a2])
-translateOp [r] CharLtOp [a1,a2] = Just (Just r, MO_32U_Lt, [a1,a2])
+translateOp [r] CharEqOp [a1,a2] = Just (r, MO_32U_Eq, [a1,a2])
+translateOp [r] CharNeOp [a1,a2] = Just (r, MO_32U_Ne, [a1,a2])
+translateOp [r] CharGeOp [a1,a2] = Just (r, MO_32U_Ge, [a1,a2])
+translateOp [r] CharLeOp [a1,a2] = Just (r, MO_32U_Le, [a1,a2])
+translateOp [r] CharGtOp [a1,a2] = Just (r, MO_32U_Gt, [a1,a2])
+translateOp [r] CharLtOp [a1,a2] = Just (r, MO_32U_Lt, [a1,a2])
-- Double ops
-translateOp [r] DoubleEqOp [a1,a2] = Just (Just r, MO_Dbl_Eq, [a1,a2])
-translateOp [r] DoubleNeOp [a1,a2] = Just (Just r, MO_Dbl_Ne, [a1,a2])
-translateOp [r] DoubleGeOp [a1,a2] = Just (Just r, MO_Dbl_Ge, [a1,a2])
-translateOp [r] DoubleLeOp [a1,a2] = Just (Just r, MO_Dbl_Le, [a1,a2])
-translateOp [r] DoubleGtOp [a1,a2] = Just (Just r, MO_Dbl_Gt, [a1,a2])
-translateOp [r] DoubleLtOp [a1,a2] = Just (Just r, MO_Dbl_Lt, [a1,a2])
-
-translateOp [r] DoubleAddOp [a1,a2] = Just (Just r, MO_Dbl_Add, [a1,a2])
-translateOp [r] DoubleSubOp [a1,a2] = Just (Just r, MO_Dbl_Sub, [a1,a2])
-translateOp [r] DoubleMulOp [a1,a2] = Just (Just r, MO_Dbl_Mul, [a1,a2])
-translateOp [r] DoubleDivOp [a1,a2] = Just (Just r, MO_Dbl_Div, [a1,a2])
-translateOp [r] DoublePowerOp [a1,a2] = Just (Just r, MO_Dbl_Pwr, [a1,a2])
-
-translateOp [r] DoubleSinOp [a1] = Just (Just r, MO_Dbl_Sin, [a1])
-translateOp [r] DoubleCosOp [a1] = Just (Just r, MO_Dbl_Cos, [a1])
-translateOp [r] DoubleTanOp [a1] = Just (Just r, MO_Dbl_Tan, [a1])
-translateOp [r] DoubleSinhOp [a1] = Just (Just r, MO_Dbl_Sinh, [a1])
-translateOp [r] DoubleCoshOp [a1] = Just (Just r, MO_Dbl_Cosh, [a1])
-translateOp [r] DoubleTanhOp [a1] = Just (Just r, MO_Dbl_Tanh, [a1])
-translateOp [r] DoubleAsinOp [a1] = Just (Just r, MO_Dbl_Asin, [a1])
-translateOp [r] DoubleAcosOp [a1] = Just (Just r, MO_Dbl_Acos, [a1])
-translateOp [r] DoubleAtanOp [a1] = Just (Just r, MO_Dbl_Atan, [a1])
-translateOp [r] DoubleLogOp [a1] = Just (Just r, MO_Dbl_Log, [a1])
-translateOp [r] DoubleExpOp [a1] = Just (Just r, MO_Dbl_Exp, [a1])
-translateOp [r] DoubleSqrtOp [a1] = Just (Just r, MO_Dbl_Sqrt, [a1])
-translateOp [r] DoubleNegOp [a1] = Just (Just r, MO_Dbl_Neg, [a1])
+translateOp [r] DoubleEqOp [a1,a2] = Just (r, MO_Dbl_Eq, [a1,a2])
+translateOp [r] DoubleNeOp [a1,a2] = Just (r, MO_Dbl_Ne, [a1,a2])
+translateOp [r] DoubleGeOp [a1,a2] = Just (r, MO_Dbl_Ge, [a1,a2])
+translateOp [r] DoubleLeOp [a1,a2] = Just (r, MO_Dbl_Le, [a1,a2])
+translateOp [r] DoubleGtOp [a1,a2] = Just (r, MO_Dbl_Gt, [a1,a2])
+translateOp [r] DoubleLtOp [a1,a2] = Just (r, MO_Dbl_Lt, [a1,a2])
+
+translateOp [r] DoubleAddOp [a1,a2] = Just (r, MO_Dbl_Add, [a1,a2])
+translateOp [r] DoubleSubOp [a1,a2] = Just (r, MO_Dbl_Sub, [a1,a2])
+translateOp [r] DoubleMulOp [a1,a2] = Just (r, MO_Dbl_Mul, [a1,a2])
+translateOp [r] DoubleDivOp [a1,a2] = Just (r, MO_Dbl_Div, [a1,a2])
+translateOp [r] DoublePowerOp [a1,a2] = Just (r, MO_Dbl_Pwr, [a1,a2])
+
+translateOp [r] DoubleSinOp [a1] = Just (r, MO_Dbl_Sin, [a1])
+translateOp [r] DoubleCosOp [a1] = Just (r, MO_Dbl_Cos, [a1])
+translateOp [r] DoubleTanOp [a1] = Just (r, MO_Dbl_Tan, [a1])
+translateOp [r] DoubleSinhOp [a1] = Just (r, MO_Dbl_Sinh, [a1])
+translateOp [r] DoubleCoshOp [a1] = Just (r, MO_Dbl_Cosh, [a1])
+translateOp [r] DoubleTanhOp [a1] = Just (r, MO_Dbl_Tanh, [a1])
+translateOp [r] DoubleAsinOp [a1] = Just (r, MO_Dbl_Asin, [a1])
+translateOp [r] DoubleAcosOp [a1] = Just (r, MO_Dbl_Acos, [a1])
+translateOp [r] DoubleAtanOp [a1] = Just (r, MO_Dbl_Atan, [a1])
+translateOp [r] DoubleLogOp [a1] = Just (r, MO_Dbl_Log, [a1])
+translateOp [r] DoubleExpOp [a1] = Just (r, MO_Dbl_Exp, [a1])
+translateOp [r] DoubleSqrtOp [a1] = Just (r, MO_Dbl_Sqrt, [a1])
+translateOp [r] DoubleNegOp [a1] = Just (r, MO_Dbl_Neg, [a1])
-- Float ops
-translateOp [r] FloatEqOp [a1,a2] = Just (Just r, MO_Flt_Eq, [a1,a2])
-translateOp [r] FloatNeOp [a1,a2] = Just (Just r, MO_Flt_Ne, [a1,a2])
-translateOp [r] FloatGeOp [a1,a2] = Just (Just r, MO_Flt_Ge, [a1,a2])
-translateOp [r] FloatLeOp [a1,a2] = Just (Just r, MO_Flt_Le, [a1,a2])
-translateOp [r] FloatGtOp [a1,a2] = Just (Just r, MO_Flt_Gt, [a1,a2])
-translateOp [r] FloatLtOp [a1,a2] = Just (Just r, MO_Flt_Lt, [a1,a2])
-
-translateOp [r] FloatAddOp [a1,a2] = Just (Just r, MO_Flt_Add, [a1,a2])
-translateOp [r] FloatSubOp [a1,a2] = Just (Just r, MO_Flt_Sub, [a1,a2])
-translateOp [r] FloatMulOp [a1,a2] = Just (Just r, MO_Flt_Mul, [a1,a2])
-translateOp [r] FloatDivOp [a1,a2] = Just (Just r, MO_Flt_Div, [a1,a2])
-translateOp [r] FloatPowerOp [a1,a2] = Just (Just r, MO_Flt_Pwr, [a1,a2])
-
-translateOp [r] FloatSinOp [a1] = Just (Just r, MO_Flt_Sin, [a1])
-translateOp [r] FloatCosOp [a1] = Just (Just r, MO_Flt_Cos, [a1])
-translateOp [r] FloatTanOp [a1] = Just (Just r, MO_Flt_Tan, [a1])
-translateOp [r] FloatSinhOp [a1] = Just (Just r, MO_Flt_Sinh, [a1])
-translateOp [r] FloatCoshOp [a1] = Just (Just r, MO_Flt_Cosh, [a1])
-translateOp [r] FloatTanhOp [a1] = Just (Just r, MO_Flt_Tanh, [a1])
-translateOp [r] FloatAsinOp [a1] = Just (Just r, MO_Flt_Asin, [a1])
-translateOp [r] FloatAcosOp [a1] = Just (Just r, MO_Flt_Acos, [a1])
-translateOp [r] FloatAtanOp [a1] = Just (Just r, MO_Flt_Atan, [a1])
-translateOp [r] FloatLogOp [a1] = Just (Just r, MO_Flt_Log, [a1])
-translateOp [r] FloatExpOp [a1] = Just (Just r, MO_Flt_Exp, [a1])
-translateOp [r] FloatSqrtOp [a1] = Just (Just r, MO_Flt_Sqrt, [a1])
-translateOp [r] FloatNegOp [a1] = Just (Just r, MO_Flt_Neg, [a1])
+translateOp [r] FloatEqOp [a1,a2] = Just (r, MO_Flt_Eq, [a1,a2])
+translateOp [r] FloatNeOp [a1,a2] = Just (r, MO_Flt_Ne, [a1,a2])
+translateOp [r] FloatGeOp [a1,a2] = Just (r, MO_Flt_Ge, [a1,a2])
+translateOp [r] FloatLeOp [a1,a2] = Just (r, MO_Flt_Le, [a1,a2])
+translateOp [r] FloatGtOp [a1,a2] = Just (r, MO_Flt_Gt, [a1,a2])
+translateOp [r] FloatLtOp [a1,a2] = Just (r, MO_Flt_Lt, [a1,a2])
+
+translateOp [r] FloatAddOp [a1,a2] = Just (r, MO_Flt_Add, [a1,a2])
+translateOp [r] FloatSubOp [a1,a2] = Just (r, MO_Flt_Sub, [a1,a2])
+translateOp [r] FloatMulOp [a1,a2] = Just (r, MO_Flt_Mul, [a1,a2])
+translateOp [r] FloatDivOp [a1,a2] = Just (r, MO_Flt_Div, [a1,a2])
+translateOp [r] FloatPowerOp [a1,a2] = Just (r, MO_Flt_Pwr, [a1,a2])
+
+translateOp [r] FloatSinOp [a1] = Just (r, MO_Flt_Sin, [a1])
+translateOp [r] FloatCosOp [a1] = Just (r, MO_Flt_Cos, [a1])
+translateOp [r] FloatTanOp [a1] = Just (r, MO_Flt_Tan, [a1])
+translateOp [r] FloatSinhOp [a1] = Just (r, MO_Flt_Sinh, [a1])
+translateOp [r] FloatCoshOp [a1] = Just (r, MO_Flt_Cosh, [a1])
+translateOp [r] FloatTanhOp [a1] = Just (r, MO_Flt_Tanh, [a1])
+translateOp [r] FloatAsinOp [a1] = Just (r, MO_Flt_Asin, [a1])
+translateOp [r] FloatAcosOp [a1] = Just (r, MO_Flt_Acos, [a1])
+translateOp [r] FloatAtanOp [a1] = Just (r, MO_Flt_Atan, [a1])
+translateOp [r] FloatLogOp [a1] = Just (r, MO_Flt_Log, [a1])
+translateOp [r] FloatExpOp [a1] = Just (r, MO_Flt_Exp, [a1])
+translateOp [r] FloatSqrtOp [a1] = Just (r, MO_Flt_Sqrt, [a1])
+translateOp [r] FloatNegOp [a1] = Just (r, MO_Flt_Neg, [a1])
-- Conversions
-translateOp [r] Int2DoubleOp [a1] = Just (Just r, MO_NatS_to_Dbl, [a1])
-translateOp [r] Double2IntOp [a1] = Just (Just r, MO_Dbl_to_NatS, [a1])
+translateOp [r] Int2DoubleOp [a1] = Just (r, MO_NatS_to_Dbl, [a1])
+translateOp [r] Double2IntOp [a1] = Just (r, MO_Dbl_to_NatS, [a1])
-translateOp [r] Int2FloatOp [a1] = Just (Just r, MO_NatS_to_Flt, [a1])
-translateOp [r] Float2IntOp [a1] = Just (Just r, MO_Flt_to_NatS, [a1])
+translateOp [r] Int2FloatOp [a1] = Just (r, MO_NatS_to_Flt, [a1])
+translateOp [r] Float2IntOp [a1] = Just (r, MO_Flt_to_NatS, [a1])
-translateOp [r] Float2DoubleOp [a1] = Just (Just r, MO_Flt_to_Dbl, [a1])
-translateOp [r] Double2FloatOp [a1] = Just (Just r, MO_Dbl_to_Flt, [a1])
+translateOp [r] Float2DoubleOp [a1] = Just (r, MO_Flt_to_Dbl, [a1])
+translateOp [r] Double2FloatOp [a1] = Just (r, MO_Dbl_to_Flt, [a1])
-translateOp [r] Int2WordOp [a1] = Just (Just r, MO_NatS_to_NatU, [a1])
-translateOp [r] Word2IntOp [a1] = Just (Just r, MO_NatU_to_NatS, [a1])
+translateOp [r] Int2WordOp [a1] = Just (r, MO_NatS_to_NatU, [a1])
+translateOp [r] Word2IntOp [a1] = Just (r, MO_NatU_to_NatS, [a1])
-translateOp [r] Int2AddrOp [a1] = Just (Just r, MO_NatS_to_NatP, [a1])
-translateOp [r] Addr2IntOp [a1] = Just (Just r, MO_NatP_to_NatS, [a1])
+translateOp [r] Int2AddrOp [a1] = Just (r, MO_NatS_to_NatP, [a1])
+translateOp [r] Addr2IntOp [a1] = Just (r, MO_NatP_to_NatS, [a1])
-translateOp [r] OrdOp [a1] = Just (Just r, MO_32U_to_NatS, [a1])
-translateOp [r] ChrOp [a1] = Just (Just r, MO_NatS_to_32U, [a1])
+translateOp [r] OrdOp [a1] = Just (r, MO_32U_to_NatS, [a1])
+translateOp [r] ChrOp [a1] = Just (r, MO_NatS_to_32U, [a1])
-translateOp [r] Narrow8IntOp [a1] = Just (Just r, MO_8S_to_NatS, [a1])
-translateOp [r] Narrow16IntOp [a1] = Just (Just r, MO_16S_to_NatS, [a1])
-translateOp [r] Narrow32IntOp [a1] = Just (Just r, MO_32S_to_NatS, [a1])
+translateOp [r] Narrow8IntOp [a1] = Just (r, MO_8S_to_NatS, [a1])
+translateOp [r] Narrow16IntOp [a1] = Just (r, MO_16S_to_NatS, [a1])
+translateOp [r] Narrow32IntOp [a1] = Just (r, MO_32S_to_NatS, [a1])
-translateOp [r] Narrow8WordOp [a1] = Just (Just r, MO_8U_to_NatU, [a1])
-translateOp [r] Narrow16WordOp [a1] = Just (Just r, MO_16U_to_NatU, [a1])
-translateOp [r] Narrow32WordOp [a1] = Just (Just r, MO_32U_to_NatU, [a1])
+translateOp [r] Narrow8WordOp [a1] = Just (r, MO_8U_to_NatU, [a1])
+translateOp [r] Narrow16WordOp [a1] = Just (r, MO_16U_to_NatU, [a1])
+translateOp [r] Narrow32WordOp [a1] = Just (r, MO_32U_to_NatU, [a1])
-- Word comparisons masquerading as more exotic things.
-translateOp [r] SameMutVarOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] SameMVarOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] EqForeignObj [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
-translateOp [r] EqStablePtrOp [a1,a2] = Just (Just r, MO_Nat_Eq, [a1,a2])
+translateOp [r] SameMutVarOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] SameMVarOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] SameMutableArrayOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] EqForeignObj [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
+translateOp [r] EqStablePtrOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2])
translateOp _ _ _ = Nothing
+\end{code}
+
+\begin{code}
+shimFCallArg arg amode
+ | tycon == foreignObjPrimTyCon
+ = CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode]
+ | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
+ = CMacroExpr PtrRep PTRS_ARR_CTS [amode]
+ | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
+ = CMacroExpr AddrRep BYTE_ARR_CTS [amode]
+ | otherwise = amode
+ where
+ -- should be a tycon app, since this is a foreign call
+ tycon = tyConAppTyCon (repType (stgArgType arg))
\end{code}
projects / ghc-hetmet.git / blobdiff