[project @ 2000-11-15 17:07:34 by simonpj]
[ghc-hetmet.git] / ghc / compiler / prelude / PrimOp.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[PrimOp]{Primitive operations (machine-level)}
5
6 \begin{code}
7 module PrimOp (
8         PrimOp(..), allThePrimOps,
9         primOpType, primOpSig, primOpUsg, primOpArity,
10         mkPrimOpIdName, primOpRdrName, primOpTag, primOpOcc,
11
12         commutableOp,
13
14         primOpOutOfLine, primOpNeedsWrapper, 
15         primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
16         primOpHasSideEffects,
17
18         getPrimOpResultInfo,  PrimOpResultInfo(..),
19
20         pprPrimOp,
21
22         CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp,
23         isDynamicTarget, dynamicTarget, setCCallUnique
24     ) where
25
26 #include "HsVersions.h"
27
28 import PrimRep          -- most of it
29 import TysPrim
30 import TysWiredIn
31
32 import Demand           ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
33 import Var              ( TyVar )
34 import CallConv         ( CallConv, pprCallConv )
35 import Name             ( Name, mkWiredInName )
36 import RdrName          ( RdrName, mkRdrOrig )
37 import OccName          ( OccName, pprOccName, mkVarOcc )
38 import TyCon            ( TyCon, tyConArity )
39 import Type             ( Type, mkForAllTys, mkFunTy, mkFunTys, mkTyVarTys,
40                           mkTyConApp, typePrimRep,
41                           splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp,
42                           mkUTy, usOnce, usMany
43                         )
44 import Unique           ( Unique, mkPrimOpIdUnique )
45 import BasicTypes       ( Arity, Boxity(..) )
46 import CStrings         ( CLabelString, pprCLabelString )
47 import PrelNames        ( pREL_GHC, pREL_GHC_Name )
48 import Outputable
49 import Util             ( zipWithEqual )
50 import FastTypes
51 \end{code}
52
53 %************************************************************************
54 %*                                                                      *
55 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
56 %*                                                                      *
57 %************************************************************************
58
59 These are in \tr{state-interface.verb} order.
60
61 \begin{code}
62
63 -- supplies: 
64 -- data PrimOp = ...
65 #include "primop-data-decl.hs-incl"
66     | CCallOp CCall          -- and don't forget to add CCall
67 \end{code}
68
69 Used for the Ord instance
70
71 \begin{code}
72 primOpTag :: PrimOp -> Int
73 primOpTag op = iBox (tagOf_PrimOp op)
74
75 -- supplies   
76 -- tagOf_PrimOp :: PrimOp -> FastInt
77 #include "primop-tag.hs-incl"
78 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
79
80
81 instance Eq PrimOp where
82     op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
83
84 instance Ord PrimOp where
85     op1 <  op2 =  tagOf_PrimOp op1 <# tagOf_PrimOp op2
86     op1 <= op2 =  tagOf_PrimOp op1 <=# tagOf_PrimOp op2
87     op1 >= op2 =  tagOf_PrimOp op1 >=# tagOf_PrimOp op2
88     op1 >  op2 =  tagOf_PrimOp op1 ># tagOf_PrimOp op2
89     op1 `compare` op2 | op1 < op2  = LT
90                       | op1 == op2 = EQ
91                       | otherwise  = GT
92
93 instance Outputable PrimOp where
94     ppr op = pprPrimOp op
95
96 instance Show PrimOp where
97     showsPrec p op = showsPrecSDoc p (pprPrimOp op)
98 \end{code}
99
100 An @Enum@-derived list would be better; meanwhile... (ToDo)
101 \begin{code}
102 allThePrimOps :: [PrimOp]
103 allThePrimOps =
104 #include "primop-list.hs-incl"
105 -- Doesn't include CCall, which is really a family of primops
106 \end{code}
107
108 %************************************************************************
109 %*                                                                      *
110 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
111 %*                                                                      *
112 %************************************************************************
113
114 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
115 refer to the primitive operation.  The conventional \tr{#}-for-
116 unboxed ops is added on later.
117
118 The reason for the funny characters in the names is so we do not
119 interfere with the programmer's Haskell name spaces.
120
121 We use @PrimKinds@ for the ``type'' information, because they're
122 (slightly) more convenient to use than @TyCons@.
123 \begin{code}
124 data PrimOpInfo
125   = Dyadic      OccName         -- string :: T -> T -> T
126                 Type
127   | Monadic     OccName         -- string :: T -> T
128                 Type
129   | Compare     OccName         -- string :: T -> T -> Bool
130                 Type
131
132   | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T
133                 [TyVar] 
134                 [Type] 
135                 Type 
136
137 mkDyadic str  ty = Dyadic  (mkVarOcc str) ty
138 mkMonadic str ty = Monadic (mkVarOcc str) ty
139 mkCompare str ty = Compare (mkVarOcc str) ty
140 mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOcc str) tvs tys ty
141 \end{code}
142
143 %************************************************************************
144 %*                                                                      *
145 \subsubsection{Strictness}
146 %*                                                                      *
147 %************************************************************************
148
149 Not all primops are strict!
150
151 \begin{code}
152 primOpStrictness :: PrimOp -> Arity -> StrictnessInfo
153         -- See Demand.StrictnessInfo for discussion of what the results
154         -- The arity should be the arity of the primop; that's why
155         -- this function isn't exported.
156 #include "primop-strictness.hs-incl"
157 \end{code}
158
159 %************************************************************************
160 %*                                                                      *
161 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
162 %*                                                                      *
163 %************************************************************************
164
165 @primOpInfo@ gives all essential information (from which everything
166 else, notably a type, can be constructed) for each @PrimOp@.
167
168 \begin{code}
169 primOpInfo :: PrimOp -> PrimOpInfo
170 #include "primop-primop-info.hs-incl"
171 \end{code}
172
173 Here are a load of comments from the old primOp info:
174
175 A @Word#@ is an unsigned @Int#@.
176
177 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
178
179 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
180
181 Decoding of floating-point numbers is sorta Integer-related.  Encoding
182 is done with plain ccalls now (see PrelNumExtra.lhs).
183
184 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
185
186         mkWeak# :: k -> v -> f -> State# RealWorld 
187                         -> (# State# RealWorld, Weak# v #)
188
189 In practice, you'll use the higher-level
190
191         data Weak v = Weak# v
192         mkWeak :: k -> v -> IO () -> IO (Weak v)
193
194 The following operation dereferences a weak pointer.  The weak pointer
195 may have been finalized, so the operation returns a result code which
196 must be inspected before looking at the dereferenced value.
197
198         deRefWeak# :: Weak# v -> State# RealWorld ->
199                         (# State# RealWorld, v, Int# #)
200
201 Only look at v if the Int# returned is /= 0 !!
202
203 The higher-level op is
204
205         deRefWeak :: Weak v -> IO (Maybe v)
206
207 Weak pointers can be finalized early by using the finalize# operation:
208         
209         finalizeWeak# :: Weak# v -> State# RealWorld -> 
210                            (# State# RealWorld, Int#, IO () #)
211
212 The Int# returned is either
213
214         0 if the weak pointer has already been finalized, or it has no
215           finalizer (the third component is then invalid).
216
217         1 if the weak pointer is still alive, with the finalizer returned
218           as the third component.
219
220 A {\em stable name/pointer} is an index into a table of stable name
221 entries.  Since the garbage collector is told about stable pointers,
222 it is safe to pass a stable pointer to external systems such as C
223 routines.
224
225 \begin{verbatim}
226 makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
227 freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld
228 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
229 eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#
230 \end{verbatim}
231
232 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
233 operation since it doesn't (directly) involve IO operations.  The
234 reason is that if some optimisation pass decided to duplicate calls to
235 @makeStablePtr#@ and we only pass one of the stable pointers over, a
236 massive space leak can result.  Putting it into the IO monad
237 prevents this.  (Another reason for putting them in a monad is to
238 ensure correct sequencing wrt the side-effecting @freeStablePtr@
239 operation.)
240
241 An important property of stable pointers is that if you call
242 makeStablePtr# twice on the same object you get the same stable
243 pointer back.
244
245 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
246 besides, it's not likely to be used from Haskell) so it's not a
247 primop.
248
249 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
250
251 Stable Names
252 ~~~~~~~~~~~~
253
254 A stable name is like a stable pointer, but with three important differences:
255
256         (a) You can't deRef one to get back to the original object.
257         (b) You can convert one to an Int.
258         (c) You don't need to 'freeStableName'
259
260 The existence of a stable name doesn't guarantee to keep the object it
261 points to alive (unlike a stable pointer), hence (a).
262
263 Invariants:
264         
265         (a) makeStableName always returns the same value for a given
266             object (same as stable pointers).
267
268         (b) if two stable names are equal, it implies that the objects
269             from which they were created were the same.
270
271         (c) stableNameToInt always returns the same Int for a given
272             stable name.
273
274
275 [Alastair Reid is to blame for this!]
276
277 These days, (Glasgow) Haskell seems to have a bit of everything from
278 other languages: strict operations, mutable variables, sequencing,
279 pointers, etc.  About the only thing left is LISP's ability to test
280 for pointer equality.  So, let's add it in!
281
282 \begin{verbatim}
283 reallyUnsafePtrEquality :: a -> a -> Int#
284 \end{verbatim}
285
286 which tests any two closures (of the same type) to see if they're the
287 same.  (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
288 difficulties of trying to box up the result.)
289
290 NB This is {\em really unsafe\/} because even something as trivial as
291 a garbage collection might change the answer by removing indirections.
292 Still, no-one's forcing you to use it.  If you're worried about little
293 things like loss of referential transparency, you might like to wrap
294 it all up in a monad-like thing as John O'Donnell and John Hughes did
295 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
296 Proceedings?)
297
298 I'm thinking of using it to speed up a critical equality test in some
299 graphics stuff in a context where the possibility of saying that
300 denotationally equal things aren't isn't a problem (as long as it
301 doesn't happen too often.)  ADR
302
303 To Will: Jim said this was already in, but I can't see it so I'm
304 adding it.  Up to you whether you add it.  (Note that this could have
305 been readily implemented using a @veryDangerousCCall@ before they were
306 removed...)
307
308
309 -- HWL: The first 4 Int# in all par... annotations denote:
310 --   name, granularity info, size of result, degree of parallelism
311 --      Same  structure as _seq_ i.e. returns Int#
312 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
313 --   `the processor containing the expression v'; it is not evaluated
314
315 These primops are pretty wierd.
316
317         dataToTag# :: a -> Int    (arg must be an evaluated data type)
318         tagToEnum# :: Int -> a    (result type must be an enumerated type)
319
320 The constraints aren't currently checked by the front end, but the
321 code generator will fall over if they aren't satisfied.
322
323 \begin{code}
324 #ifdef DEBUG
325 primOpInfo op = pprPanic "primOpInfo:" (ppr op)
326 #endif
327 \end{code}
328
329 %************************************************************************
330 %*                                                                      *
331 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
332 %*                                                                      *
333 %************************************************************************
334
335 Some PrimOps need to be called out-of-line because they either need to
336 perform a heap check or they block.
337
338 \begin{code}
339 primOpOutOfLine (CCallOp c_call) = ccallMayGC c_call
340 #include "primop-out-of-line.hs-incl"
341 \end{code}
342
343
344 primOpOkForSpeculation
345 ~~~~~~~~~~~~~~~~~~~~~~
346 Sometimes we may choose to execute a PrimOp even though it isn't
347 certain that its result will be required; ie execute them
348 ``speculatively''.  The same thing as ``cheap eagerness.'' Usually
349 this is OK, because PrimOps are usually cheap, but it isn't OK for
350 (a)~expensive PrimOps and (b)~PrimOps which can fail.
351
352 PrimOps that have side effects also should not be executed speculatively.
353
354 Ok-for-speculation also means that it's ok *not* to execute the
355 primop. For example
356         case op a b of
357           r -> 3
358 Here the result is not used, so we can discard the primop.  Anything
359 that has side effects mustn't be dicarded in this way, of course!
360
361 See also @primOpIsCheap@ (below).
362
363
364 \begin{code}
365 primOpOkForSpeculation :: PrimOp -> Bool
366         -- See comments with CoreUtils.exprOkForSpeculation
367 primOpOkForSpeculation op 
368   = primOpIsCheap op && not (primOpCanFail op)
369 \end{code}
370
371
372 primOpIsCheap
373 ~~~~~~~~~~~~~
374 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK
375 WARNING), we just borrow some other predicates for a
376 what-should-be-good-enough test.  "Cheap" means willing to call it more
377 than once.  Evaluation order is unaffected.
378
379 \begin{code}
380 primOpIsCheap :: PrimOp -> Bool
381         -- See comments with CoreUtils.exprOkForSpeculation
382 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
383 \end{code}
384
385 primOpIsDupable
386 ~~~~~~~~~~~~~~~
387 primOpIsDupable means that the use of the primop is small enough to
388 duplicate into different case branches.  See CoreUtils.exprIsDupable.
389
390 \begin{code}
391 primOpIsDupable :: PrimOp -> Bool
392         -- See comments with CoreUtils.exprIsDupable
393         -- We say it's dupable it isn't implemented by a C call with a wrapper
394 primOpIsDupable op = not (primOpNeedsWrapper op)
395 \end{code}
396
397
398 \begin{code}
399 primOpCanFail :: PrimOp -> Bool
400 #include "primop-can-fail.hs-incl"
401 \end{code}
402
403 And some primops have side-effects and so, for example, must not be
404 duplicated.
405
406 \begin{code}
407 primOpHasSideEffects :: PrimOp -> Bool
408 primOpHasSideEffects (CCallOp _)        = True
409 #include "primop-has-side-effects.hs-incl"
410 \end{code}
411
412 Inline primitive operations that perform calls need wrappers to save
413 any live variables that are stored in caller-saves registers.
414
415 \begin{code}
416 primOpNeedsWrapper :: PrimOp -> Bool
417 primOpNeedsWrapper (CCallOp _)          = True
418 #include "primop-needs-wrapper.hs-incl"
419 \end{code}
420
421 \begin{code}
422 primOpArity :: PrimOp -> Arity
423 primOpArity op 
424   = case (primOpInfo op) of
425       Monadic occ ty                      -> 1
426       Dyadic occ ty                       -> 2
427       Compare occ ty                      -> 2
428       GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
429                 
430 primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead
431 primOpType op
432   = case (primOpInfo op) of
433       Dyadic occ ty ->      dyadic_fun_ty ty
434       Monadic occ ty ->     monadic_fun_ty ty
435       Compare occ ty ->     compare_fun_ty ty
436
437       GenPrimOp occ tyvars arg_tys res_ty -> 
438         mkForAllTys tyvars (mkFunTys arg_tys res_ty)
439
440 mkPrimOpIdName :: PrimOp -> Name
441         -- Make the name for the PrimOp's Id
442         -- We have to pass in the Id itself because it's a WiredInId
443         -- and hence recursive
444 mkPrimOpIdName op
445   = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
446
447 primOpRdrName :: PrimOp -> RdrName 
448 primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
449
450 primOpOcc :: PrimOp -> OccName
451 primOpOcc op = case (primOpInfo op) of
452                               Dyadic    occ _     -> occ
453                               Monadic   occ _     -> occ
454                               Compare   occ _     -> occ
455                               GenPrimOp occ _ _ _ -> occ
456
457 -- primOpSig is like primOpType but gives the result split apart:
458 -- (type variables, argument types, result type)
459 -- It also gives arity, strictness info
460
461 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
462 primOpSig op
463   = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
464   where
465     arity = length arg_tys
466     (tyvars, arg_tys, res_ty)
467       = case (primOpInfo op) of
468           Monadic   occ ty -> ([],     [ty],    ty    )
469           Dyadic    occ ty -> ([],     [ty,ty], ty    )
470           Compare   occ ty -> ([],     [ty,ty], boolTy)
471           GenPrimOp occ tyvars arg_tys res_ty
472                            -> (tyvars, arg_tys, res_ty)
473
474 -- primOpUsg is like primOpSig but the types it yields are the
475 -- appropriate sigma (i.e., usage-annotated) types,
476 -- as required by the UsageSP inference.
477
478 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
479 primOpUsg p@(CCallOp _) = mangle p [] mkM
480 #include "primop-usage.hs-incl"
481
482 -- Things with no Haskell pointers inside: in actuality, usages are
483 -- irrelevant here (hence it doesn't matter that some of these
484 -- apparently permit duplication; since such arguments are never 
485 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
486 -- except insofar as it propagates to infect other values that *are*
487 -- pointed.
488
489
490 -- Helper bits & pieces for usage info.
491                                     
492 mkZ          = mkUTy usOnce  -- pointed argument used zero
493 mkO          = mkUTy usOnce  -- pointed argument used once
494 mkM          = mkUTy usMany  -- pointed argument used multiply
495 mkP          = mkUTy usOnce  -- unpointed argument
496 mkR          = mkUTy usMany  -- unpointed result
497
498 nomangle op
499    = case primOpSig op of
500         (tyvars, arg_tys, res_ty, _, _)
501            -> (tyvars, map mkP arg_tys, mkR res_ty)
502
503 mangle op fs g  
504    = case primOpSig op of
505         (tyvars, arg_tys, res_ty, _, _)
506            -> (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
507
508 inFun op f g ty 
509    = case splitFunTy_maybe ty of
510         Just (a,b) -> mkFunTy (f a) (g b)
511         Nothing    -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
512
513 inUB op fs ty
514    = case splitTyConApp ty of
515         (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
516                     mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" ($) fs tys)
517 \end{code}
518
519 \begin{code}
520 data PrimOpResultInfo
521   = ReturnsPrim     PrimRep
522   | ReturnsAlg      TyCon
523
524 -- Some PrimOps need not return a manifest primitive or algebraic value
525 -- (i.e. they might return a polymorphic value).  These PrimOps *must*
526 -- be out of line, or the code generator won't work.
527
528 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
529 getPrimOpResultInfo (CCallOp _)
530   = ReturnsAlg unboxedPairTyCon
531 getPrimOpResultInfo op
532   = case (primOpInfo op) of
533       Dyadic  _ ty               -> ReturnsPrim (typePrimRep ty)
534       Monadic _ ty               -> ReturnsPrim (typePrimRep ty)
535       Compare _ ty               -> ReturnsAlg boolTyCon
536       GenPrimOp _ _ _ ty         -> 
537         let rep = typePrimRep ty in
538         case rep of
539            PtrRep -> case splitAlgTyConApp_maybe ty of
540                         Nothing -> pprPanic "getPrimOpResultInfo" 
541                                             (ppr ty <+> ppr op)
542                         Just (tc,_,_) -> ReturnsAlg tc
543            other -> ReturnsPrim other
544 \end{code}
545
546 The commutable ops are those for which we will try to move constants
547 to the right hand side for strength reduction.
548
549 \begin{code}
550 commutableOp :: PrimOp -> Bool
551 #include "primop-commutable.hs-incl"
552 \end{code}
553
554 Utils:
555 \begin{code}
556 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
557         -- CharRep       -->  ([],  Char#)
558         -- StablePtrRep  -->  ([a], StablePtr# a)
559 mkPrimTyApp tvs kind
560   = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
561   where
562     tycon      = primRepTyCon kind
563     forall_tvs = take (tyConArity tycon) tvs
564
565 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
566 monadic_fun_ty ty = mkFunTy  ty ty
567 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
568 \end{code}
569
570 Output stuff:
571 \begin{code}
572 pprPrimOp  :: PrimOp -> SDoc
573
574 pprPrimOp (CCallOp c_call) = pprCCallOp c_call
575 pprPrimOp other_op
576   = getPprStyle $ \ sty ->
577     if ifaceStyle sty then      -- For interfaces Print it qualified with PrelGHC.
578         ptext SLIT("PrelGHC.") <> pprOccName occ
579     else
580         pprOccName occ
581   where
582     occ = primOpOcc other_op
583 \end{code}
584
585
586 %************************************************************************
587 %*                                                                      *
588 \subsubsection{CCalls}
589 %*                                                                      *
590 %************************************************************************
591
592 A special ``trap-door'' to use in making calls direct to C functions:
593 \begin{code}
594 data CCall
595   =  CCall      CCallTarget
596                 Bool            -- True <=> really a "casm"
597                 Bool            -- True <=> might invoke Haskell GC
598                 CallConv        -- calling convention to use.
599   deriving( Eq )
600
601 data CCallTarget
602   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
603   | DynamicTarget Unique        -- First argument (an Addr#) is the function pointer
604                                 --   (unique is used to generate a 'typedef' to cast
605                                 --    the function pointer if compiling the ccall# down to
606                                 --    .hc code - can't do this inline for tedious reasons.)
607
608 instance Eq CCallTarget where
609   (StaticTarget l1) == (StaticTarget l2) = l1 == l2
610   (DynamicTarget _) == (DynamicTarget _) = True 
611         -- Ignore the arbitrary unique; this is important when comparing
612         -- a dynamic ccall read from an interface file A.hi with the
613         -- one constructed from A.hs, when deciding whether the interface
614         -- has changed
615   t1 == t2 = False
616
617 ccallMayGC :: CCall -> Bool
618 ccallMayGC (CCall _ _ may_gc _) = may_gc
619
620 ccallIsCasm :: CCall -> Bool
621 ccallIsCasm (CCall _ c_asm _ _) = c_asm
622
623 isDynamicTarget (DynamicTarget _) = True
624 isDynamicTarget (StaticTarget _)  = False
625
626 dynamicTarget :: CCallTarget
627 dynamicTarget = DynamicTarget (panic "Unique in DynamicTarget not yet set")
628         -- The unique is really only to do with code generation, so it
629         -- is only set in CoreToStg; before then it's just an error message
630
631 setCCallUnique :: CCall -> Unique -> CCall
632 setCCallUnique (CCall (DynamicTarget _) is_asm may_gc cconv) uniq
633   = CCall (DynamicTarget uniq) is_asm may_gc cconv
634 setCCallUnique ccall uniq = ccall
635 \end{code}
636
637 \begin{code}
638 pprCCallOp (CCall fun is_casm may_gc cconv)
639   = hcat [ ifPprDebug callconv
640          , text "__", ppr_dyn
641          , text before , ppr_fun , after]
642   where
643         callconv = text "{-" <> pprCallConv cconv <> text "-}"
644
645         before
646           | is_casm && may_gc = "casm_GC ``"
647           | is_casm           = "casm ``"
648           | may_gc            = "ccall_GC "
649           | otherwise         = "ccall "
650
651         after
652           | is_casm   = text "''"
653           | otherwise = empty
654           
655         ppr_dyn = case fun of
656                     DynamicTarget _ -> text "dyn_"
657                     _               -> empty
658
659         ppr_fun = case fun of
660                      DynamicTarget _ -> text "\"\""
661                      StaticTarget fn -> pprCLabelString fn
662 \end{code}