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

  Names
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module Clash.Core.Name
  ( module Clash.Core.Name
  , noSrcSpan
  )
where

import           Control.DeepSeq                        (NFData)
import           Data.Binary                            (Binary)
import           Data.Function                          (on)
import           Data.Hashable                          (Hashable (..))
import           Data.Text                              (Text, append)
import           GHC.BasicTypes.Extra                   ()
import           GHC.Generics                           (Generic)
import           GHC.SrcLoc.Extra                       ()
import           GHC.Types.SrcLoc
  (SrcSpan, leftmost_smallest, noSrcSpan)

import           Clash.Unique

data Name a
  = Name
  { forall a. Name a -> NameSort
nameSort :: NameSort
  , forall a. Name a -> OccName
nameOcc  :: !OccName
  , forall a. Name a -> Unique
nameUniq :: {-# UNPACK #-} !Unique
  , forall a. Name a -> SrcSpan
nameLoc  :: !SrcSpan
  }
  deriving (Int -> Name a -> ShowS
[Name a] -> ShowS
Name a -> String
(Int -> Name a -> ShowS)
-> (Name a -> String) -> ([Name a] -> ShowS) -> Show (Name a)
forall a. Int -> Name a -> ShowS
forall a. [Name a] -> ShowS
forall a. Name a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Name a -> ShowS
showsPrec :: Int -> Name a -> ShowS
$cshow :: forall a. Name a -> String
show :: Name a -> String
$cshowList :: forall a. [Name a] -> ShowS
showList :: [Name a] -> ShowS
Show,(forall x. Name a -> Rep (Name a) x)
-> (forall x. Rep (Name a) x -> Name a) -> Generic (Name a)
forall x. Rep (Name a) x -> Name a
forall x. Name a -> Rep (Name a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Name a) x -> Name a
forall a x. Name a -> Rep (Name a) x
$cfrom :: forall a x. Name a -> Rep (Name a) x
from :: forall x. Name a -> Rep (Name a) x
$cto :: forall a x. Rep (Name a) x -> Name a
to :: forall x. Rep (Name a) x -> Name a
Generic,Name a -> ()
(Name a -> ()) -> NFData (Name a)
forall a. Name a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. Name a -> ()
rnf :: Name a -> ()
NFData,Get (Name a)
[Name a] -> Put
Name a -> Put
(Name a -> Put)
-> Get (Name a) -> ([Name a] -> Put) -> Binary (Name a)
forall a. Get (Name a)
forall a. [Name a] -> Put
forall a. Name a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: forall a. Name a -> Put
put :: Name a -> Put
$cget :: forall a. Get (Name a)
get :: Get (Name a)
$cputList :: forall a. [Name a] -> Put
putList :: [Name a] -> Put
Binary)

-- | N.B.: Equality checking only compares uniques, which only identify a name
-- within one scope. If you want structural equality, use `eqName`.
instance Eq (Name a) where
  == :: Name a -> Name a -> Bool
(==) = Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Unique -> Unique -> Bool)
-> (Name a -> Unique) -> Name a -> Name a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name a -> Unique
forall a. Name a -> Unique
nameUniq
  /= :: Name a -> Name a -> Bool
(/=) = Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Unique -> Unique -> Bool)
-> (Name a -> Unique) -> Name a -> Name a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name a -> Unique
forall a. Name a -> Unique
nameUniq

-- | N.B.: Comparison only looks at uniques, which only identify a name within
-- one scope. If you want structural comparison, use `ordName`.
instance Ord (Name a) where
  compare :: Name a -> Name a -> Ordering
compare = Unique -> Unique -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Unique -> Unique -> Ordering)
-> (Name a -> Unique) -> Name a -> Name a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name a -> Unique
forall a. Name a -> Unique
nameUniq

-- | Structural equality on 'Name's. See 'ordName'.
eqName :: Name a -> Name a -> Bool
eqName :: forall a. Name a -> Name a -> Bool
eqName Name a
n1 Name a
n2 = Name a -> Name a -> Ordering
forall a. Name a -> Name a -> Ordering
ordName Name a
n1 Name a
n2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Structural comparison on 'Name's: on top of the 'Ord' instance, which only
-- compares uniques, this compares every other field too.
--
-- 'SrcSpan's are compared with 'leftmost_smallest', which treats all unhelpful
-- spans alike, matching how they are hashed in "Clash.Core.Subst".
ordName :: Name a -> Name a -> Ordering
ordName :: forall a. Name a -> Name a -> Ordering
ordName Name a
n1 Name a
n2 =
  Unique -> Unique -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name a -> Unique
forall a. Name a -> Unique
nameUniq Name a
n1) (Name a -> Unique
forall a. Name a -> Unique
nameUniq Name a
n2)
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> NameSort -> NameSort -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name a -> NameSort
forall a. Name a -> NameSort
nameSort Name a
n1) (Name a -> NameSort
forall a. Name a -> NameSort
nameSort Name a
n2)
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Name a -> OccName
forall a. Name a -> OccName
nameOcc Name a
n1) (Name a -> OccName
forall a. Name a -> OccName
nameOcc Name a
n2)
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (Name a -> SrcSpan
forall a. Name a -> SrcSpan
nameLoc Name a
n1) (Name a -> SrcSpan
forall a. Name a -> SrcSpan
nameLoc Name a
n2)

instance Hashable (Name a) where
  hashWithSalt :: Int -> Name a -> Int
hashWithSalt Int
salt Name a
nm = Int -> Unique -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Name a -> Unique
forall a. Name a -> Unique
nameUniq Name a
nm)

instance Uniquable (Name a) where
  getUnique :: Name a -> Unique
getUnique = Name a -> Unique
forall a. Name a -> Unique
nameUniq
  setUnique :: Name a -> Unique -> Name a
setUnique Name a
nm Unique
u = Name a
nm {nameUniq=u}

type OccName = Text

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

mkUnsafeName
  :: NameSort
  -> Text
  -> Unique
  -> Name a
mkUnsafeName :: forall a. NameSort -> OccName -> Unique -> Name a
mkUnsafeName NameSort
ns OccName
s Unique
i = NameSort -> OccName -> Unique -> SrcSpan -> Name a
forall a. NameSort -> OccName -> Unique -> SrcSpan -> Name a
Name NameSort
ns OccName
s Unique
i SrcSpan
noSrcSpan

mkUnsafeSystemName
  :: Text
  -> Unique
  -> Name a
mkUnsafeSystemName :: forall a. OccName -> Unique -> Name a
mkUnsafeSystemName OccName
s Unique
i = NameSort -> OccName -> Unique -> SrcSpan -> Name a
forall a. NameSort -> OccName -> Unique -> SrcSpan -> Name a
Name NameSort
System OccName
s Unique
i SrcSpan
noSrcSpan

mkUnsafeInternalName
  :: Text
  -> Unique
  -> Name a
mkUnsafeInternalName :: forall a. OccName -> Unique -> Name a
mkUnsafeInternalName OccName
s Unique
i = NameSort -> OccName -> Unique -> SrcSpan -> Name a
forall a. NameSort -> OccName -> Unique -> SrcSpan -> Name a
Name NameSort
Internal (OccName
"c$" OccName -> OccName -> OccName
`append` OccName
s) Unique
i SrcSpan
noSrcSpan

appendToName :: Name a -> Text -> Name a
appendToName :: forall a. Name a -> OccName -> Name a
appendToName (Name NameSort
sort OccName
nm Unique
uniq SrcSpan
loc) OccName
s = NameSort -> OccName -> Unique -> SrcSpan -> Name a
forall a. NameSort -> OccName -> Unique -> SrcSpan -> Name a
Name NameSort
Internal OccName
nm2 Unique
uniq SrcSpan
loc
  where
    nm1 :: OccName
nm1 = case NameSort
sort of {NameSort
Internal -> OccName
nm; NameSort
_ -> OccName
"c$" OccName -> OccName -> OccName
`append` OccName
nm}
    nm2 :: OccName
nm2 = OccName
nm1 OccName -> OccName -> OccName
`append` OccName
s