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

  Variables in CoreHW
-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

module Clash.Core.Var
  ( Attr' (..)
  , Var (..)
  , IdScope (..)
  , Id
  , TyVar
  , mkId
  , mkLocalId
  , mkGlobalId
  , mkTyVar
  , setVarUnique
  , setVarType
  , setIdScope
  , modifyVarName
  , isGlobalId
  , isLocalId
  , attrName
  )
where


import Control.DeepSeq                  (NFData (..))
import Data.Binary                      (Binary)
import Data.Function                    (on)
import Data.Hashable                    (Hashable(hashWithSalt))
import GHC.Generics                     (Generic)
import Clash.Core.Name                  (Name (..))
import {-# SOURCE #-} Clash.Core.Term   (Term, TmName)
import {-# SOURCE #-} Clash.Core.Type   (Kind, Type, TyName)
import Clash.Unique


-- | Interal version of Clash.Annotations.SynthesisAttributes.Attr.
--
-- Needed because Clash.Annotations.SynthesisAttributes.Attr uses the Symbol
-- kind for names, which do not have a term-level representation
data Attr'
  = BoolAttr' String Bool
  | IntegerAttr' String Integer
  | StringAttr' String String
  | Attr' String
  deriving (Attr' -> Attr' -> Bool
(Attr' -> Attr' -> Bool) -> (Attr' -> Attr' -> Bool) -> Eq Attr'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attr' -> Attr' -> Bool
$c/= :: Attr' -> Attr' -> Bool
== :: Attr' -> Attr' -> Bool
$c== :: Attr' -> Attr' -> Bool
Eq, Int -> Attr' -> ShowS
[Attr'] -> ShowS
Attr' -> String
(Int -> Attr' -> ShowS)
-> (Attr' -> String) -> ([Attr'] -> ShowS) -> Show Attr'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attr'] -> ShowS
$cshowList :: [Attr'] -> ShowS
show :: Attr' -> String
$cshow :: Attr' -> String
showsPrec :: Int -> Attr' -> ShowS
$cshowsPrec :: Int -> Attr' -> ShowS
Show, Attr' -> ()
(Attr' -> ()) -> NFData Attr'
forall a. (a -> ()) -> NFData a
rnf :: Attr' -> ()
$crnf :: Attr' -> ()
NFData, (forall x. Attr' -> Rep Attr' x)
-> (forall x. Rep Attr' x -> Attr') -> Generic Attr'
forall x. Rep Attr' x -> Attr'
forall x. Attr' -> Rep Attr' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attr' x -> Attr'
$cfrom :: forall x. Attr' -> Rep Attr' x
Generic, Eq Attr'
Eq Attr'
-> (Int -> Attr' -> Int) -> (Attr' -> Int) -> Hashable Attr'
Int -> Attr' -> Int
Attr' -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Attr' -> Int
$chash :: Attr' -> Int
hashWithSalt :: Int -> Attr' -> Int
$chashWithSalt :: Int -> Attr' -> Int
$cp1Hashable :: Eq Attr'
Hashable, Eq Attr'
Eq Attr'
-> (Attr' -> Attr' -> Ordering)
-> (Attr' -> Attr' -> Bool)
-> (Attr' -> Attr' -> Bool)
-> (Attr' -> Attr' -> Bool)
-> (Attr' -> Attr' -> Bool)
-> (Attr' -> Attr' -> Attr')
-> (Attr' -> Attr' -> Attr')
-> Ord Attr'
Attr' -> Attr' -> Bool
Attr' -> Attr' -> Ordering
Attr' -> Attr' -> Attr'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attr' -> Attr' -> Attr'
$cmin :: Attr' -> Attr' -> Attr'
max :: Attr' -> Attr' -> Attr'
$cmax :: Attr' -> Attr' -> Attr'
>= :: Attr' -> Attr' -> Bool
$c>= :: Attr' -> Attr' -> Bool
> :: Attr' -> Attr' -> Bool
$c> :: Attr' -> Attr' -> Bool
<= :: Attr' -> Attr' -> Bool
$c<= :: Attr' -> Attr' -> Bool
< :: Attr' -> Attr' -> Bool
$c< :: Attr' -> Attr' -> Bool
compare :: Attr' -> Attr' -> Ordering
$ccompare :: Attr' -> Attr' -> Ordering
$cp1Ord :: Eq Attr'
Ord, Get Attr'
[Attr'] -> Put
Attr' -> Put
(Attr' -> Put) -> Get Attr' -> ([Attr'] -> Put) -> Binary Attr'
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Attr'] -> Put
$cputList :: [Attr'] -> Put
get :: Get Attr'
$cget :: Get Attr'
put :: Attr' -> Put
$cput :: Attr' -> Put
Binary)

attrName :: Attr' -> String
attrName :: Attr' -> String
attrName (BoolAttr' String
n Bool
_)    = String
n
attrName (IntegerAttr' String
n Integer
_) = String
n
attrName (StringAttr' String
n String
_)  = String
n
attrName (Attr' String
n)          = String
n

-- | Variables in CoreHW
data Var a
  -- | Constructor for type variables
  = TyVar
  { Var a -> Name a
varName :: !(Name a)
  , Var a -> Int
varUniq :: {-# UNPACK #-} !Unique
  -- ^ Invariant: forall x . varUniq x ~ nameUniq (varName x)
  , Var a -> Kind
varType :: Kind
  }
  -- | Constructor for term variables
  | Id
  { varName :: !(Name a)
  , varUniq :: {-# UNPACK #-} !Unique
  -- ^ Invariant: forall x . varUniq x ~ nameUniq (varName x)
  , varType :: Type
  , Var a -> IdScope
idScope :: IdScope
  }
  deriving (Int -> Var a -> ShowS
[Var a] -> ShowS
Var a -> String
(Int -> Var a -> ShowS)
-> (Var a -> String) -> ([Var a] -> ShowS) -> Show (Var a)
forall a. Int -> Var a -> ShowS
forall a. [Var a] -> ShowS
forall a. Var a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var a] -> ShowS
$cshowList :: forall a. [Var a] -> ShowS
show :: Var a -> String
$cshow :: forall a. Var a -> String
showsPrec :: Int -> Var a -> ShowS
$cshowsPrec :: forall a. Int -> Var a -> ShowS
Show,(forall x. Var a -> Rep (Var a) x)
-> (forall x. Rep (Var a) x -> Var a) -> Generic (Var a)
forall x. Rep (Var a) x -> Var a
forall x. Var a -> Rep (Var a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Var a) x -> Var a
forall a x. Var a -> Rep (Var a) x
$cto :: forall a x. Rep (Var a) x -> Var a
$cfrom :: forall a x. Var a -> Rep (Var a) x
Generic,Var a -> ()
(Var a -> ()) -> NFData (Var a)
forall a. Var a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Var a -> ()
$crnf :: forall a. Var a -> ()
NFData,Get (Var a)
[Var a] -> Put
Var a -> Put
(Var a -> Put) -> Get (Var a) -> ([Var a] -> Put) -> Binary (Var a)
forall a. Get (Var a)
forall a. [Var a] -> Put
forall a. Var a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Var a] -> Put
$cputList :: forall a. [Var a] -> Put
get :: Get (Var a)
$cget :: forall a. Get (Var a)
put :: Var a -> Put
$cput :: forall a. Var a -> Put
Binary)

-- | Gets a _key_ in the DBMS sense: a value that uniquely identifies a
-- Var. In case of a "Var" that is its unique and (if applicable) scope
varKey :: Var a -> (Unique, Maybe IdScope)
varKey :: Var a -> (Int, Maybe IdScope)
varKey TyVar{Int
varUniq :: Int
varUniq :: forall a. Var a -> Int
varUniq} = (Int
varUniq, Maybe IdScope
forall a. Maybe a
Nothing)
varKey Id{Int
varUniq :: Int
varUniq :: forall a. Var a -> Int
varUniq,IdScope
idScope :: IdScope
idScope :: forall a. Var a -> IdScope
idScope} = (Int
varUniq, IdScope -> Maybe IdScope
forall a. a -> Maybe a
Just IdScope
idScope)

instance Hashable (Var a) where
  hashWithSalt :: Int -> Var a -> Int
hashWithSalt Int
salt Var a
a = Int -> (Int, Maybe IdScope) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Var a -> (Int, Maybe IdScope)
forall a. Var a -> (Int, Maybe IdScope)
varKey Var a
a)

instance Eq (Var a) where
  == :: Var a -> Var a -> Bool
(==) = (Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Bool)
-> (Var a -> (Int, Maybe IdScope)) -> Var a -> Var a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Var a -> (Int, Maybe IdScope)
forall a. Var a -> (Int, Maybe IdScope)
varKey
  /= :: Var a -> Var a -> Bool
(/=) = (Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ((Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Bool)
-> (Var a -> (Int, Maybe IdScope)) -> Var a -> Var a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Var a -> (Int, Maybe IdScope)
forall a. Var a -> (Int, Maybe IdScope)
varKey

instance Ord (Var a) where
  compare :: Var a -> Var a -> Ordering
compare = (Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, Maybe IdScope) -> (Int, Maybe IdScope) -> Ordering)
-> (Var a -> (Int, Maybe IdScope)) -> Var a -> Var a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Var a -> (Int, Maybe IdScope)
forall a. Var a -> (Int, Maybe IdScope)
varKey

instance Uniquable (Var a) where
  getUnique :: Var a -> Int
getUnique = Var a -> Int
forall a. Var a -> Int
varUniq
  setUnique :: Var a -> Int -> Var a
setUnique Var a
var Int
u = Var a
var {varUniq :: Int
varUniq=Int
u, varName :: Name a
varName=(Var a -> Name a
forall a. Var a -> Name a
varName Var a
var){nameUniq :: Int
nameUniq=Int
u}}

data IdScope = GlobalId | LocalId
  deriving (Int -> IdScope -> ShowS
[IdScope] -> ShowS
IdScope -> String
(Int -> IdScope -> ShowS)
-> (IdScope -> String) -> ([IdScope] -> ShowS) -> Show IdScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdScope] -> ShowS
$cshowList :: [IdScope] -> ShowS
show :: IdScope -> String
$cshow :: IdScope -> String
showsPrec :: Int -> IdScope -> ShowS
$cshowsPrec :: Int -> IdScope -> ShowS
Show,(forall x. IdScope -> Rep IdScope x)
-> (forall x. Rep IdScope x -> IdScope) -> Generic IdScope
forall x. Rep IdScope x -> IdScope
forall x. IdScope -> Rep IdScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdScope x -> IdScope
$cfrom :: forall x. IdScope -> Rep IdScope x
Generic,IdScope -> ()
(IdScope -> ()) -> NFData IdScope
forall a. (a -> ()) -> NFData a
rnf :: IdScope -> ()
$crnf :: IdScope -> ()
NFData,Eq IdScope
Eq IdScope
-> (Int -> IdScope -> Int) -> (IdScope -> Int) -> Hashable IdScope
Int -> IdScope -> Int
IdScope -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: IdScope -> Int
$chash :: IdScope -> Int
hashWithSalt :: Int -> IdScope -> Int
$chashWithSalt :: Int -> IdScope -> Int
$cp1Hashable :: Eq IdScope
Hashable,Get IdScope
[IdScope] -> Put
IdScope -> Put
(IdScope -> Put)
-> Get IdScope -> ([IdScope] -> Put) -> Binary IdScope
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [IdScope] -> Put
$cputList :: [IdScope] -> Put
get :: Get IdScope
$cget :: Get IdScope
put :: IdScope -> Put
$cput :: IdScope -> Put
Binary,IdScope -> IdScope -> Bool
(IdScope -> IdScope -> Bool)
-> (IdScope -> IdScope -> Bool) -> Eq IdScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdScope -> IdScope -> Bool
$c/= :: IdScope -> IdScope -> Bool
== :: IdScope -> IdScope -> Bool
$c== :: IdScope -> IdScope -> Bool
Eq,Eq IdScope
Eq IdScope
-> (IdScope -> IdScope -> Ordering)
-> (IdScope -> IdScope -> Bool)
-> (IdScope -> IdScope -> Bool)
-> (IdScope -> IdScope -> Bool)
-> (IdScope -> IdScope -> Bool)
-> (IdScope -> IdScope -> IdScope)
-> (IdScope -> IdScope -> IdScope)
-> Ord IdScope
IdScope -> IdScope -> Bool
IdScope -> IdScope -> Ordering
IdScope -> IdScope -> IdScope
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IdScope -> IdScope -> IdScope
$cmin :: IdScope -> IdScope -> IdScope
max :: IdScope -> IdScope -> IdScope
$cmax :: IdScope -> IdScope -> IdScope
>= :: IdScope -> IdScope -> Bool
$c>= :: IdScope -> IdScope -> Bool
> :: IdScope -> IdScope -> Bool
$c> :: IdScope -> IdScope -> Bool
<= :: IdScope -> IdScope -> Bool
$c<= :: IdScope -> IdScope -> Bool
< :: IdScope -> IdScope -> Bool
$c< :: IdScope -> IdScope -> Bool
compare :: IdScope -> IdScope -> Ordering
$ccompare :: IdScope -> IdScope -> Ordering
$cp1Ord :: Eq IdScope
Ord)

-- | Term variable
type Id    = Var Term
-- | Type variable
type TyVar = Var Type

-- | Change the name of a variable
modifyVarName ::
  (Name a -> Name a)
  -> Var a
  -> Var a
modifyVarName :: (Name a -> Name a) -> Var a -> Var a
modifyVarName Name a -> Name a
f (TyVar Name a
n Int
_ Kind
k) =
  let n' :: Name a
n' = Name a -> Name a
f Name a
n
  in  Name a -> Int -> Kind -> Var a
forall a. Name a -> Int -> Kind -> Var a
TyVar Name a
n' (Name a -> Int
forall a. Name a -> Int
nameUniq Name a
n') Kind
k
modifyVarName Name a -> Name a
f (Id Name a
n Int
_ Kind
t IdScope
s) =
  let n' :: Name a
n' = Name a -> Name a
f Name a
n
  in  Name a -> Int -> Kind -> IdScope -> Var a
forall a. Name a -> Int -> Kind -> IdScope -> Var a
Id Name a
n' (Name a -> Int
forall a. Name a -> Int
nameUniq Name a
n') Kind
t IdScope
s

-- | Make a type variable
mkTyVar
  :: Kind
  -> TyName
  -> TyVar
mkTyVar :: Kind -> TyName -> TyVar
mkTyVar Kind
tyKind TyName
tyName = TyName -> Int -> Kind -> TyVar
forall a. Name a -> Int -> Kind -> Var a
TyVar TyName
tyName (TyName -> Int
forall a. Name a -> Int
nameUniq TyName
tyName) Kind
tyKind

-- | Make a term variable
mkId
  :: Type
  -> IdScope
  -> TmName
  -> Id
mkId :: Kind -> IdScope -> TmName -> Id
mkId Kind
tmType IdScope
scope TmName
tmName = TmName -> Int -> Kind -> IdScope -> Id
forall a. Name a -> Int -> Kind -> IdScope -> Var a
Id TmName
tmName (TmName -> Int
forall a. Name a -> Int
nameUniq TmName
tmName) Kind
tmType IdScope
scope

mkLocalId
  :: Type
  -> TmName
  -> Id
mkLocalId :: Kind -> TmName -> Id
mkLocalId Kind
tmType TmName
tmName = TmName -> Int -> Kind -> IdScope -> Id
forall a. Name a -> Int -> Kind -> IdScope -> Var a
Id TmName
tmName (TmName -> Int
forall a. Name a -> Int
nameUniq TmName
tmName) Kind
tmType IdScope
LocalId

mkGlobalId
  :: Type
  -> TmName
  -> Id
mkGlobalId :: Kind -> TmName -> Id
mkGlobalId Kind
tmType TmName
tmName = TmName -> Int -> Kind -> IdScope -> Id
forall a. Name a -> Int -> Kind -> IdScope -> Var a
Id TmName
tmName (TmName -> Int
forall a. Name a -> Int
nameUniq TmName
tmName) Kind
tmType IdScope
GlobalId

setVarUnique
  :: Var a
  -> Unique
  -> Var a
setVarUnique :: Var a -> Int -> Var a
setVarUnique Var a
v Int
u = Var a
v { varUniq :: Int
varUniq = Int
u, varName :: Name a
varName = (Var a -> Name a
forall a. Var a -> Name a
varName Var a
v) {nameUniq :: Int
nameUniq = Int
u} }

setVarType
  :: Var a
  -> Type
  -> Var a
setVarType :: Var a -> Kind -> Var a
setVarType Var a
v Kind
t = Var a
v { varType :: Kind
varType = Kind
t }

isGlobalId
  :: Var a
  -> Bool
isGlobalId :: Var a -> Bool
isGlobalId (Id {idScope :: forall a. Var a -> IdScope
idScope = IdScope
GlobalId}) = Bool
True
isGlobalId Var a
_ = Bool
False

isLocalId
  :: Var a
  -> Bool
isLocalId :: Var a -> Bool
isLocalId (Id {idScope :: forall a. Var a -> IdScope
idScope = IdScope
LocalId}) = Bool
True
isLocalId Var a
_  = Bool
False

setIdScope
  :: IdScope
  -> Var a
  -> Var a
setIdScope :: IdScope -> Var a -> Var a
setIdScope IdScope
s (Id Name a
nm Int
u Kind
t IdScope
_) = Name a -> Int -> Kind -> IdScope -> Var a
forall a. Name a -> Int -> Kind -> IdScope -> Var a
Id Name a
nm Int
u Kind
t IdScope
s
setIdScope IdScope
_ Var a
v = Var a
v