DsForeign.lhs 15.9 KB
Newer Older
sof's avatar
sof committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
%
% (c) The AQUA Project, Glasgow University, 1998
%
\section[DsCCall]{Desugaring \tr{foreign} declarations}

Expanding out @foreign import@ and @foreign export@ declarations.

\begin{code}
module DsForeign ( dsForeigns ) where

#include "HsVersions.h"

import CoreSyn

15
import DsCCall		( dsCCall, mkCCall, boxResult, unboxArg )
sof's avatar
sof committed
16
17
18
import DsMonad
import DsUtils

19
20
import HsSyn		( ExtName(..), ForeignDecl(..), isDynamicExtName, ForKind(..) )
import HsDecls		( extNameStatic )
sof's avatar
sof committed
21
import CallConv
22
import TcHsSyn		( TypecheckedForeignDecl )
23
import CoreUtils	( exprType, mkInlineMe )
24
import DataCon		( DataCon, dataConWrapId )
25
import Id		( Id, idType, idName, mkWildId, mkVanillaId )
26
import MkId		( mkWorkerId )
27
import Literal		( Literal(..) )
sof's avatar
sof committed
28
import Module		( Module, moduleUserString )
29
import Name		( mkGlobalName, nameModule, nameOccName, getOccString, 
sof's avatar
sof committed
30
			  mkForeignExportOcc, isLocalName,
31
32
			  NamedThing(..), Provenance(..), ExportFlag(..)
			)
33
import PrelInfo		( deRefStablePtr_NAME, returnIO_NAME, bindIO_NAME, makeStablePtr_NAME )
34
import Type		( unUsgTy,
sof's avatar
sof committed
35
			  splitTyConApp_maybe, splitFunTys, splitForAllTys,
36
			  Type, mkFunTys, mkForAllTys, mkTyConApp,
37
			  mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy
sof's avatar
sof committed
38
			)
39
import PprType		( {- instance Outputable Type -} )
40
import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..) )
41
42
import Var		( TyVar )
import TysPrim		( realWorldStatePrimTy, addrPrimTy )
43
import TysWiredIn	( unitTy, addrTy, stablePtrTyCon,
44
			  unboxedTupleCon, addrDataCon
sof's avatar
sof committed
45
			)
sof's avatar
sof committed
46
import Unique
47
import Maybes		( maybeToBool )
sof's avatar
sof committed
48
49
50
51
52
import Outputable
\end{code}

Desugaring of @foreign@ declarations is naturally split up into
parts, an @import@ and an @export@  part. A @foreign import@ 
53
54
declaration
\begin{verbatim}
sof's avatar
sof committed
55
  foreign import cc nm f :: prim_args -> IO prim_res
56
\end{verbatim}
sof's avatar
sof committed
57
is the same as
58
\begin{verbatim}
sof's avatar
sof committed
59
60
  f :: prim_args -> IO prim_res
  f a1 ... an = _ccall_ nm cc a1 ... an
61
\end{verbatim}
sof's avatar
sof committed
62
63
64
so we reuse the desugaring code in @DsCCall@ to deal with these.

\begin{code}
sof's avatar
sof committed
65
66
dsForeigns :: Module
           -> [TypecheckedForeignDecl] 
67
68
	   -> DsM ( [CoreBind]        -- desugared foreign imports
                  , [CoreBind]        -- helper functions for foreign exports
69
70
71
72
		  , SDoc	      -- Header file prototypes for
                                      -- "foreign exported" functions.
		  , SDoc 	      -- C stubs to use when calling
                                      -- "foreign exported" functions.
sof's avatar
sof committed
73
		  )
sof's avatar
sof committed
74
dsForeigns mod_name fos = foldlDs combine ([],[],empty,empty) fos
sof's avatar
sof committed
75
 where
76
77
  combine (acc_fi, acc_fe, acc_h, acc_c) fo@(ForeignDecl i imp_exp _ ext_nm cconv _) 
    | isForeignImport =   -- foreign import (dynamic)?
78
79
        dsFImport i (idType i) uns ext_nm cconv  `thenDs` \ bs -> 
	returnDs (bs ++ acc_fi, acc_fe, acc_h, acc_c)
sof's avatar
sof committed
80
81
    | isForeignLabel = 
        dsFLabel i ext_nm `thenDs` \ b -> 
82
	returnDs (b:acc_fi, acc_fe, acc_h, acc_c)
83
    | isDynamicExtName ext_nm =
sof's avatar
sof committed
84
        dsFExportDynamic i (idType i) mod_name ext_nm cconv  `thenDs` \ (fi,fe,h,c) -> 
85
	returnDs (fi:acc_fi, fe:acc_fe, h $$ acc_h, c $$ acc_c)
sof's avatar
sof committed
86

87
    | otherwise	       =  -- foreign export
sof's avatar
sof committed
88
        dsFExport i (idType i) mod_name ext_nm cconv False   `thenDs` \ (fe,h,c) ->
89
	returnDs (acc_fi, fe:acc_fe, h $$ acc_h, c $$ acc_c)
sof's avatar
sof committed
90
   where
sof's avatar
sof committed
91
92
93
94
95
96
97
98
99
100
101
    isForeignImport = 
	case imp_exp of
	  FoImport _ -> True
	  _          -> False

    isForeignLabel = 
	case imp_exp of
	  FoLabel -> True
	  _       -> False

    (FoImport uns)   = imp_exp
sof's avatar
sof committed
102
103
104
105
106

\end{code}

Desugaring foreign imports is just the matter of creating a binding
that on its RHS unboxes its arguments, performs the external call
107
(using the @CCallOp@ primop), before boxing the result up and returning it.
sof's avatar
sof committed
108

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
However, we create a worker/wrapper pair, thus:

	foreign import f :: Int -> IO Int
==>
	f x = IO ( \s -> case x of { I# x# ->
			 case fw s x# of { (# s1, y# #) ->
			 (# s1, I# y# #)}})

	fw s x# = ccall f s x#

The strictness/CPR analyser won't do this automatically because it doesn't look
inside returned tuples; but inlining this wrapper is a Really Good Idea 
because it exposes the boxing to the call site.
			

sof's avatar
sof committed
124
125
126
127
128
129
\begin{code}
dsFImport :: Id
	  -> Type		-- Type of foreign import.
	  -> Bool		-- True <=> might cause Haskell GC
	  -> ExtName
	  -> CallConv
130
131
132
	  -> DsM [CoreBind]
dsFImport fn_id ty may_not_gc ext_name cconv 
  = let
133
134
	(tvs, fun_ty)        = splitForAllTys ty
	(arg_tys, io_res_ty) = splitFunTys fun_ty
sof's avatar
sof committed
135
    in
136
    newSysLocalsDs arg_tys  			`thenDs` \ args ->
137
138
    mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
    boxResult io_res_ty				`thenDs` \ (ccall_result_ty, res_wrapper) ->
139

sof's avatar
sof committed
140
    (case ext_name of
sof's avatar
sof committed
141
       Dynamic       -> getUniqueDs `thenDs` \ u -> 
142
143
			returnDs (DynamicTarget u)
       ExtName fs _  -> returnDs (StaticTarget fs))	`thenDs` \ lbl ->
144

145
146
    getUniqueDs						`thenDs` \ ccall_uniq ->
    getUniqueDs						`thenDs` \ work_uniq ->
sof's avatar
sof committed
147
    let
148
149
150
151
152
153
154
155
156
157
158
	-- Build the worker
	work_arg_ids  = [v | Var v <- val_args]		-- All guaranteed to be vars
	worker_ty     = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
	the_ccall     = CCall lbl False (not may_not_gc) cconv
 	the_ccall_app = mkCCall ccall_uniq the_ccall val_args ccall_result_ty
	work_rhs      = mkLams tvs (mkLams work_arg_ids the_ccall_app)
	work_id       = mkWorkerId work_uniq fn_id worker_ty

	-- Build the wrapper
	work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args
	wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
159
        wrap_rhs     = mkInlineMe (mkLams (tvs ++ args) wrapper_body)
sof's avatar
sof committed
160
    in
161
    returnDs [NonRec fn_id wrap_rhs, NonRec work_id work_rhs]
162
163
\end{code}

164
Foreign labels 
sof's avatar
sof committed
165
166

\begin{code}
167
168
dsFLabel :: Id -> ExtName -> DsM CoreBind
dsFLabel nm ext_name = returnDs (NonRec nm fo_rhs)
sof's avatar
sof committed
169
  where
170
   fo_rhs = mkConApp addrDataCon [mkLit (MachLitLit enm addrPrimTy)]
171
   enm    = extNameStatic ext_name
sof's avatar
sof committed
172
173
\end{code}

174
175
The function that does most of the work for `@foreign export@' declarations.
(see below for the boilerplate code a `@foreign export@' declaration expands
176
 into.)
sof's avatar
sof committed
177

178
179
180
181
182
183
For each `@foreign export foo@' in a module M we generate:
\begin{itemize}
\item a C function `@foo@', which calls
\item a Haskell stub `@M.$ffoo@', which calls
\end{itemize}
the user-written Haskell function `@M.foo@'.
184

sof's avatar
sof committed
185
186
187
\begin{code}
dsFExport :: Id
	  -> Type		-- Type of foreign export.
sof's avatar
sof committed
188
	  -> Module
sof's avatar
sof committed
189
190
191
192
	  -> ExtName
	  -> CallConv
	  -> Bool		-- True => invoke IO action that's hanging off 
				-- the first argument's stable pointer
193
194
195
196
	  -> DsM ( CoreBind
		 , SDoc
		 , SDoc
		 )
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
dsFExport i ty mod_name ext_name cconv isDyn
  = 	-- BUILD THE returnIO WRAPPER, if necessary
	-- 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
	Just (ioTyCon, [res_ty])
	      -> ASSERT( getUnique ioTyCon == ioTyConKey )
			-- The function already returns IO t
		 returnDs (\body -> body, orig_res_ty, res_ty)

	other -> 	-- The function returns t, so wrap the call in returnIO
		 dsLookupGlobalValue returnIO_NAME	`thenDs` \ retIOId ->
	         returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body],
		           funResultTy (applyTy (idType retIOId) orig_res_ty), 
				-- We don't have ioTyCon conveniently to hand
			   orig_res_ty)

     )		`thenDs` \ (return_io_wrapper, 	-- Either identity or returnIO
			    io_res_ty, 		-- IO t
			    res_ty) ->		-- t


	-- BUILD THE deRefStablePtr WRAPPER, if necessary
sof's avatar
sof committed
221
222
     (if isDyn then 
        newSysLocalDs stbl_ptr_ty			`thenDs` \ stbl_ptr ->
223
224
	newSysLocalDs stbl_ptr_to_ty			`thenDs` \ stbl_value ->
	dsLookupGlobalValue deRefStablePtr_NAME		`thenDs` \ deRefStablePtrId ->
sof's avatar
sof committed
225
	let
226
227
	 the_deref_app = mkApps (Var deRefStablePtrId)
				[ Type stbl_ptr_to_ty, Var stbl_ptr ]
sof's avatar
sof committed
228
        in
229
230
        dsLookupGlobalValue bindIO_NAME			 `thenDs` \ bindIOId ->
	let
231
232
233
234
235
	 stbl_app cont = mkApps (Var bindIOId)
				[ Type stbl_ptr_to_ty
				, Type res_ty
				, the_deref_app
				, mkLams [stbl_value] cont]
236
237
        in
	returnDs (stbl_value, stbl_app, stbl_ptr)
sof's avatar
sof committed
238
239
240
241
      else
        returnDs (i, 
	          \ body -> body,
		  panic "stbl_ptr"  -- should never be touched.
242
		  ))			`thenDs` \ (i, getFun_wrapper, stbl_ptr) ->
sof's avatar
sof committed
243
244


245
	-- BUILD THE HELPER
246
     getModuleDs			`thenDs` \ mod -> 
247
     getUniqueDs			`thenDs` \ uniq ->
248
249
     getSrcLocDs			`thenDs` \ src_loc ->
     newSysLocalsDs fe_arg_tys		`thenDs` \ fe_args ->
sof's avatar
sof committed
250
     let
251
252
        wrapper_args | isDyn      = stbl_ptr:fe_args
		     | otherwise  = fe_args
sof's avatar
sof committed
253

254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
        wrapper_arg_tys | isDyn      = stbl_ptr_ty:fe_arg_tys
		        | otherwise  = fe_arg_tys

	helper_ty =  mkForAllTys tvs $
		     mkFunTys wrapper_arg_tys io_res_ty

	f_helper_glob = mkVanillaId helper_name helper_ty
		      where
			name	            = idName i
			mod	
			 | isLocalName name = mod_name
			 | otherwise        = nameModule name

			occ	            = mkForeignExportOcc (nameOccName name)
			prov	            = LocalDef src_loc Exported
			helper_name         = mkGlobalName uniq mod occ prov

      	the_app = getFun_wrapper (return_io_wrapper (mkVarApps (Var i) (tvs ++ fe_args)))
      	the_body = mkLams (tvs ++ wrapper_args) the_app
      	c_nm     = extNameStatic ext_name
  
      	(h_stub, c_stub) = fexportEntry (moduleUserString mod)
sof's avatar
sof committed
276
      				      c_nm f_helper_glob
277
                                      wrapper_arg_tys res_ty cconv isDyn
sof's avatar
sof committed
278
     in
279
280
     returnDs (NonRec f_helper_glob the_body, h_stub, c_stub)

sof's avatar
sof committed
281
  where
282
   (tvs,sans_foralls)			= splitForAllTys ty
283
   (fe_arg_tys', orig_res_ty)	        = splitFunTys sans_foralls
sof's avatar
sof committed
284
285
286
287

   (_, stbl_ptr_ty')			= splitForAllTys stbl_ptr_ty
   (_, stbl_ptr_to_ty)			= splitAppTy stbl_ptr_ty'

288
289
290
291
292
   fe_arg_tys | isDyn	  = tail fe_arg_tys'
	      | otherwise = fe_arg_tys'

   stbl_ptr_ty | isDyn     = head fe_arg_tys'
	       | otherwise = error "stbl_ptr_ty"
sof's avatar
sof committed
293
294
\end{code}

295
@foreign export dynamic@ lets you dress up Haskell IO actions
sof's avatar
sof committed
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
of some fixed type behind an externally callable interface (i.e.,
as a C function pointer). Useful for callbacks and stuff.

\begin{verbatim}
foreign export stdcall f :: (Addr -> Int -> IO Int) -> IO Addr

-- Haskell-visible constructor, which is generated from the
-- above:

f :: (Addr -> Int -> IO Int) -> IO Addr
f cback = IO ( \ s1# ->
  case makeStablePtr# cback s1# of { StateAndStablePtr# s2# sp# ->
  case _ccall_ "mkAdjustor" sp# ``f_helper'' s2# of
    StateAndAddr# s3# a# ->
    case addr2Int# a# of
      0# -> IOfail s# err
      _  -> 
	 let
	  a :: Addr
	  a = A# a#
	 in
         IOok s3# a)

foreign export "f_helper" f_helper :: StablePtr (Addr -> Int -> IO Int) -> Addr -> Int -> IO Int
-- `special' foreign export that invokes the closure pointed to by the
-- first argument.
\end{verbatim}

\begin{code}
dsFExportDynamic :: Id
		 -> Type		-- Type of foreign export.
sof's avatar
sof committed
327
		 -> Module
sof's avatar
sof committed
328
329
		 -> ExtName
		 -> CallConv
330
		 -> DsM (CoreBind, CoreBind, SDoc, SDoc)
sof's avatar
sof committed
331
dsFExportDynamic i ty mod_name ext_name cconv =
sof's avatar
sof committed
332
333
334
     newSysLocalDs ty					 `thenDs` \ fe_id ->
     let 
        -- hack: need to get at the name of the C stub we're about to generate.
335
       fe_nm	   = toCName fe_id
sof's avatar
sof committed
336
337
       fe_ext_name = ExtName (_PK_ fe_nm) Nothing
     in
338
339
     dsFExport  i export_ty mod_name fe_ext_name cconv True
     `thenDs` \ (fe@(NonRec fe_helper fe_expr), h_code, c_code) ->
340
341
     newSysLocalDs arg_ty			`thenDs` \ cback ->
     dsLookupGlobalValue makeStablePtr_NAME	`thenDs` \ makeStablePtrId ->
sof's avatar
sof committed
342
     let
343
	mk_stbl_ptr_app    = mkApps (Var makeStablePtrId) [ Type arg_ty, Var cback ]
sof's avatar
sof committed
344
     in
345
346
     dsLookupGlobalValue bindIO_NAME		        `thenDs` \ bindIOId ->
     newSysLocalDs (mkTyConApp stablePtrTyCon [arg_ty]) `thenDs` \ stbl_value ->
sof's avatar
sof committed
347
     let
348
349
350
351
352
353
354
      stbl_app cont ret_ty 
	= mkApps (Var bindIOId)
		 [ Type (mkTyConApp stablePtrTyCon [arg_ty])
		 , Type ret_ty
		 , mk_stbl_ptr_app
		 , cont
		 ]
355
356
357
358
359
360
361
362

       {-
        The arguments to the external function which will
	create a little bit of (template) code on the fly
	for allowing the (stable pointed) Haskell closure
	to be entered using an external calling convention
	(stdcall, ccall).
       -}
363
      adj_args      = [ mkIntLitInt (callConvToInt cconv)
364
365
366
367
368
369
370
		      , Var stbl_value
		      , mkLit (MachLitLit (_PK_ fe_nm) addrPrimTy)
		      ]
        -- name of external entry point providing these services.
	-- (probably in the RTS.) 
      adjustor	    = SLIT("createAdjustor")
     in
371
     dsCCall adjustor adj_args False False ioAddrTy `thenDs` \ ccall_adj ->
372
     let ccall_adj_ty = exprType ccall_adj
373
374
375
         ccall_io_adj = mkLams [stbl_value]		     $
			Note (Coerce io_res_ty (unUsgTy ccall_adj_ty))
			     ccall_adj
376
377
378
     in
     let io_app = mkLams tvs	 $
		  mkLams [cback] $
379
		  stbl_app ccall_io_adj addrTy
380
381
382
     in
     returnDs (NonRec i io_app, fe, h_code, c_code)

sof's avatar
sof committed
383
384
 where
  (tvs,sans_foralls)		   = splitForAllTys ty
385
  ([arg_ty], io_res_ty)		   = splitFunTys sans_foralls
sof's avatar
sof committed
386

387
  Just (ioTyCon, [res_ty])	   = splitTyConApp_maybe io_res_ty
sof's avatar
sof committed
388
389
390

  export_ty			   = mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty

391
392
393
  ioAddrTy :: Type	-- IO Addr
  ioAddrTy = mkTyConApp ioTyCon [addrTy]

sof's avatar
sof committed
394
395
396
397
398
399
400
401
402
403
toCName :: Id -> String
toCName i = showSDoc (pprCode CStyle (ppr (idName i)))
\end{code}

%*
%
\subsection{Generating @foreign export@ stubs}
%
%*

404
405
406
For each @foreign export@ function, a C stub function is generated.
The C stub constructs the application of the exported Haskell function 
using the hugs/ghc rts invocation API.
sof's avatar
sof committed
407
408

\begin{code}
sof's avatar
sof committed
409
410
fexportEntry :: String
	     -> FAST_STRING
sof's avatar
sof committed
411
412
	     -> Id 
	     -> [Type] 
413
	     -> Type 
sof's avatar
sof committed
414
415
416
	     -> CallConv 
	     -> Bool
	     -> (SDoc, SDoc)
417
fexportEntry mod_nm c_nm helper args res_ty cc isDyn = (header_bits, c_bits)
sof's avatar
sof committed
418
419
 where
   -- name of the (Haskell) helper function generated by the desugarer.
420
421
422
  h_nm	    = ppr helper <> text "_closure"
   -- prototype for the exported function.
  header_bits = ptext SLIT("extern") <+> fun_proto <> semi
sof's avatar
sof committed
423

424
  fun_proto = cResType <+> pprCconv <+> ptext c_nm <>
sof's avatar
sof committed
425
	      parens (hsep (punctuate comma (zipWith (<+>) cParamTypes proto_args)))
sof's avatar
sof committed
426

427
428
429
  c_bits =
    externDecl $$
    fun_proto  $$
sof's avatar
sof committed
430
    vcat 
431
432
433
434
435
436
     [ lbrace
     ,   text "SchedulerStatus rc;"
     ,   declareResult
	  -- create the application + perform it.
     ,   text "rc=rts_evalIO" <> 
                  parens (foldl appArg (text "(StgClosure*)&" <> h_nm) (zip args c_args) <> comma <> text "&ret") <> semi
437
438
439
     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (text mod_nm <> char '.' <> ptext c_nm) 
						<> comma <> text "rc") <> semi
     ,   text "return" <> return_what <> semi
440
441
     , rbrace
     ]
sof's avatar
sof committed
442

443
444
  appArg acc (a,c_a) =
     text "rts_apply" <> parens (acc <> comma <> mkHObj a <> parens c_a)
sof's avatar
sof committed
445

sof's avatar
sof committed
446
  cParamTypes  = map showStgType real_args
sof's avatar
sof committed
447

448
449
450
451
  res_ty_is_unit = res_ty == unitTy

  cResType | res_ty_is_unit = text "void"
	   | otherwise	    = showStgType res_ty
sof's avatar
sof committed
452
453
454
455
456

  pprCconv
   | cc == cCallConv = empty
   | otherwise	     = pprCallConv cc
     
457
  declareResult  = text "HaskellObj ret;"
sof's avatar
sof committed
458

459
  externDecl     = mkExtern (text "HaskellObj") h_nm
sof's avatar
sof committed
460

461
  mkExtern ty nm = text "extern" <+> ty <+> nm <> semi
sof's avatar
sof committed
462

463
464
  return_what | res_ty_is_unit = empty
	      | otherwise      = parens (unpackHObj res_ty <> parens (text "ret"))
sof's avatar
sof committed
465

sof's avatar
sof committed
466
467
468
469
470
471
472
473
474
475
476
477
478
479
  c_args = mkCArgNames 0 args

  {-
   If we're generating an entry point for a 'foreign export ccall dynamic',
   then we receive the return address of the C function that wants to
   invoke a Haskell function as any other C function, as second arg.
   This arg is unused within the body of the generated C stub, but
   needed by the Adjustor.c code to get the stack cleanup right.
  -}
  (proto_args, real_args)
    | cc == cCallConv && isDyn = ( text "a0" : text "a_" : mkCArgNames 1 (tail args)
				, head args : addrTy : tail args)
    | otherwise = (mkCArgNames 0 args, args)

sof's avatar
sof committed
480
481
mkCArgNames :: Int -> [a] -> [SDoc]
mkCArgNames n as = zipWith (\ _ n -> text ('a':show n)) as [n..] 
sof's avatar
sof committed
482

483
mkHObj :: Type -> SDoc
sof's avatar
sof committed
484
mkHObj t = text "rts_mk" <> text (showFFIType t)
sof's avatar
sof committed
485

486
unpackHObj :: Type -> SDoc
sof's avatar
sof committed
487
unpackHObj t = text "rts_get" <> text (showFFIType t)
488
489

showStgType :: Type -> SDoc
sof's avatar
sof committed
490
showStgType t = text "Stg" <> text (showFFIType t)
sof's avatar
sof committed
491

sof's avatar
sof committed
492
493
showFFIType :: Type -> String
showFFIType t = getOccString (getName tc)
494
495
496
497
498
 where
  tc = case splitTyConApp_maybe t of
	    Just (tc,_) -> tc
	    Nothing	-> pprPanic "showFFIType" (ppr t)
\end{code}