import TcType ( Type, isUnLiftedType, mkFunTys, mkFunTy,
tyVarsOfType, mkForAllTys, mkTyConApp,
- isBoolTy, isUnitTy, isPrimitiveType
+ isBoolTy, isUnitTy, isPrimitiveType,
+ tcSplitTyConApp_maybe
)
import Type ( splitTyConApp_maybe, repType, eqType ) -- Sees the representation type
import PrimOp ( PrimOp(TouchOp) )
dsCCall lbl args may_gc is_asm result_ty
= mapAndUnzipDs unboxArg args `thenDs` \ (unboxed_args, arg_wrappers) ->
- boxResult [] result_ty `thenDs` \ (ccall_result_ty, res_wrapper) ->
+ boxResult [] ({-repType-} result_ty) `thenDs` \ (ccall_result_ty, res_wrapper) ->
getUniqueDs `thenDs` \ uniq ->
let
target | is_asm = CasmTarget lbl
(data_con_arg_ty1 : _) = data_con_arg_tys
(_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys
- maybe_arg3_tycon = splitTyConApp_maybe data_con_arg_ty3
+ maybe_arg3_tycon = tcSplitTyConApp_maybe data_con_arg_ty3
Just (arg3_tycon,_) = maybe_arg3_tycon
\end{code}
-- the call. The arg_ids passed in are the Ids passed to the actual ccall.
boxResult arg_ids result_ty
- = case splitTyConApp_maybe result_ty of
+ = case tcSplitTyConApp_maybe result_ty of
-- The result is IO t, so wrap the result in an IO constructor
Just (io_tycon, [io_res_ty]) | io_tycon `hasKey` ioTyConKey
= pprPanic "resultWrapper" (ppr result_ty)
where
result_ty_rep = repType result_ty
+
\end{code}
Type, mkFunTys, mkForAllTys, mkTyConApp,
mkFunTy, applyTy, eqType, repType
)
+import TcType ( tcSplitForAllTys, tcSplitFunTys,
+ tcSplitTyConApp_maybe, tcSplitAppTy,
+ tcFunResultTy
+ )
import ForeignCall ( ForeignCall(..), CCallSpec(..),
Safety(..), playSafe,
dsFCall mod_Name fn_id fcall
= let
ty = idType fn_id
- (tvs, fun_ty) = splitForAllTys ty
- (arg_tys, io_res_ty) = splitFunTys fun_ty
+ (tvs, fun_ty) = tcSplitForAllTys ty
+ (arg_tys, io_res_ty) = tcSplitFunTys fun_ty
in
newSysLocalsDs arg_tys `thenDs` \ args ->
mapAndUnzipDs unboxArg (map Var args) `thenDs` \ (val_args, arg_wrappers) ->
-- Look at the result type of the exported function, orig_res_ty
-- If it's IO t, return (\x.x, IO t, t)
-- If it's plain t, return (\x.returnIO x, IO t, t)
- (case splitTyConApp_maybe orig_res_ty of
+ (case tcSplitTyConApp_maybe orig_res_ty of
Just (ioTyCon, [res_ty])
-> ASSERT( ioTyCon `hasKey` ioTyConKey )
-- The function already returns IO t
other -> -- The function returns t, so wrap the call in returnIO
dsLookupGlobalValue returnIOName `thenDs` \ retIOId ->
returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body],
- funResultTy (applyTy (idType retIOId) orig_res_ty),
+ tcFunResultTy (applyTy (idType retIOId) orig_res_ty),
-- We don't have ioTyCon conveniently to hand
orig_res_ty)
returnDs (f_helper_glob, (f_helper_glob, the_body), h_stub, c_stub)
where
- (tvs,sans_foralls) = splitForAllTys ty
- (fe_arg_tys', orig_res_ty) = splitFunTys sans_foralls
+ (tvs,sans_foralls) = tcSplitForAllTys ty
+ (fe_arg_tys', orig_res_ty) = tcSplitFunTys sans_foralls
- (_, stbl_ptr_ty') = splitForAllTys stbl_ptr_ty
- (_, stbl_ptr_to_ty) = splitAppTy stbl_ptr_ty'
+ (_, stbl_ptr_ty') = tcSplitForAllTys stbl_ptr_ty
+ (_, stbl_ptr_to_ty) = tcSplitAppTy stbl_ptr_ty'
fe_arg_tys | isDyn = tail fe_arg_tys'
| otherwise = fe_arg_tys'
where
ty = idType id
- (tvs,sans_foralls) = splitForAllTys ty
- ([arg_ty], io_res_ty) = splitFunTys sans_foralls
- Just (ioTyCon, [res_ty]) = splitTyConApp_maybe io_res_ty
+ (tvs,sans_foralls) = tcSplitForAllTys ty
+ ([arg_ty], io_res_ty) = tcSplitFunTys sans_foralls
+ Just (ioTyCon, [res_ty]) = tcSplitTyConApp_maybe io_res_ty
export_ty = mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty
toCName :: Id -> String
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.77 2001/07/13 11:39:48 rrt Exp $
+ * $Id: PrimOps.h,v 1.78 2001/07/14 00:06:14 sof Exp $
*
* (c) The GHC Team, 1998-2000
*
#define writeForeignObjzh(res,datum) \
(ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
-#define eqForeignObjzh(f1,f2) ((f1)==(f2))
+#define eqForeignObjzh(r,f1,f2) r=(f1)==(f2)
#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexWideCharOffForeignObjzh(r,fo,i) indexWideCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
bitSize _ = 64
isSigned _ = True
-foreign import "eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool
-foreign import "neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool
-foreign import "ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool
-foreign import "leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool
-foreign import "gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool
-foreign import "geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool
-foreign import "plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
-foreign import "negateInt64" unsafe negateInt64# :: Int64# -> Int64#
-foreign import "quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64#
-foreign import "remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64#
-foreign import "intToInt64" unsafe intToInt64# :: Int# -> Int64#
-foreign import "int64ToInt" unsafe int64ToInt# :: Int64# -> Int#
-foreign import "wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
-foreign import "int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
-foreign import "word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
-foreign import "and64" unsafe and64# :: Word64# -> Word64# -> Word64#
-foreign import "or64" unsafe or64# :: Word64# -> Word64# -> Word64#
-foreign import "xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
-foreign import "not64" unsafe not64# :: Word64# -> Word64#
-foreign import "iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64#
-foreign import "iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64#
-foreign import "shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
-foreign import "shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
+foreign import "stg_quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
+foreign import "stg_int64ToInt" unsafe int64ToInt# :: Int64# -> Int#
+foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
+foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
+foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
+foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
+foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64#
+foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64#
+foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
{-# RULES
"fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#)
bitSize _ = 64
isSigned _ = False
-foreign import "eqWord64" unsafe eqWord64# :: Word64# -> Word64# -> Bool
-foreign import "neWord64" unsafe neWord64# :: Word64# -> Word64# -> Bool
-foreign import "ltWord64" unsafe ltWord64# :: Word64# -> Word64# -> Bool
-foreign import "leWord64" unsafe leWord64# :: Word64# -> Word64# -> Bool
-foreign import "gtWord64" unsafe gtWord64# :: Word64# -> Word64# -> Bool
-foreign import "geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool
-foreign import "int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
-foreign import "word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
-foreign import "plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
-foreign import "negateInt64" unsafe negateInt64# :: Int64# -> Int64#
-foreign import "intToInt64" unsafe intToInt64# :: Int# -> Int64#
-foreign import "wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
-foreign import "word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
-foreign import "quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64#
-foreign import "remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64#
-foreign import "and64" unsafe and64# :: Word64# -> Word64# -> Word64#
-foreign import "or64" unsafe or64# :: Word64# -> Word64# -> Word64#
-foreign import "xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
-foreign import "not64" unsafe not64# :: Word64# -> Word64#
-foreign import "shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
-foreign import "shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_eqWord64" unsafe eqWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_neWord64" unsafe neWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_ltWord64" unsafe ltWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_leWord64" unsafe leWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_gtWord64" unsafe gtWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
+foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
+foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
+foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
+foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
+foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
+foreign import "stg_quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
+foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
{-# RULES
"fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#))
/* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.1 2001/07/13 11:03:47 rrt Exp $
+ * $Id: longlong.c,v 1.2 2001/07/14 00:06:15 sof Exp $
*
* (c) The GHC Team, 1998-1999
*
/* Relational operators */
-StgBool gtWord64 (StgWord64 a, StgWord64 b) {return a > b;}
-StgBool geWord64 (StgWord64 a, StgWord64 b) {return a >= b;}
-StgBool eqWord64 (StgWord64 a, StgWord64 b) {return a == b;}
-StgBool neWord64 (StgWord64 a, StgWord64 b) {return a != b;}
-StgBool ltWord64 (StgWord64 a, StgWord64 b) {return a < b;}
-StgBool leWord64 (StgWord64 a, StgWord64 b) {return a <= b;}
+StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a > b;}
+StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;}
+StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;}
+StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;}
+StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a < b;}
+StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;}
-StgBool gtInt64 (StgInt64 a, StgInt64 b) {return a > b;}
-StgBool geInt64 (StgInt64 a, StgInt64 b) {return a >= b;}
-StgBool eqInt64 (StgInt64 a, StgInt64 b) {return a == b;}
-StgBool neInt64 (StgInt64 a, StgInt64 b) {return a != b;}
-StgBool ltInt64 (StgInt64 a, StgInt64 b) {return a < b;}
-StgBool leInt64 (StgInt64 a, StgInt64 b) {return a <= b;}
+StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a > b;}
+StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;}
+StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;}
+StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;}
+StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a < b;}
+StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;}
/* Arithmetic operators */
-StgWord64 remWord64 (StgWord64 a, StgWord64 b) {return a % b;}
-StgWord64 quotWord64 (StgWord64 a, StgWord64 b) {return a / b;}
-StgInt64 remInt64 (StgInt64 a, StgInt64 b) {return a % b;}
-StgInt64 quotInt64 (StgInt64 a, StgInt64 b) {return a / b;}
-StgInt64 negateInt64 (StgInt64 a) {return -a;}
-StgInt64 plusInt64 (StgInt64 a, StgInt64 b) {return a + b;}
-StgInt64 minusInt64 (StgInt64 a, StgInt64 b) {return a - b;}
-StgInt64 timesInt64 (StgInt64 a, StgInt64 b) {return a * b;}
+StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;}
+StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;}
+StgInt64 stg_remInt64 (StgInt64 a, StgInt64 b) {return a % b;}
+StgInt64 stg_quotInt64 (StgInt64 a, StgInt64 b) {return a / b;}
+StgInt64 stg_negateInt64 (StgInt64 a) {return -a;}
+StgInt64 stg_plusInt64 (StgInt64 a, StgInt64 b) {return a + b;}
+StgInt64 stg_minusInt64 (StgInt64 a, StgInt64 b) {return a - b;}
+StgInt64 stg_timesInt64 (StgInt64 a, StgInt64 b) {return a * b;}
/* Logical operators: */
-StgWord64 and64 (StgWord64 a, StgWord64 b) {return a & b;}
-StgWord64 or64 (StgWord64 a, StgWord64 b) {return a | b;}
-StgWord64 xor64 (StgWord64 a, StgWord64 b) {return a ^ b;}
-StgWord64 not64 (StgWord64 a) {return ~a;}
-StgWord64 shiftL64 (StgWord64 a, StgInt b) {return a << b;}
-StgWord64 shiftRL64 (StgWord64 a, StgInt b) {return a >> b;}
+StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;}
+StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;}
+StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;}
+StgWord64 stg_not64 (StgWord64 a) {return ~a;}
+StgWord64 stg_shiftL64 (StgWord64 a, StgInt b) {return a << b;}
+StgWord64 stg_shiftRL64 (StgWord64 a, StgInt b) {return a >> b;}
/* Right shifting of signed quantities is not portable in C, so
the behaviour you'll get from using these primops depends
on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
*/
-StgInt64 iShiftL64 (StgInt64 a, StgInt b) {return a << b;}
-StgInt64 iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;}
-StgInt64 iShiftRL64 (StgInt64 a, StgInt b)
+StgInt64 stg_iShiftL64 (StgInt64 a, StgInt b) {return a << b;}
+StgInt64 stg_iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;}
+StgInt64 stg_iShiftRL64 (StgInt64 a, StgInt b)
{return (StgInt64) ((StgWord64) a >> b);}
/* Casting between longs and longer longs:
expressed as macros, since these may cause some heap allocation).
*/
-StgInt64 intToInt64 (StgInt i) {return (StgInt64) i;}
-StgInt int64ToInt (StgInt64 i) {return (StgInt) i;}
-StgWord64 int64ToWord64 (StgInt64 i) {return (StgWord64) i;}
-StgWord64 wordToWord64 (StgWord w) {return (StgWord64) w;}
-StgWord word64ToWord (StgWord64 w) {return (StgWord) w;}
-StgInt64 word64ToInt64 (StgWord64 w) {return (StgInt64) w;}
+StgInt64 stg_intToInt64 (StgInt i) {return (StgInt64) i;}
+StgInt stg_int64ToInt (StgInt64 i) {return (StgInt) i;}
+StgWord64 stg_int64ToWord64 (StgInt64 i) {return (StgWord64) i;}
+StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;}
+StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;}
+StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;}
#endif /* SUPPORT_LONG_LONGS */
projects / ghc-hetmet.git / commitdiff