Unlifted primop types

Simon Peyton Jones simonpj at microsoft.com
Wed Aug 22 09:44:52 UTC 2018


|  Huh! It looks like what we currently do for some primops is just use a
|  totally bogus kind. For example, mkWeak# will happily accept an Int# as
|  its first argument.

Well, I see
  primop  MkWeakOp "mkWeak#" GenPrimOp
     o -> b -> (State# RealWorld -> (# State# RealWorld, c #))

and I believe (from Ben's message) that the "o" means "open type variable",
which is the old terminology for what we now call levity-polymorphic.

The type from primops.txt.pp is processed into various Haskell source files including
  compiler/stage1/build/primop-primop-info.hs-incl

which includes

primOpInfo MkWeakOp 
  = mkGenPrimOp (fsLit "mkWeak#")  
      [runtimeRep1TyVar, openAlphaTyVar, betaTyVar, gammaTyVar]
      [openAlphaTy, betaTy, 
       (mkFunTy (mkStatePrimTy realWorldTy) 
               ((mkTupleTy Unboxed [ mkStatePrimTy realWorldTy, gammaTy])))
                                   , mkStatePrimTy realWorldTy] 
       ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy]))


So it looks as if (rightly or wrongly) mkWeak# is deliberately levity-polymorphic.

It would be good to write this stuff down.  A good starting point is
https://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps

Simon

So we *could* follow that precedent and generalize
|  reallyUnsafePtrEquality#, makeStableName#, etc., to accept anything,
|  whether it makes sense or not. Or we can work out how to do what I was
|  trying to do and then duplicate those primitives as appropriate
|  (mkLiftedWeak#, mkUnliftedWeak#, makeLiftedStableName#,
|  makeUnliftedStableName#, etc.).


More information about the ghc-devs mailing list