Commit 1454d97e authored by panne's avatar panne
Browse files

[project @ 2000-04-04 13:40:27 by panne]

Enable Bool in foreign import/export
parent 985d30aa
......@@ -34,11 +34,16 @@ import Type ( isUnLiftedType, splitAlgTyConApp_maybe, mkFunTys,
splitTyConApp_maybe, tyVarsOfType, mkForAllTys, Type
)
import TysPrim ( byteArrayPrimTy, realWorldStatePrimTy,
byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
import TysWiredIn ( unitDataConId, stringTy,
byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
intPrimTy
)
import TysWiredIn ( unitDataConId, stringTy, boolTy,
falseDataCon, falseDataConId,
trueDataCon, trueDataConId,
unboxedPairDataCon,
mkUnboxedTupleTy, unboxedTupleCon
)
import Literal ( mkMachInt )
import CStrings ( CLabelString )
import Unique ( Unique )
import VarSet ( varSetElems )
......@@ -174,6 +179,16 @@ unboxArg arg
\ body -> Case arg case_bndr [(DataAlt box_data_con,[prim_arg],body)]
)
-- Booleans; Hacking alert: the 0/1 literals should match the HsFalse/HsTrue constants
| arg_ty == boolTy
= newSysLocalDs intPrimTy `thenDs` \ prim_arg ->
returnDs (Var prim_arg,
\ body -> Case (Case arg (mkWildId arg_ty) [
(DataAlt falseDataCon,[],mkIntLit 0),
(DataAlt trueDataCon, [],mkIntLit 1)])
prim_arg [(DEFAULT,[],body)]
)
| otherwise
= getSrcLocDs `thenDs` \ l ->
pprPanic "unboxArg: " (ppr l <+> ppr arg_ty)
......@@ -248,6 +263,13 @@ boxResult result_ty
returnDs (ccall_res_type, \prim_app -> Case prim_app case_bndr [the_alt]
)
-- Booleans
| result_ty == boolTy
= returnDs (mkUnboxedTupleTy 2 [realWorldStatePrimTy, intPrimTy],
\ prim_app -> Case prim_app (mkWildId intPrimTy) [
(LitAlt (mkMachInt 0),[],Var falseDataConId),
(DEFAULT ,[],Var trueDataConId )])
| otherwise
= pprPanic "boxResult: " (ppr result_ty)
where
......
/* -----------------------------------------------------------------------------
* $Id: StgTypes.h,v 1.7 2000/01/25 14:36:53 panne Exp $
* $Id: StgTypes.h,v 1.8 2000/04/04 13:40:27 panne Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -90,7 +90,7 @@ typedef void* StgAddr;
*/
typedef StgWord8 StgChar;
typedef int StgBool;
/*
* If a double fits in an StgWord, don't bother using floats.
*/
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.c,v 1.13 2000/03/31 03:09:36 hwloidl Exp $
* $Id: RtsAPI.c,v 1.14 2000/04/04 13:40:27 panne Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -176,7 +176,7 @@ rts_mkAddr (void *a)
#ifdef COMPILER /* GHC has em, Hugs doesn't */
HaskellObj
rts_mkBool (int b)
rts_mkBool (StgBool b)
{
if (b) {
return (StgClosure *)True_closure;
......@@ -316,9 +316,9 @@ int
rts_getBool (HaskellObj p)
{
if (p == True_closure) {
return 1;
return 1; /* NOTE: This should better be HsTrue */
} else if (p == False_closure) {
return 0;
return 0; /* ... and this HsFalse */
} else {
barf("getBool: not a Bool");
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment