DsForeign.lhs 16 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, resultWrapper )
sof's avatar
sof committed
16
17
import DsMonad

18
19
import HsSyn		( ExtName(..), ForeignDecl(..), isDynamicExtName, ForKind(..) )
import HsDecls		( extNameStatic )
sof's avatar
sof committed
20
import CallConv
21
import TcHsSyn		( TypecheckedForeignDecl )
22
import CoreUtils	( exprType, mkInlineMe )
23
import Id		( Id, idType, idName, mkVanillaId, mkSysLocal,
24
25
			  setInlinePragma )
import IdInfo		( neverInlinePrag )
26
import Literal		( Literal(..) )
sof's avatar
sof committed
27
import Module		( Module, moduleUserString )
28
import Name		( mkGlobalName, nameModule, nameOccName, getOccString, 
sof's avatar
sof committed
29
			  mkForeignExportOcc, isLocalName,
30
			  NamedThing(..),
31
			)
32
import Type		( unUsgTy, repType,
sof's avatar
sof committed
33
			  splitTyConApp_maybe, splitFunTys, splitForAllTys,
34
			  Type, mkFunTys, mkForAllTys, mkTyConApp,
35
			  mkTyVarTy, mkFunTy, splitAppTy, applyTy, funResultTy
sof's avatar
sof committed
36
			)
37
38
import PrimOp		( PrimOp(..), CCall(..), 
			  CCallTarget(..), dynamicTarget )
39
import TysWiredIn	( unitTy, addrTy, stablePtrTyCon,
40
			  addrDataCon
sof's avatar
sof committed
41
			)
42
import TysPrim		( addrPrimTy )
43
import PrelNames	( Uniquable(..), hasKey,
44
45
			  ioTyConKey, deRefStablePtrIdKey, returnIOIdKey, 
			  bindIOIdKey, makeStablePtrIdKey
46
			)
sof's avatar
sof committed
47
import Outputable
48
49

import Maybe 		( fromJust )
sof's avatar
sof committed
50
51
52
53
\end{code}

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

\begin{code}
66
67
68
type Binding = (Id, CoreExpr)	-- No rec/nonrec structure;
				-- the occurrence analyser will sort it all out

sof's avatar
sof committed
69
70
dsForeigns :: Module
           -> [TypecheckedForeignDecl] 
71
72
73
	   -> DsM ( [Id]		-- Foreign-exported binders; 
					-- we have to generate code to register these
		  , [Binding]
74
75
76
77
		  , SDoc	      -- Header file prototypes for
                                      -- "foreign exported" functions.
		  , SDoc 	      -- C stubs to use when calling
                                      -- "foreign exported" functions.
sof's avatar
sof committed
78
		  )
79
dsForeigns mod_name fos = foldlDs combine ([], [], empty, empty) fos
sof's avatar
sof committed
80
 where
81
  combine (acc_feb, acc_f, acc_h, acc_c) fo@(ForeignDecl i imp_exp _ ext_nm cconv _) 
82
    | isForeignImport =   -- foreign import (dynamic)?
83
        dsFImport i (idType i) uns ext_nm cconv  `thenDs` \ bs -> 
84
	returnDs (acc_feb, bs ++ acc_f, acc_h, acc_c)
sof's avatar
sof committed
85
    | isForeignLabel = 
86
        dsFLabel i (idType i) ext_nm `thenDs` \ b -> 
87
	returnDs (acc_feb, b:acc_f, acc_h, acc_c)
88
    | isDynamicExtName ext_nm =
89
90
        dsFExportDynamic i (idType i) mod_name ext_nm cconv  `thenDs` \ (feb,bs,h,c) -> 
	returnDs (feb:acc_feb, bs ++ acc_f, h $$ acc_h, c $$ acc_c)
sof's avatar
sof committed
91

92
    | otherwise	       =  -- foreign export
93
94
        dsFExport i (idType i) mod_name ext_nm cconv False   `thenDs` \ (feb,fe,h,c) ->
	returnDs (feb:acc_feb, fe:acc_f, h $$ acc_h, c $$ acc_c)
sof's avatar
sof committed
95
   where
sof's avatar
sof committed
96
97
98
99
100
101
102
103
104
105
106
    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
107
108
109
110
111

\end{code}

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

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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
129
130
131
132
133
134
\begin{code}
dsFImport :: Id
	  -> Type		-- Type of foreign import.
	  -> Bool		-- True <=> might cause Haskell GC
	  -> ExtName
	  -> CallConv
135
	  -> DsM [Binding]
136
137
dsFImport fn_id ty may_not_gc ext_name cconv 
  = let
138
139
	(tvs, fun_ty)        = splitForAllTys ty
	(arg_tys, io_res_ty) = splitFunTys fun_ty
sof's avatar
sof committed
140
    in
141
    newSysLocalsDs arg_tys  			`thenDs` \ args ->
142
143
    mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
    boxResult io_res_ty				`thenDs` \ (ccall_result_ty, res_wrapper) ->
144
145
146

    getUniqueDs						`thenDs` \ ccall_uniq ->
    getUniqueDs						`thenDs` \ work_uniq ->
sof's avatar
sof committed
147
    let
148
149
150
151
	lbl = case ext_name of
		Dynamic	     -> dynamicTarget
	        ExtName fs _ -> StaticTarget fs

152
153
154
155
156
157
	-- 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)
158
	work_id       = mkSysLocal SLIT("$wccall") work_uniq worker_ty
159
160
161
162

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

168
Foreign labels 
sof's avatar
sof committed
169
170

\begin{code}
171
dsFLabel :: Id -> Type -> ExtName -> DsM Binding
172
173
dsFLabel nm ty ext_name = 
   ASSERT(fromJust res_ty == addrPrimTy) -- typechecker ensures this
174
   returnDs (nm, fo_rhs (mkLit (MachLabel enm)))
sof's avatar
sof committed
175
  where
176
   (res_ty, fo_rhs) = resultWrapper ty
177
   enm    = extNameStatic ext_name
sof's avatar
sof committed
178
179
\end{code}

180
181
The function that does most of the work for `@foreign export@' declarations.
(see below for the boilerplate code a `@foreign export@' declaration expands
182
 into.)
sof's avatar
sof committed
183

184
185
186
187
188
189
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@'.
190

sof's avatar
sof committed
191
192
193
\begin{code}
dsFExport :: Id
	  -> Type		-- Type of foreign export.
sof's avatar
sof committed
194
	  -> Module
sof's avatar
sof committed
195
196
197
198
	  -> ExtName
	  -> CallConv
	  -> Bool		-- True => invoke IO action that's hanging off 
				-- the first argument's stable pointer
199
200
	  -> DsM ( Id		-- The foreign-exported Id
		 , Binding
201
202
203
		 , SDoc
		 , SDoc
		 )
204
dsFExport fn_id ty mod_name ext_name cconv isDyn
205
206
207
208
209
210
  = 	-- 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])
211
	      -> ASSERT( ioTyCon `hasKey` ioTyConKey )
212
213
214
215
			-- 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
216
		 dsLookupGlobalValue returnIOIdKey	`thenDs` \ retIOId ->
217
218
219
220
221
222
223
224
225
226
227
	         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
228
229
     (if isDyn then 
        newSysLocalDs stbl_ptr_ty			`thenDs` \ stbl_ptr ->
230
	newSysLocalDs stbl_ptr_to_ty			`thenDs` \ stbl_value ->
231
232
	dsLookupGlobalValue deRefStablePtrIdKey		`thenDs` \ deRefStablePtrId ->
        dsLookupGlobalValue bindIOIdKey			`thenDs` \ bindIOId ->
sof's avatar
sof committed
233
	let
234
235
	 the_deref_app = mkApps (Var deRefStablePtrId)
				[ Type stbl_ptr_to_ty, Var stbl_ptr ]
236

237
238
239
240
241
	 stbl_app cont = mkApps (Var bindIOId)
				[ Type stbl_ptr_to_ty
				, Type res_ty
				, the_deref_app
				, mkLams [stbl_value] cont]
242
243
        in
	returnDs (stbl_value, stbl_app, stbl_ptr)
sof's avatar
sof committed
244
      else
245
        returnDs (fn_id, 
sof's avatar
sof committed
246
247
	          \ body -> body,
		  panic "stbl_ptr"  -- should never be touched.
248
		  ))			`thenDs` \ (i, getFun_wrapper, stbl_ptr) ->
sof's avatar
sof committed
249
250


251
	-- BUILD THE HELPER
252
     getModuleDs			`thenDs` \ mod -> 
253
     getUniqueDs			`thenDs` \ uniq ->
254
255
     getSrcLocDs			`thenDs` \ src_loc ->
     newSysLocalsDs fe_arg_tys		`thenDs` \ fe_args ->
sof's avatar
sof committed
256
     let
257
258
        wrapper_args | isDyn      = stbl_ptr:fe_args
		     | otherwise  = fe_args
sof's avatar
sof committed
259

260
261
262
263
264
265
266
267
        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
268
			name	            = idName fn_id
269
270
271
272
273
			mod	
			 | isLocalName name = mod_name
			 | otherwise        = nameModule name

			occ	            = mkForeignExportOcc (nameOccName name)
274
			helper_name         = mkGlobalName uniq mod occ src_loc
275
276
277
278
279
280

      	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
281
      				      c_nm f_helper_glob
282
                                      wrapper_arg_tys res_ty cconv isDyn
sof's avatar
sof committed
283
     in
284
     returnDs (f_helper_glob, (f_helper_glob, the_body), h_stub, c_stub)
285

sof's avatar
sof committed
286
  where
287
   (tvs,sans_foralls)			= splitForAllTys ty
288
   (fe_arg_tys', orig_res_ty)	        = splitFunTys sans_foralls
sof's avatar
sof committed
289
290
291
292

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

293
294
295
296
297
   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
298
299
\end{code}

300
@foreign export dynamic@ lets you dress up Haskell IO actions
sof's avatar
sof committed
301
302
303
304
of some fixed type behind an externally callable interface (i.e.,
as a C function pointer). Useful for callbacks and stuff.

\begin{verbatim}
305
foreign export dynamic f :: (Addr -> Int -> IO Int) -> IO Addr
sof's avatar
sof committed
306

307
308
-- Haskell-visible constructor, which is generated from the above:
-- SUP: No check for NULL from createAdjustor anymore???
sof's avatar
sof committed
309
310

f :: (Addr -> Int -> IO Int) -> IO Addr
311
312
313
314
315
f cback =
   bindIO (makeStablePtr cback)
          (\StablePtr sp# -> IO (\s1# ->
              case _ccall_ createAdjustor cconv sp# ``f_helper'' s1# of
                 (# s2#, a# #) -> (# s2#, A# a# #)))
sof's avatar
sof committed
316
317
318
319
320
321
322
323
324

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
325
		 -> Module
sof's avatar
sof committed
326
327
		 -> ExtName
		 -> CallConv
328
		 -> DsM (Id, [Binding], SDoc, SDoc)
sof's avatar
sof committed
329
dsFExportDynamic i ty mod_name ext_name cconv =
sof's avatar
sof committed
330
331
332
     newSysLocalDs ty					 `thenDs` \ fe_id ->
     let 
        -- hack: need to get at the name of the C stub we're about to generate.
333
       fe_nm	   = moduleUserString mod_name ++ "_" ++ toCName fe_id
sof's avatar
sof committed
334
335
       fe_ext_name = ExtName (_PK_ fe_nm) Nothing
     in
336
     dsFExport  i export_ty mod_name fe_ext_name cconv True
337
     	`thenDs` \ (feb, fe, h_code, c_code) ->
338
     newSysLocalDs arg_ty			`thenDs` \ cback ->
339
     dsLookupGlobalValue makeStablePtrIdKey	`thenDs` \ makeStablePtrId ->
sof's avatar
sof committed
340
     let
341
	mk_stbl_ptr_app    = mkApps (Var makeStablePtrId) [ Type arg_ty, Var cback ]
sof's avatar
sof committed
342
     in
343
     dsLookupGlobalValue bindIOIdKey		        `thenDs` \ bindIOId ->
344
     newSysLocalDs (mkTyConApp stablePtrTyCon [arg_ty]) `thenDs` \ stbl_value ->
sof's avatar
sof committed
345
     let
346
347
348
349
350
351
352
      stbl_app cont ret_ty 
	= mkApps (Var bindIOId)
		 [ Type (mkTyConApp stablePtrTyCon [arg_ty])
		 , Type ret_ty
		 , mk_stbl_ptr_app
		 , cont
		 ]
353
354
355
356
357
358
359
360

       {-
        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).
       -}
361
      adj_args      = [ mkIntLitInt (callConvToInt cconv)
362
		      , Var stbl_value
363
		      , mkLit (MachLabel (_PK_ fe_nm))
364
365
366
367
368
		      ]
        -- name of external entry point providing these services.
	-- (probably in the RTS.) 
      adjustor	    = SLIT("createAdjustor")
     in
369
     dsCCall adjustor adj_args False False io_res_ty `thenDs` \ ccall_adj ->
370
     let ccall_adj_ty = exprType ccall_adj
371
372
373
         ccall_io_adj = mkLams [stbl_value]		     $
			Note (Coerce io_res_ty (unUsgTy ccall_adj_ty))
			     ccall_adj
374
375
376
     in
     let io_app = mkLams tvs	 $
		  mkLams [cback] $
377
		  stbl_app ccall_io_adj res_ty
378
379
380
	 fed = (i `setInlinePragma` neverInlinePrag, io_app)
		-- Never inline the f.e.d. function, because the litlit
		-- might not be in scope in other modules.
381
     in
382
     returnDs (feb, [fed, fe], h_code, c_code)
383

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

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

  export_ty			   = mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty

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

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

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

405
406
407
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
408
409

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

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

428
429
430
  c_bits =
    externDecl $$
    fun_proto  $$
sof's avatar
sof committed
431
    vcat 
432
433
434
435
436
437
     [ 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
438
     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ptext c_nm)
439
440
						<> comma <> text "rc") <> semi
     ,   text "return" <> return_what <> semi
441
442
     , rbrace
     ]
sof's avatar
sof committed
443

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

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

449
450
451
452
  res_ty_is_unit = res_ty == unitTy

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

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

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

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

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

sof's avatar
sof committed
467
468
469
470
471
472
473
474
475
476
477
478
479
480
  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
481
482
mkCArgNames :: Int -> [a] -> [SDoc]
mkCArgNames n as = zipWith (\ _ n -> text ('a':show n)) as [n..] 
sof's avatar
sof committed
483

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

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

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

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