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_maybe,
  42                           UsageAnn(..), mkUsgTy
  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          = mkUsgTy UsOnce  -- pointed argument used zero
 493 mkO          = mkUsgTy UsOnce  -- pointed argument used once
 494 mkM          = mkUsgTy UsMany  -- pointed argument used multiply
 495 mkP          = mkUsgTy UsOnce  -- unpointed argument
 496 mkR          = mkUsgTy 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_maybe ty of
 515         Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
 516                          mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg"
 517                                                                      ($) fs tys)
 518         Nothing       -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
 519 \end{code}
 520
 521 \begin{code}
 522 data PrimOpResultInfo
 523   = ReturnsPrim     PrimRep
 524   | ReturnsAlg      TyCon
 525
 526 -- Some PrimOps need not return a manifest primitive or algebraic value
 527 -- (i.e. they might return a polymorphic value).  These PrimOps *must*
 528 -- be out of line, or the code generator won't work.
 529
 530 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
 531 getPrimOpResultInfo (CCallOp _)
 532   = ReturnsAlg unboxedPairTyCon
 533 getPrimOpResultInfo op
 534   = case (primOpInfo op) of
 535       Dyadic  _ ty               -> ReturnsPrim (typePrimRep ty)
 536       Monadic _ ty               -> ReturnsPrim (typePrimRep ty)
 537       Compare _ ty               -> ReturnsAlg boolTyCon
 538       GenPrimOp _ _ _ ty         ->
 539         let rep = typePrimRep ty in
 540         case rep of
 541            PtrRep -> case splitAlgTyConApp_maybe ty of
 542                         Nothing -> pprPanic "getPrimOpResultInfo"
 543                                             (ppr ty <+> ppr op)
 544                         Just (tc,_,_) -> ReturnsAlg tc
 545            other -> ReturnsPrim other
 546 \end{code}
 547
 548 The commutable ops are those for which we will try to move constants
 549 to the right hand side for strength reduction.
 550
 551 \begin{code}
 552 commutableOp :: PrimOp -> Bool
 553 #include "primop-commutable.hs-incl"
 554 \end{code}
 555
 556 Utils:
 557 \begin{code}
 558 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
 559         -- CharRep       -->  ([],  Char#)
 560         -- StablePtrRep  -->  ([a], StablePtr# a)
 561 mkPrimTyApp tvs kind
 562   = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
 563   where
 564     tycon      = primRepTyCon kind
 565     forall_tvs = take (tyConArity tycon) tvs
 566
 567 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
 568 monadic_fun_ty ty = mkFunTy  ty ty
 569 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
 570 \end{code}
 571
 572 Output stuff:
 573 \begin{code}
 574 pprPrimOp  :: PrimOp -> SDoc
 575
 576 pprPrimOp (CCallOp c_call) = pprCCallOp c_call
 577 pprPrimOp other_op
 578   = getPprStyle $ \ sty ->
 579     if ifaceStyle sty then      -- For interfaces Print it qualified with PrelGHC.
 580         ptext SLIT("PrelGHC.") <> pprOccName occ
 581     else
 582         pprOccName occ
 583   where
 584     occ = primOpOcc other_op
 585 \end{code}
 586
 587
 588 %************************************************************************
 589 %*                                                                      *
 590 \subsubsection{CCalls}
 591 %*                                                                      *
 592 %************************************************************************
 593
 594 A special ``trap-door'' to use in making calls direct to C functions:
 595 \begin{code}
 596 data CCall
 597   =  CCall      CCallTarget
 598                 Bool            -- True <=> really a "casm"
 599                 Bool            -- True <=> might invoke Haskell GC
 600                 CallConv        -- calling convention to use.
 601   deriving( Eq )
 602
 603 data CCallTarget
 604   = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
 605   | DynamicTarget Unique        -- First argument (an Addr#) is the function pointer
 606                                 --   (unique is used to generate a 'typedef' to cast
 607                                 --    the function pointer if compiling the ccall# down to
 608                                 --    .hc code - can't do this inline for tedious reasons.)
 609
 610 instance Eq CCallTarget where
 611   (StaticTarget l1) == (StaticTarget l2) = l1 == l2
 612   (DynamicTarget _) == (DynamicTarget _) = True
 613         -- Ignore the arbitrary unique; this is important when comparing
 614         -- a dynamic ccall read from an interface file A.hi with the
 615         -- one constructed from A.hs, when deciding whether the interface
 616         -- has changed
 617   t1 == t2 = False
 618
 619 ccallMayGC :: CCall -> Bool
 620 ccallMayGC (CCall _ _ may_gc _) = may_gc
 621
 622 ccallIsCasm :: CCall -> Bool
 623 ccallIsCasm (CCall _ c_asm _ _) = c_asm
 624
 625 isDynamicTarget (DynamicTarget _) = True
 626 isDynamicTarget (StaticTarget _)  = False
 627
 628 dynamicTarget :: CCallTarget
 629 dynamicTarget = DynamicTarget (panic "Unique in DynamicTarget not yet set")
 630         -- The unique is really only to do with code generation, so it
 631         -- is only set in CoreToStg; before then it's just an error message
 632
 633 setCCallUnique :: CCall -> Unique -> CCall
 634 setCCallUnique (CCall (DynamicTarget _) is_asm may_gc cconv) uniq
 635   = CCall (DynamicTarget uniq) is_asm may_gc cconv
 636 setCCallUnique ccall uniq = ccall
 637 \end{code}
 638
 639 \begin{code}
 640 pprCCallOp (CCall fun is_casm may_gc cconv)
 641   = hcat [ ifPprDebug callconv
 642          , text "__", ppr_dyn
 643          , text before , ppr_fun , after]
 644   where
 645         callconv = text "{-" <> pprCallConv cconv <> text "-}"
 646
 647         before
 648           | is_casm && may_gc = "casm_GC ``"
 649           | is_casm           = "casm ``"
 650           | may_gc            = "ccall_GC "
 651           | otherwise         = "ccall "
 652
 653         after
 654           | is_casm   = text "''"
 655           | otherwise = empty
 656
 657         ppr_dyn = case fun of
 658                     DynamicTarget _ -> text "dyn_"
 659                     _               -> empty
 660
 661         ppr_fun = case fun of
 662                      DynamicTarget _ -> text "\"\""
 663                      StaticTarget fn -> pprCLabelString fn
 664 \end{code}