Levity.hs

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# OPTIONS_GHC -Wall -Werror -Wno-unticked-promoted-constructors #-}
-- | Conversion between unlifted and lifted datatypes
module Packed.Levity
  ( -- * Types
    Rep
  , Levity(..)
  ) where

import Data.Kind (Type)
import GHC.Types (TYPE, RuntimeRep(..), Int(..), Word(..))
import GHC.Exts  (Int#, Word#, ByteArray#)

import Data.Primitive (ByteArray(..))

type family Rep (a :: Type) :: RuntimeRep

type instance Rep Int  = IntRep
type instance Rep Word = WordRep
type instance Rep ByteArray = UnliftedRep

class Levity (a :: Type) where
  type Unlifted a :: TYPE (Rep a)
  box   :: Unlifted a -> a
  unbox :: a -> Unlifted a

instance Levity Int where
  type Unlifted Int = Int#
  box = I#
  unbox (I# i) = i

instance Levity Word where
  type Unlifted Word = Word#
  box = W#
  unbox (W# w) = w

instance Levity ByteArray where
  type Unlifted ByteArray = ByteArray#
  box = ByteArray
  unbox (ByteArray arr) = arr

type Stuff# = (# Int#, Int# #)

data Stuff = Stuff Int# Int#

type instance Rep Stuff = TupleRep '[ IntRep, IntRep ]

instance Levity Stuff where
  type Unlifted Stuff = Stuff#
  box (# a, b #) = Stuff a b

{- ERROR:
src/Packed/Levity.hs:52:25: error:
    • Expected kind ‘TYPE (Rep Stuff)’,
        but ‘Stuff#’ has kind ‘TYPE ('TupleRep '['IntRep, 'IntRep])’
    • In the type ‘Stuff#’
      In the type instance declaration for ‘Unlifted’
      In the instance declaration for ‘Levity Stuff’
   |
52 |   type Unlifted Stuff = Stuff#
   |                         ^^^^^^
-}