ghc/compiler/basicTypes/IdUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[IdUtils]{Constructing PrimOp Ids}
   5
   6 \begin{code}
   7 module IdUtils ( primOpName ) where
   8
   9 #include "HsVersions.h"
  10
  11 import CoreSyn
  12 import CoreUnfold       ( Unfolding )
  13 import MkId             ( mkPrimitiveId )
  14 import IdInfo           -- quite a few things
  15 import Name             ( mkWiredInIdName, Name )
  16 import PrimOp           ( primOpInfo, tagOf_PrimOp, PrimOpInfo(..), PrimOp )
  17 import PrelMods         ( pREL_GHC )
  18 import Type             ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp )
  19 import TysWiredIn       ( boolTy )
  20 import Unique           ( mkPrimOpIdUnique )
  21 import Util             ( panic )
  22 \end{code}
  23
  24 \begin{code}
  25 primOpName       :: PrimOp -> Name
  26 primOpName op
  27   = case (primOpInfo op) of
  28       Dyadic str ty ->
  29         mk_prim_name op str [] [ty,ty] (dyadic_fun_ty ty) 2
  30
  31       Monadic str ty ->
  32         mk_prim_name op str [] [ty] (monadic_fun_ty ty) 1
  33
  34       Compare str ty ->
  35         mk_prim_name op str [] [ty,ty] (compare_fun_ty ty) 2
  36
  37       Coercing str ty1 ty2 ->
  38         mk_prim_name op str [] [ty1] (ty1 `mkFunTy` ty2) 1
  39
  40       PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
  41         mk_prim_name op str
  42             tyvars
  43             arg_tys
  44             (mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys)))
  45             (length arg_tys) -- arity
  46
  47       AlgResult str tyvars arg_tys tycon res_tys ->
  48         mk_prim_name op str
  49             tyvars
  50             arg_tys
  51             (mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys)))
  52             (length arg_tys) -- arity
  53   where
  54     mk_prim_name prim_op occ_name tyvar_tmpls arg_tys ty arity
  55       = name
  56       where
  57         key     = mkPrimOpIdUnique (IBOX(tagOf_PrimOp prim_op))
  58         name    = mkWiredInIdName key pREL_GHC occ_name the_id
  59         the_id  = mkPrimitiveId name ty prim_op
  60 \end{code}
  61
  62 \begin{code}
  63 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
  64 monadic_fun_ty ty = ty `mkFunTy` ty
  65 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
  66 \end{code}