diff options
author | Simon Marlow <marlowsd@gmail.com> | 2009-07-27 14:45:24 +0000 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2009-07-27 14:45:24 +0000 |
commit | 1fede4bc9501744bf2269ce2a4cb9fb735969caa (patch) | |
tree | f21e2178bcc90c3e1d50c2b0e93a68b7bfd369d4 /compiler/deSugar/DsCCall.lhs | |
parent | dd849158c84941f5e3714dd4df24e467854f0d91 (diff) | |
download | haskell-1fede4bc9501744bf2269ce2a4cb9fb735969caa.tar.gz |
Remove old 'foreign import dotnet' code
It still lives in darcs, if anyone wants to revive it sometime.
Diffstat (limited to 'compiler/deSugar/DsCCall.lhs')
-rw-r--r-- | compiler/deSugar/DsCCall.lhs | 25 |
1 files changed, 9 insertions, 16 deletions
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs index 27dff94839..0dd29c988f 100644 --- a/compiler/deSugar/DsCCall.lhs +++ b/compiler/deSugar/DsCCall.lhs @@ -88,7 +88,7 @@ dsCCall :: CLabelString -- C routine to invoke dsCCall lbl args may_gc result_ty = do (unboxed_args, arg_wrappers) <- mapAndUnzipM unboxArg args - (ccall_result_ty, res_wrapper) <- boxResult id Nothing result_ty + (ccall_result_ty, res_wrapper) <- boxResult result_ty uniq <- newUnique let target = StaticTarget lbl @@ -231,10 +231,7 @@ unboxArg arg \begin{code} -boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) - -> (Maybe Type, CoreExpr -> CoreExpr)) - -> Maybe Id - -> Type +boxResult :: Type -> DsM (Type, CoreExpr -> CoreExpr) -- Takes the result of the user-level ccall: @@ -247,11 +244,8 @@ boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -- where t' is the unwrapped form of t. If t is simply (), then -- the result type will be -- State# RealWorld -> (# State# RealWorld #) --- --- The gruesome 'augment' and 'mbTopCon' are to do with .NET foreign calls --- It looks a mess: I wonder if it could be refactored. -boxResult augment mbTopCon result_ty +boxResult result_ty | Just (io_tycon, io_res_ty, co) <- tcSplitIOType_maybe result_ty -- isIOType_maybe handles the case where the type is a -- simple wrapping of IO. E.g. @@ -261,9 +255,8 @@ boxResult augment mbTopCon result_ty -- another case, and a coercion.) -- The result is IO t, so wrap the result in an IO constructor = do { res <- resultWrapper io_res_ty - ; let aug_res = augment res - extra_result_tys - = case aug_res of + ; let extra_result_tys + = case res of (Just ty,_) | isUnboxedTupleType ty -> let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls @@ -274,11 +267,11 @@ boxResult augment mbTopCon result_ty (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys) ++ (state : anss)) - ; (ccall_res_ty, the_alt) <- mk_alt return_result aug_res + ; (ccall_res_ty, the_alt) <- mk_alt return_result res ; state_id <- newSysLocalDs realWorldStatePrimTy ; let io_data_con = head (tyConDataCons io_tycon) - toIOCon = mbTopCon `orElse` dataConWrapId io_data_con + toIOCon = dataConWrapId io_data_con wrap the_call = mkCoerceI (mkSymCoI co) $ mkApps (Var toIOCon) @@ -292,11 +285,11 @@ boxResult augment mbTopCon result_ty ; return (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap) } -boxResult augment _mbTopCon result_ty +boxResult result_ty = do -- It isn't IO, so do unsafePerformIO -- It's not conveniently available, so we inline it res <- resultWrapper result_ty - (ccall_res_ty, the_alt) <- mk_alt return_result (augment res) + (ccall_res_ty, the_alt) <- mk_alt return_result res let wrap = \ the_call -> mkWildCase (App the_call (Var realWorldPrimId)) ccall_res_ty |