DsForeign.lhs 17 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		( repType, eqType )
import TcType		( Type, mkFunTys, mkForAllTys, mkTyConApp,
			  mkFunTy, applyTy, 
			  tcSplitForAllTys, tcSplitFunTys, tcTyConAppArgs,
sof's avatar
sof committed
35
36
37
			  tcSplitTyConApp_maybe, tcSplitAppTy,
			  tcFunResultTy
			)
38

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

import Maybe 		( fromJust )
sof's avatar
sof committed
53
54
55
56
\end{code}

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

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

sof's avatar
sof committed
72
73
dsForeigns :: Module
           -> [TypecheckedForeignDecl] 
74
75
76
	   -> DsM ( [Id]		-- Foreign-exported binders; 
					-- we have to generate code to register these
		  , [Binding]
77
78
79
80
		  , SDoc	      -- Header file prototypes for
                                      -- "foreign exported" functions.
		  , SDoc 	      -- C stubs to use when calling
                                      -- "foreign exported" functions.
sof's avatar
sof committed
81
		  )
82
83
dsForeigns mod_name fos
  = foldlDs combine ([], [], empty, empty) fos
sof's avatar
sof committed
84
 where
85
86
87
88
89
90
91
  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
92
93
\end{code}

94
95
96
97
98
99
100

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

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

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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
120
\begin{code}
121
122
123
124
125
dsFImport :: Module
	  -> Id
	  -> FoImport
	  -> DsM ([Binding], SDoc, SDoc)
dsFImport mod_name lbl_id (LblImport ext_nm) 
126
 = ASSERT(fromJust res_ty `eqType` addrPrimTy) -- typechecker ensures this
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
   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
146
  = let
147
	ty		     = idType fn_id
sof's avatar
sof committed
148
149
	(tvs, fun_ty)        = tcSplitForAllTys ty
	(arg_tys, io_res_ty) = tcSplitFunTys fun_ty
150
151
		-- Must use tcSplit* functions because we want to 
		-- see that (IO t) in the corner
sof's avatar
sof committed
152
    in
153
    newSysLocalsDs arg_tys  			`thenDs` \ args ->
154
    mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
155

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

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

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

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

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

sof's avatar
sof committed
187

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

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

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

sof's avatar
sof committed
205
\begin{code}
206
207
208
209
210
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
211
	  -> CCallConv
212
213
214
	  -> Bool		-- True => foreign export dynamic
				-- 	   so invoke IO action that's hanging off 
				-- 	   the first argument's stable pointer
215
216
	  -> DsM ( Id		-- The foreign-exported Id
		 , Binding
217
218
219
		 , SDoc
		 , SDoc
		 )
220
dsFExport mod_name fn_id ty ext_name cconv isDyn
221
222
223
224
  = 	-- 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
225
     (case tcSplitTyConApp_maybe orig_res_ty of
226
227
228
	-- We must use tcSplit here so that we see the (IO t) in
	-- the type.  [IO t is transparent to plain splitTyConApp.]

229
	Just (ioTyCon, [res_ty])
230
	      -> ASSERT( ioTyCon `hasKey` ioTyConKey )
231
232
233
234
			-- 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
235
		 dsLookupGlobalValue returnIOName	`thenDs` \ retIOId ->
236
	         returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body],
sof's avatar
sof committed
237
		           tcFunResultTy (applyTy (idType retIOId) orig_res_ty), 
238
239
240
241
242
243
244
245
246
				-- 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
247
248
     (if isDyn then 
        newSysLocalDs stbl_ptr_ty			`thenDs` \ stbl_ptr ->
249
	newSysLocalDs stbl_ptr_to_ty			`thenDs` \ stbl_value ->
250
251
	dsLookupGlobalValue deRefStablePtrName		`thenDs` \ deRefStablePtrId ->
        dsLookupGlobalValue bindIOName			`thenDs` \ bindIOId ->
sof's avatar
sof committed
252
	let
253
254
	 the_deref_app = mkApps (Var deRefStablePtrId)
				[ Type stbl_ptr_to_ty, Var stbl_ptr ]
255

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


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

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

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

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

      	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)
299
300
      				      	ext_name f_helper_glob
                                      	wrapper_arg_tys res_ty cconv isDyn
sof's avatar
sof committed
301
     in
302
     returnDs (f_helper_glob, (f_helper_glob, the_body), h_stub, c_stub)
303

sof's avatar
sof committed
304
  where
sof's avatar
sof committed
305
306
   (tvs,sans_foralls)		= tcSplitForAllTys ty
   (fe_arg_tys', orig_res_ty)	= tcSplitFunTys sans_foralls
307
308
	-- We must use tcSplits here, because we want to see 
	-- the (IO t) in the corner of the type!
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"
315
316
317
318
319

   (_, stbl_ptr_ty')		= tcSplitForAllTys stbl_ptr_ty
   (_, stbl_ptr_to_ty)		= tcSplitAppTy stbl_ptr_ty'
	-- Again, stable pointers are just newtypes, 
	-- so we must see them!  Hence tcSplit*
sof's avatar
sof committed
320
321
\end{code}

322
@foreign export dynamic@ lets you dress up Haskell IO actions
sof's avatar
sof committed
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}
327
foreign export dynamic f :: (Addr -> Int -> IO Int) -> IO Addr
sof's avatar
sof committed
328

329
330
-- Haskell-visible constructor, which is generated from the above:
-- SUP: No check for NULL from createAdjustor anymore???
sof's avatar
sof committed
331
332

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

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

       {-
        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).
       -}
379
      adj_args      = [ mkIntLitInt (ccallConvToInt cconv)
380
		      , Var stbl_value
381
		      , mkLit (MachLabel fe_nm)
382
383
384
385
386
		      ]
        -- name of external entry point providing these services.
	-- (probably in the RTS.) 
      adjustor	    = SLIT("createAdjustor")
     in
387
388
     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
389
     let ccall_adj_ty = exprType ccall_adj
390
         ccall_io_adj = mkLams [stbl_value]		     $
391
			Note (Coerce io_res_ty ccall_adj_ty)
392
			     ccall_adj
393
         io_app = mkLams tvs	 $
394
		  mkLams [cback] $
395
		  stbl_app ccall_io_adj res_ty
396
	 fed = (id `setInlinePragma` neverInlinePrag, io_app)
397
398
		-- Never inline the f.e.d. function, because the litlit
		-- might not be in scope in other modules.
399
     in
400
     returnDs ([fed, fe], h_code, c_code)
401

sof's avatar
sof committed
402
 where
403
404
405
406
407
408
  ty			= idType id
  (tvs,sans_foralls)	= tcSplitForAllTys ty
  ([arg_ty], io_res_ty)	= tcSplitFunTys sans_foralls
  [res_ty]		= tcTyConAppArgs io_res_ty
	-- Must use tcSplit* to see the (IO t), which is a newtype
  export_ty		= mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty
sof's avatar
sof committed
409
410
411
412
413
414
415
416
417
418
419

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

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

420
421
422
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
423
424

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

440
  fun_proto = cResType <+> pprCconv <+> ptext c_nm <>
sof's avatar
sof committed
441
	      parens (hsep (punctuate comma (zipWith (<+>) cParamTypes proto_args)))
sof's avatar
sof committed
442

443
444
445
  c_bits =
    externDecl $$
    fun_proto  $$
sof's avatar
sof committed
446
    vcat 
447
448
449
450
451
452
     [ 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
453
     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ptext c_nm)
454
455
						<> comma <> text "rc") <> semi
     ,   text "return" <> return_what <> semi
456
457
     , rbrace
     ]
sof's avatar
sof committed
458

459
460
  appArg acc (a,c_a) =
     text "rts_apply" <> parens (acc <> comma <> mkHObj a <> parens c_a)
sof's avatar
sof committed
461

sof's avatar
sof committed
462
  cParamTypes  = map showStgType real_args
sof's avatar
sof committed
463

464
  res_ty_is_unit = res_ty `eqType` unitTy	-- Look through any newtypes
465
466
467

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

469
470
471
  pprCconv = case cc of
		CCallConv   -> empty
		StdCallConv -> ppr cc
sof's avatar
sof committed
472
     
473
  declareResult  = text "HaskellObj ret;"
sof's avatar
sof committed
474

475
  externDecl     = mkExtern (text "HaskellObj") h_nm
sof's avatar
sof committed
476

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

479
480
  return_what | res_ty_is_unit = empty
	      | otherwise      = parens (unpackHObj res_ty <> parens (text "ret"))
sof's avatar
sof committed
481

sof's avatar
sof committed
482
483
484
485
486
487
488
489
490
491
  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)
492
493
494
495
    = 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
496

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

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

503
unpackHObj :: Type -> SDoc
sof's avatar
sof committed
504
unpackHObj t = text "rts_get" <> text (showFFIType t)
505
506

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

sof's avatar
sof committed
509
showFFIType :: Type -> String
510
511
showFFIType t = getOccString (getName tc)
 where
512
  tc = case tcSplitTyConApp_maybe (repType t) of
513
514
	    Just (tc,_) -> tc
	    Nothing	-> pprPanic "showFFIType" (ppr t)
515
\end{code}