{-|
  Copyright   :  (C) 2012-2016, University of Twente,
                     2016     , Myrtle Software Ltd
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>

  Builtin Type and Kind definitions
-}

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Core.TysPrim
  ( liftedTypeKind
  , typeNatKind
  , typeSymbolKind
  , intPrimTy
  , integerPrimTy
  , charPrimTy
  , stringPrimTy
  , voidPrimTy
  , wordPrimTy
  , int64PrimTy
  , word64PrimTy
  , floatPrimTy
  , doublePrimTy
  , naturalPrimTy
  , byteArrayPrimTy
  , tysPrimMap
  )
where

import qualified Data.List            as List

import           PrelNames
import           Unique               (getKey)

import           Clash.Core.Name
import           Clash.Core.TyCon
import {-# SOURCE #-} Clash.Core.Type
import           Clash.Unique

-- | Builtin Name
tySuperKindTyConName, liftedTypeKindTyConName, typeNatKindTyConName, typeSymbolKindTyConName :: TyConName
tySuperKindTyConName :: TyConName
tySuperKindTyConName      = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "tYPE" (Unique -> Unique
getKey Unique
tYPETyConKey)
liftedTypeKindTyConName :: TyConName
liftedTypeKindTyConName   = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "*" (Unique -> Unique
getKey Unique
liftedTypeKindTyConKey)
typeNatKindTyConName :: TyConName
typeNatKindTyConName      = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "Nat" (Unique -> Unique
getKey Unique
typeNatKindConNameKey)
typeSymbolKindTyConName :: TyConName
typeSymbolKindTyConName   = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "Symbol" (Unique -> Unique
getKey Unique
typeSymbolKindConNameKey)

-- | Builtin Kind
liftedTypeKindTc, tySuperKindTc, typeNatKindTc, typeSymbolKindTc :: TyCon
tySuperKindTc :: TyCon
tySuperKindTc    = Unique -> TyConName -> TyCon
SuperKindTyCon (TyConName -> Unique
forall a. Name a -> Unique
nameUniq TyConName
tySuperKindTyConName) TyConName
tySuperKindTyConName
liftedTypeKindTc :: TyCon
liftedTypeKindTc = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
liftedTypeKindTyConName Kind
tySuperKind
typeNatKindTc :: TyCon
typeNatKindTc    = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
typeNatKindTyConName Kind
tySuperKind
typeSymbolKindTc :: TyCon
typeSymbolKindTc = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
typeSymbolKindTyConName Kind
tySuperKind

liftedTypeKind, tySuperKind, typeNatKind, typeSymbolKind :: Type
tySuperKind :: Kind
tySuperKind    = TyConName -> Kind
mkTyConTy TyConName
tySuperKindTyConName
liftedTypeKind :: Kind
liftedTypeKind = TyConName -> Kind
mkTyConTy TyConName
liftedTypeKindTyConName
typeNatKind :: Kind
typeNatKind    = TyConName -> Kind
mkTyConTy TyConName
typeNatKindTyConName
typeSymbolKind :: Kind
typeSymbolKind = TyConName -> Kind
mkTyConTy TyConName
typeSymbolKindTyConName

intPrimTyConName, integerPrimTyConName, charPrimTyConName, stringPrimTyConName,
  voidPrimTyConName, wordPrimTyConName, int64PrimTyConName,
  word64PrimTyConName, floatPrimTyConName, doublePrimTyConName,
  naturalPrimTyConName, byteArrayPrimTyConName :: TyConName
intPrimTyConName :: TyConName
intPrimTyConName     = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Int#"
                                (Unique -> Unique
getKey Unique
intPrimTyConKey)
integerPrimTyConName :: TyConName
integerPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Integer.Type.Integer"
                                (Unique -> Unique
getKey Unique
integerTyConKey)
stringPrimTyConName :: TyConName
stringPrimTyConName  = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Addr#" (Unique -> Unique
getKey Unique
addrPrimTyConKey)
charPrimTyConName :: TyConName
charPrimTyConName    = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Char#"
                                (Unique -> Unique
getKey Unique
charPrimTyConKey)
voidPrimTyConName :: TyConName
voidPrimTyConName    = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "Void#" (Unique -> Unique
getKey Unique
voidPrimTyConKey)
wordPrimTyConName :: TyConName
wordPrimTyConName    = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Word#"
                                (Unique -> Unique
getKey Unique
wordPrimTyConKey)
int64PrimTyConName :: TyConName
int64PrimTyConName   = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Int64#"
                                (Unique -> Unique
getKey Unique
int64PrimTyConKey)
word64PrimTyConName :: TyConName
word64PrimTyConName  = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Word64#"
                                (Unique -> Unique
getKey Unique
word64PrimTyConKey)
floatPrimTyConName :: TyConName
floatPrimTyConName   = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Float#"
                                (Unique -> Unique
getKey Unique
floatPrimTyConKey)
doublePrimTyConName :: TyConName
doublePrimTyConName  = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.Double#"
                                (Unique -> Unique
getKey Unique
doublePrimTyConKey)
naturalPrimTyConName :: TyConName
naturalPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Natural.Natural"
                                (Unique -> Unique
getKey Unique
naturalTyConKey)
byteArrayPrimTyConName :: TyConName
byteArrayPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName "GHC.Prim.ByteArray#"
                          (Unique -> Unique
getKey Unique
byteArrayPrimTyConKey)

liftedPrimTC :: TyConName
             -> TyCon
liftedPrimTC :: TyConName -> TyCon
liftedPrimTC name :: TyConName
name = Unique -> TyConName -> Kind -> Unique -> TyCon
PrimTyCon (TyConName -> Unique
forall a. Name a -> Unique
nameUniq TyConName
name) TyConName
name Kind
liftedTypeKind 0

-- | Builtin Type
intPrimTc, integerPrimTc, charPrimTc, stringPrimTc, voidPrimTc, wordPrimTc,
  int64PrimTc, word64PrimTc, floatPrimTc, doublePrimTc, naturalPrimTc,
  byteArrayPrimTc :: TyCon
intPrimTc :: TyCon
intPrimTc     = TyConName -> TyCon
liftedPrimTC TyConName
intPrimTyConName
integerPrimTc :: TyCon
integerPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
integerPrimTyConName
charPrimTc :: TyCon
charPrimTc    = TyConName -> TyCon
liftedPrimTC TyConName
charPrimTyConName
stringPrimTc :: TyCon
stringPrimTc  = TyConName -> TyCon
liftedPrimTC TyConName
stringPrimTyConName
voidPrimTc :: TyCon
voidPrimTc    = TyConName -> TyCon
liftedPrimTC TyConName
voidPrimTyConName
wordPrimTc :: TyCon
wordPrimTc    = TyConName -> TyCon
liftedPrimTC TyConName
wordPrimTyConName
int64PrimTc :: TyCon
int64PrimTc   = TyConName -> TyCon
liftedPrimTC TyConName
int64PrimTyConName
word64PrimTc :: TyCon
word64PrimTc  = TyConName -> TyCon
liftedPrimTC TyConName
word64PrimTyConName
floatPrimTc :: TyCon
floatPrimTc   = TyConName -> TyCon
liftedPrimTC TyConName
floatPrimTyConName
doublePrimTc :: TyCon
doublePrimTc  = TyConName -> TyCon
liftedPrimTC TyConName
doublePrimTyConName
naturalPrimTc :: TyCon
naturalPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
naturalPrimTyConName
byteArrayPrimTc :: TyCon
byteArrayPrimTc = TyConName -> TyCon
liftedPrimTC  TyConName
byteArrayPrimTyConName

intPrimTy, integerPrimTy, charPrimTy, stringPrimTy, voidPrimTy, wordPrimTy,
  int64PrimTy, word64PrimTy, floatPrimTy, doublePrimTy, naturalPrimTy,
  byteArrayPrimTy :: Type
intPrimTy :: Kind
intPrimTy     = TyConName -> Kind
mkTyConTy TyConName
intPrimTyConName
integerPrimTy :: Kind
integerPrimTy = TyConName -> Kind
mkTyConTy TyConName
integerPrimTyConName
charPrimTy :: Kind
charPrimTy    = TyConName -> Kind
mkTyConTy TyConName
charPrimTyConName
stringPrimTy :: Kind
stringPrimTy  = TyConName -> Kind
mkTyConTy TyConName
stringPrimTyConName
voidPrimTy :: Kind
voidPrimTy    = TyConName -> Kind
mkTyConTy TyConName
voidPrimTyConName
wordPrimTy :: Kind
wordPrimTy    = TyConName -> Kind
mkTyConTy TyConName
wordPrimTyConName
int64PrimTy :: Kind
int64PrimTy   = TyConName -> Kind
mkTyConTy TyConName
int64PrimTyConName
word64PrimTy :: Kind
word64PrimTy  = TyConName -> Kind
mkTyConTy TyConName
word64PrimTyConName
floatPrimTy :: Kind
floatPrimTy   = TyConName -> Kind
mkTyConTy TyConName
floatPrimTyConName
doublePrimTy :: Kind
doublePrimTy  = TyConName -> Kind
mkTyConTy TyConName
doublePrimTyConName
naturalPrimTy :: Kind
naturalPrimTy = TyConName -> Kind
mkTyConTy TyConName
naturalPrimTyConName
byteArrayPrimTy :: Kind
byteArrayPrimTy = TyConName -> Kind
mkTyConTy TyConName
byteArrayPrimTyConName

tysPrimMap :: TyConMap
tysPrimMap :: TyConMap
tysPrimMap = (TyConMap -> (TyConName, TyCon) -> TyConMap)
-> TyConMap -> [(TyConName, TyCon)] -> TyConMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\s :: TyConMap
s (k :: TyConName
k,x :: TyCon
x) -> TyConName -> TyCon -> TyConMap -> TyConMap
forall a b. Uniquable a => a -> b -> UniqMap b -> UniqMap b
extendUniqMap TyConName
k TyCon
x TyConMap
s) TyConMap
forall a. UniqMap a
emptyUniqMap
  [  (TyConName
tySuperKindTyConName , TyCon
tySuperKindTc)
  ,  (TyConName
liftedTypeKindTyConName , TyCon
liftedTypeKindTc)
  ,  (TyConName
typeNatKindTyConName , TyCon
typeNatKindTc)
  ,  (TyConName
typeSymbolKindTyConName , TyCon
typeSymbolKindTc)
  ,  (TyConName
intPrimTyConName , TyCon
intPrimTc)
  ,  (TyConName
integerPrimTyConName , TyCon
integerPrimTc)
  ,  (TyConName
charPrimTyConName , TyCon
charPrimTc)
  ,  (TyConName
stringPrimTyConName , TyCon
stringPrimTc)
  ,  (TyConName
voidPrimTyConName , TyCon
voidPrimTc)
  ,  (TyConName
wordPrimTyConName , TyCon
wordPrimTc)
  ,  (TyConName
int64PrimTyConName , TyCon
int64PrimTc)
  ,  (TyConName
word64PrimTyConName , TyCon
word64PrimTc)
  ,  (TyConName
floatPrimTyConName , TyCon
floatPrimTc)
  ,  (TyConName
doublePrimTyConName , TyCon
doublePrimTc)
  ,  (TyConName
naturalPrimTyConName , TyCon
naturalPrimTc)
  ,  (TyConName
byteArrayPrimTyConName , TyCon
byteArrayPrimTc)
  ]