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

18
import HsSyn		( ForeignDecl(..), FoExport(..), FoImport(..)  )
19
import TcHsSyn		( TypecheckedForeignDecl )
20
import CoreUtils	( exprType, mkInlineMe )
21
import Id		( Id, idType, idName, mkVanillaGlobal, mkSysLocal,
22
			  setInlinePragma )
23
import IdInfo		( neverInlinePrag, vanillaIdInfo )
24
import Literal		( Literal(..) )
sof's avatar
sof committed
25
import Module		( Module, moduleUserString )
26
import Name		( mkGlobalName, nameModule, nameOccName, getOccString, 
sof's avatar
sof committed
27
			  mkForeignExportOcc, isLocalName,
28
			  NamedThing(..),
29
			)
30
31
32
33
34

	-- Import Type not TcType; in this module we are generating code
	-- to marshal representation types across to C
import Type		( splitTyConApp_maybe, funResultTy,
			  splitFunTys, splitForAllTys, splitAppTy, 
35
			  Type, mkFunTys, mkForAllTys, mkTyConApp,
36
			  mkFunTy, applyTy, eqType, repType
sof's avatar
sof committed
37
			)
sof's avatar
sof committed
38
39
40
41
import TcType		( tcSplitForAllTys, tcSplitFunTys,
			  tcSplitTyConApp_maybe, tcSplitAppTy,
			  tcFunResultTy
			)
42

43
44
import ForeignCall	( ForeignCall(..), CCallSpec(..), 
			  Safety(..), playSafe,
45
			  CExportSpec(..),
46
47
			  CCallConv(..), ccallConvToInt
			)
48
import CStrings		( CLabelString )
49
import TysWiredIn	( addrTy, unitTy, stablePtrTyCon )
50
import TysPrim		( addrPrimTy )
51
52
import PrelNames	( hasKey, ioTyConKey, deRefStablePtrName, newStablePtrName,
			  bindIOName, returnIOName
53
			)
sof's avatar
sof committed
54
import Outputable
55
56

import Maybe 		( fromJust )
sof's avatar
sof committed
57
58
59
60
\end{code}

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

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

sof's avatar
sof committed
76
77
dsForeigns :: Module
           -> [TypecheckedForeignDecl] 
78
79
80
	   -> DsM ( [Id]		-- Foreign-exported binders; 
					-- we have to generate code to register these
		  , [Binding]
81
82
83
84
		  , SDoc	      -- Header file prototypes for
                                      -- "foreign exported" functions.
		  , SDoc 	      -- C stubs to use when calling
                                      -- "foreign exported" functions.
sof's avatar
sof committed
85
		  )
86
87
dsForeigns mod_name fos
  = foldlDs combine ([], [], empty, empty) fos
sof's avatar
sof committed
88
 where
89
90
91
92
93
94
95
  combine (acc_feb, acc_f, acc_h, acc_c) (ForeignImport id _ spec _) 
    = dsFImport mod_name id spec	`thenDs` \ (bs, h, c) -> 
      returnDs (acc_feb, bs ++ acc_f, h $$ acc_h, c $$ acc_c)

  combine (acc_feb, acc_f, acc_h, acc_c) (ForeignExport id _ (CExport (CExportStatic ext_nm cconv)) _)
    = dsFExport mod_name id (idType id) ext_nm cconv False	`thenDs` \ (feb, b, h, c) ->
      returnDs (feb:acc_feb, b : acc_f, h $$ acc_h, c $$ acc_c)
sof's avatar
sof committed
96
97
\end{code}

98
99
100
101
102
103
104

%************************************************************************
%*									*
\subsection{Foreign import}
%*									*
%************************************************************************

sof's avatar
sof committed
105
106
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
\begin{code}
125
126
127
128
129
dsFImport :: Module
	  -> Id
	  -> FoImport
	  -> DsM ([Binding], SDoc, SDoc)
dsFImport mod_name lbl_id (LblImport ext_nm) 
130
 = ASSERT(fromJust res_ty `eqType` addrPrimTy) -- typechecker ensures this
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
   returnDs ([(lbl_id, rhs)], empty, empty)
 where
   (res_ty, fo_rhs) = resultWrapper (idType lbl_id)
   rhs		    = fo_rhs (mkLit (MachLabel ext_nm))

dsFImport mod_name fn_id (CImport spec)     = dsFCall mod_name fn_id (CCall spec)
dsFImport mod_name fn_id (DNImport spec)    = dsFCall mod_name fn_id (DNCall spec)
dsFImport mod_name fn_id (CDynImport cconv) = dsFExportDynamic mod_name fn_id cconv
\end{code}


%************************************************************************
%*									*
\subsection{Foreign calls}
%*									*
%************************************************************************

\begin{code}
dsFCall mod_Name fn_id fcall
150
  = let
151
	ty		     = idType fn_id
sof's avatar
sof committed
152
153
	(tvs, fun_ty)        = tcSplitForAllTys ty
	(arg_tys, io_res_ty) = tcSplitFunTys fun_ty
sof's avatar
sof committed
154
    in
155
    newSysLocalsDs arg_tys  			`thenDs` \ args ->
156
    mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
157

158
159
160
    let
	work_arg_ids  = [v | Var v <- val_args]	-- All guaranteed to be vars

161
	-- These are the ids we pass to boxResult, which are used to decide
162
163
	-- whether to touch# an argument after the call (used to keep
	-- ForeignObj#s live across a 'safe' foreign import).
164
165
	maybe_arg_ids | unsafe_call fcall = work_arg_ids
		      | otherwise	  = []
166
    in
167
    boxResult maybe_arg_ids io_res_ty  		`thenDs` \ (ccall_result_ty, res_wrapper) ->
168
169
170

    getUniqueDs					`thenDs` \ ccall_uniq ->
    getUniqueDs					`thenDs` \ work_uniq ->
sof's avatar
sof committed
171
    let
172
173
	-- Build the worker
	worker_ty     = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
174
 	the_ccall_app = mkFCall ccall_uniq fcall val_args ccall_result_ty
175
	work_rhs      = mkLams tvs (mkLams work_arg_ids the_ccall_app)
176
	work_id       = mkSysLocal SLIT("$wccall") work_uniq worker_ty
177
178
179
180

	-- Build the wrapper
	work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args
	wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
181
        wrap_rhs     = mkInlineMe (mkLams (tvs ++ args) wrapper_body)
sof's avatar
sof committed
182
    in
183
184
185
186
    returnDs ([(work_id, work_rhs), (fn_id, wrap_rhs)], empty, empty)

unsafe_call (CCall (CCallSpec _ _ safety)) = playSafe safety
unsafe_call (DNCall _)			   = False
187
188
\end{code}

sof's avatar
sof committed
189

190
191
192
193
194
%************************************************************************
%*									*
\subsection{Foreign export}
%*									*
%************************************************************************
sof's avatar
sof committed
195

196
197
The function that does most of the work for `@foreign export@' declarations.
(see below for the boilerplate code a `@foreign export@' declaration expands
198
 into.)
sof's avatar
sof committed
199

200
201
202
203
204
205
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@'.
206

sof's avatar
sof committed
207
\begin{code}
208
209
210
211
212
dsFExport :: Module
	  -> Id			-- Either the exported Id, 
				-- or the foreign-export-dynamic constructor
	  -> Type		-- The type of the thing callable from C
	  -> CLabelString	-- The name to export to C land
213
	  -> CCallConv
214
215
216
	  -> Bool		-- True => foreign export dynamic
				-- 	   so invoke IO action that's hanging off 
				-- 	   the first argument's stable pointer
217
218
	  -> DsM ( Id		-- The foreign-exported Id
		 , Binding
219
220
221
		 , SDoc
		 , SDoc
		 )
222
dsFExport mod_name fn_id ty ext_name cconv isDyn
223
224
225
226
  = 	-- 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)
sof's avatar
sof committed
227
     (case tcSplitTyConApp_maybe orig_res_ty of
228
	Just (ioTyCon, [res_ty])
229
	      -> ASSERT( ioTyCon `hasKey` ioTyConKey )
230
231
232
233
			-- 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
234
		 dsLookupGlobalValue returnIOName	`thenDs` \ retIOId ->
235
	         returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body],
sof's avatar
sof committed
236
		           tcFunResultTy (applyTy (idType retIOId) orig_res_ty), 
237
238
239
240
241
242
243
244
245
				-- 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
246
247
     (if isDyn then 
        newSysLocalDs stbl_ptr_ty			`thenDs` \ stbl_ptr ->
248
	newSysLocalDs stbl_ptr_to_ty			`thenDs` \ stbl_value ->
249
250
	dsLookupGlobalValue deRefStablePtrName		`thenDs` \ deRefStablePtrId ->
        dsLookupGlobalValue bindIOName			`thenDs` \ bindIOId ->
sof's avatar
sof committed
251
	let
252
253
	 the_deref_app = mkApps (Var deRefStablePtrId)
				[ Type stbl_ptr_to_ty, Var stbl_ptr ]
254

255
256
257
258
259
	 stbl_app cont = mkApps (Var bindIOId)
				[ Type stbl_ptr_to_ty
				, Type res_ty
				, the_deref_app
				, mkLams [stbl_value] cont]
260
261
        in
	returnDs (stbl_value, stbl_app, stbl_ptr)
sof's avatar
sof committed
262
      else
263
        returnDs (fn_id, 
sof's avatar
sof committed
264
265
	          \ body -> body,
		  panic "stbl_ptr"  -- should never be touched.
266
		  ))			`thenDs` \ (i, getFun_wrapper, stbl_ptr) ->
sof's avatar
sof committed
267
268


269
	-- BUILD THE HELPER
270
     getModuleDs			`thenDs` \ mod -> 
271
     getUniqueDs			`thenDs` \ uniq ->
272
273
     getSrcLocDs			`thenDs` \ src_loc ->
     newSysLocalsDs fe_arg_tys		`thenDs` \ fe_args ->
sof's avatar
sof committed
274
     let
275
276
        wrapper_args | isDyn      = stbl_ptr:fe_args
		     | otherwise  = fe_args
sof's avatar
sof committed
277

278
279
280
281
282
283
        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

284
	f_helper_glob = mkVanillaGlobal helper_name helper_ty vanillaIdInfo
285
		      where
286
			name	            = idName fn_id
287
288
289
290
291
			mod	
			 | isLocalName name = mod_name
			 | otherwise        = nameModule name

			occ	            = mkForeignExportOcc (nameOccName name)
292
			helper_name         = mkGlobalName uniq mod occ src_loc
293
294
295
296
297

      	the_app = getFun_wrapper (return_io_wrapper (mkVarApps (Var i) (tvs ++ fe_args)))
      	the_body = mkLams (tvs ++ wrapper_args) the_app
  
      	(h_stub, c_stub) = fexportEntry (moduleUserString mod)
298
299
      				      	ext_name f_helper_glob
                                      	wrapper_arg_tys res_ty cconv isDyn
sof's avatar
sof committed
300
     in
301
     returnDs (f_helper_glob, (f_helper_glob, the_body), h_stub, c_stub)
302

sof's avatar
sof committed
303
  where
sof's avatar
sof committed
304
305
   (tvs,sans_foralls)		= tcSplitForAllTys ty
   (fe_arg_tys', orig_res_ty)	= tcSplitFunTys sans_foralls
sof's avatar
sof committed
306

sof's avatar
sof committed
307
308
   (_, stbl_ptr_ty')		= tcSplitForAllTys stbl_ptr_ty
   (_, stbl_ptr_to_ty)		= tcSplitAppTy stbl_ptr_ty'
sof's avatar
sof committed
309

310
311
312
313
314
   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
315
316
\end{code}

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

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

324
325
-- Haskell-visible constructor, which is generated from the above:
-- SUP: No check for NULL from createAdjustor anymore???
sof's avatar
sof committed
326
327

f :: (Addr -> Int -> IO Int) -> IO Addr
328
f cback =
329
   bindIO (newStablePtr cback)
330
331
332
          (\StablePtr sp# -> IO (\s1# ->
              case _ccall_ createAdjustor cconv sp# ``f_helper'' s1# of
                 (# s2#, a# #) -> (# s2#, A# a# #)))
sof's avatar
sof committed
333
334
335
336
337
338
339

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}
340
341
dsFExportDynamic :: Module
		 -> Id
342
		 -> CCallConv
343
344
345
		 -> DsM ([Binding], SDoc, SDoc)
dsFExportDynamic mod_name id cconv
  =  newSysLocalDs ty					 `thenDs` \ fe_id ->
sof's avatar
sof committed
346
347
     let 
        -- hack: need to get at the name of the C stub we're about to generate.
348
       fe_nm	   = _PK_ (moduleUserString mod_name ++ "_" ++ toCName fe_id)
sof's avatar
sof committed
349
     in
350
351
352
     dsFExport mod_name id export_ty fe_nm cconv True  	`thenDs` \ (feb, fe, h_code, c_code) ->
     newSysLocalDs arg_ty				`thenDs` \ cback ->
     dsLookupGlobalValue newStablePtrName		`thenDs` \ newStablePtrId ->
sof's avatar
sof committed
353
     let
354
	mk_stbl_ptr_app    = mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ]
sof's avatar
sof committed
355
     in
356
     dsLookupGlobalValue bindIOName		        `thenDs` \ bindIOId ->
357
     newSysLocalDs (mkTyConApp stablePtrTyCon [arg_ty]) `thenDs` \ stbl_value ->
sof's avatar
sof committed
358
     let
359
360
361
362
363
364
365
      stbl_app cont ret_ty 
	= mkApps (Var bindIOId)
		 [ Type (mkTyConApp stablePtrTyCon [arg_ty])
		 , Type ret_ty
		 , mk_stbl_ptr_app
		 , cont
		 ]
366
367
368
369
370
371
372
373

       {-
        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).
       -}
374
      adj_args      = [ mkIntLitInt (ccallConvToInt cconv)
375
		      , Var stbl_value
376
		      , mkLit (MachLabel fe_nm)
377
378
379
380
381
		      ]
        -- name of external entry point providing these services.
	-- (probably in the RTS.) 
      adjustor	    = SLIT("createAdjustor")
     in
382
383
     dsCCall adjustor adj_args PlayRisky False io_res_ty	`thenDs` \ ccall_adj ->
	-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
384
     let ccall_adj_ty = exprType ccall_adj
385
         ccall_io_adj = mkLams [stbl_value]		     $
386
			Note (Coerce io_res_ty ccall_adj_ty)
387
			     ccall_adj
388
         io_app = mkLams tvs	 $
389
		  mkLams [cback] $
390
		  stbl_app ccall_io_adj res_ty
391
	 fed = (id `setInlinePragma` neverInlinePrag, io_app)
392
393
		-- Never inline the f.e.d. function, because the litlit
		-- might not be in scope in other modules.
394
     in
395
     returnDs ([fed, fe], h_code, c_code)
396

sof's avatar
sof committed
397
 where
398
  ty				   = idType id
sof's avatar
sof committed
399
400
401
  (tvs,sans_foralls)		   = tcSplitForAllTys ty
  ([arg_ty], io_res_ty)		   = tcSplitFunTys sans_foralls
  Just (ioTyCon, [res_ty])	   = tcSplitTyConApp_maybe io_res_ty
sof's avatar
sof committed
402
403
404
405
406
407
408
409
410
411
412
413
  export_ty			   = mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty

toCName :: Id -> String
toCName i = showSDoc (pprCode CStyle (ppr (idName i)))
\end{code}

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

414
415
416
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
417
418

\begin{code}
sof's avatar
sof committed
419
420
fexportEntry :: String
	     -> FAST_STRING
sof's avatar
sof committed
421
422
	     -> Id 
	     -> [Type] 
423
	     -> Type 
424
	     -> CCallConv 
sof's avatar
sof committed
425
426
	     -> Bool
	     -> (SDoc, SDoc)
427
fexportEntry mod_nm c_nm helper args res_ty cc isDyn = (header_bits, c_bits)
sof's avatar
sof committed
428
429
 where
   -- name of the (Haskell) helper function generated by the desugarer.
430
431
432
  h_nm	    = ppr helper <> text "_closure"
   -- prototype for the exported function.
  header_bits = ptext SLIT("extern") <+> fun_proto <> semi
sof's avatar
sof committed
433

434
  fun_proto = cResType <+> pprCconv <+> ptext c_nm <>
sof's avatar
sof committed
435
	      parens (hsep (punctuate comma (zipWith (<+>) cParamTypes proto_args)))
sof's avatar
sof committed
436

437
438
439
  c_bits =
    externDecl $$
    fun_proto  $$
sof's avatar
sof committed
440
    vcat 
441
442
443
444
445
446
     [ 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
447
     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ptext c_nm)
448
449
						<> comma <> text "rc") <> semi
     ,   text "return" <> return_what <> semi
450
451
     , rbrace
     ]
sof's avatar
sof committed
452

453
454
  appArg acc (a,c_a) =
     text "rts_apply" <> parens (acc <> comma <> mkHObj a <> parens c_a)
sof's avatar
sof committed
455

sof's avatar
sof committed
456
  cParamTypes  = map showStgType real_args
sof's avatar
sof committed
457

458
  res_ty_is_unit = res_ty `eqType` unitTy
459
460
461

  cResType | res_ty_is_unit = text "void"
	   | otherwise	    = showStgType res_ty
sof's avatar
sof committed
462

463
464
465
  pprCconv = case cc of
		CCallConv   -> empty
		StdCallConv -> ppr cc
sof's avatar
sof committed
466
     
467
  declareResult  = text "HaskellObj ret;"
sof's avatar
sof committed
468

469
  externDecl     = mkExtern (text "HaskellObj") h_nm
sof's avatar
sof committed
470

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

473
474
  return_what | res_ty_is_unit = empty
	      | otherwise      = parens (unpackHObj res_ty <> parens (text "ret"))
sof's avatar
sof committed
475

sof's avatar
sof committed
476
477
478
479
480
481
482
483
484
485
  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)
486
487
488
489
    = case cc of
	CCallConv | isDyn -> ( text "a0" : text "a_" : mkCArgNames 1 (tail args)
			     , head args : addrTy : tail args)
        other		  -> (mkCArgNames 0 args, args)
sof's avatar
sof committed
490

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

494
mkHObj :: Type -> SDoc
sof's avatar
sof committed
495
mkHObj t = text "rts_mk" <> text (showFFIType t)
sof's avatar
sof committed
496

497
unpackHObj :: Type -> SDoc
sof's avatar
sof committed
498
unpackHObj t = text "rts_get" <> text (showFFIType t)
499
500

showStgType :: Type -> SDoc
501
showStgType t = text "Hs" <> text (showFFIType t)
sof's avatar
sof committed
502

sof's avatar
sof committed
503
showFFIType :: Type -> String
504
505
showFFIType t = getOccString (getName tc)
 where
506
  tc = case splitTyConApp_maybe (repType t) of
507
508
	    Just (tc,_) -> tc
	    Nothing	-> pprPanic "showFFIType" (ppr t)
509
\end{code}