-- |
-- Module      :  Cryptol.Parser.Name
-- Copyright   :  (c) 2015-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE DeriveGeneric #-}

module Cryptol.Parser.Name where

import Cryptol.Utils.Fixity
import Cryptol.Utils.Ident
import Cryptol.Utils.PP
import Cryptol.Utils.Panic (panic)

import           Control.DeepSeq
import           GHC.Generics (Generic)


-- Names -----------------------------------------------------------------------

-- | Names that originate in the parser.
data PName = UnQual !Ident
             -- ^ Unqualified names like @x@, @Foo@, or @+@.
           | Qual !ModName !Ident
             -- ^ Qualified names like @Foo::bar@ or @module::!@.
           | NewName !Pass !Int
             -- ^ Fresh names generated by a pass.
             deriving (PName -> PName -> Bool
(PName -> PName -> Bool) -> (PName -> PName -> Bool) -> Eq PName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PName -> PName -> Bool
$c/= :: PName -> PName -> Bool
== :: PName -> PName -> Bool
$c== :: PName -> PName -> Bool
Eq,Eq PName
Eq PName
-> (PName -> PName -> Ordering)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> Bool)
-> (PName -> PName -> PName)
-> (PName -> PName -> PName)
-> Ord PName
PName -> PName -> Bool
PName -> PName -> Ordering
PName -> PName -> PName
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 :: PName -> PName -> PName
$cmin :: PName -> PName -> PName
max :: PName -> PName -> PName
$cmax :: PName -> PName -> PName
>= :: PName -> PName -> Bool
$c>= :: PName -> PName -> Bool
> :: PName -> PName -> Bool
$c> :: PName -> PName -> Bool
<= :: PName -> PName -> Bool
$c<= :: PName -> PName -> Bool
< :: PName -> PName -> Bool
$c< :: PName -> PName -> Bool
compare :: PName -> PName -> Ordering
$ccompare :: PName -> PName -> Ordering
$cp1Ord :: Eq PName
Ord,Int -> PName -> ShowS
[PName] -> ShowS
PName -> String
(Int -> PName -> ShowS)
-> (PName -> String) -> ([PName] -> ShowS) -> Show PName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PName] -> ShowS
$cshowList :: [PName] -> ShowS
show :: PName -> String
$cshow :: PName -> String
showsPrec :: Int -> PName -> ShowS
$cshowsPrec :: Int -> PName -> ShowS
Show,(forall x. PName -> Rep PName x)
-> (forall x. Rep PName x -> PName) -> Generic PName
forall x. Rep PName x -> PName
forall x. PName -> Rep PName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PName x -> PName
$cfrom :: forall x. PName -> Rep PName x
Generic)

-- | Passes that can generate fresh names.
data Pass = NoPat
          | MonoValues
            deriving (Pass -> Pass -> Bool
(Pass -> Pass -> Bool) -> (Pass -> Pass -> Bool) -> Eq Pass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pass -> Pass -> Bool
$c/= :: Pass -> Pass -> Bool
== :: Pass -> Pass -> Bool
$c== :: Pass -> Pass -> Bool
Eq,Eq Pass
Eq Pass
-> (Pass -> Pass -> Ordering)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Pass)
-> (Pass -> Pass -> Pass)
-> Ord Pass
Pass -> Pass -> Bool
Pass -> Pass -> Ordering
Pass -> Pass -> Pass
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 :: Pass -> Pass -> Pass
$cmin :: Pass -> Pass -> Pass
max :: Pass -> Pass -> Pass
$cmax :: Pass -> Pass -> Pass
>= :: Pass -> Pass -> Bool
$c>= :: Pass -> Pass -> Bool
> :: Pass -> Pass -> Bool
$c> :: Pass -> Pass -> Bool
<= :: Pass -> Pass -> Bool
$c<= :: Pass -> Pass -> Bool
< :: Pass -> Pass -> Bool
$c< :: Pass -> Pass -> Bool
compare :: Pass -> Pass -> Ordering
$ccompare :: Pass -> Pass -> Ordering
$cp1Ord :: Eq Pass
Ord,Int -> Pass -> ShowS
[Pass] -> ShowS
Pass -> String
(Int -> Pass -> ShowS)
-> (Pass -> String) -> ([Pass] -> ShowS) -> Show Pass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pass] -> ShowS
$cshowList :: [Pass] -> ShowS
show :: Pass -> String
$cshow :: Pass -> String
showsPrec :: Int -> Pass -> ShowS
$cshowsPrec :: Int -> Pass -> ShowS
Show,(forall x. Pass -> Rep Pass x)
-> (forall x. Rep Pass x -> Pass) -> Generic Pass
forall x. Rep Pass x -> Pass
forall x. Pass -> Rep Pass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pass x -> Pass
$cfrom :: forall x. Pass -> Rep Pass x
Generic)

instance NFData PName
instance NFData Pass

mkUnqual :: Ident -> PName
mkUnqual :: Ident -> PName
mkUnqual  = Ident -> PName
UnQual

mkQual :: ModName -> Ident -> PName
mkQual :: ModName -> Ident -> PName
mkQual  = ModName -> Ident -> PName
Qual

getModName :: PName -> Maybe ModName
getModName :: PName -> Maybe ModName
getModName (Qual ModName
ns Ident
_) = ModName -> Maybe ModName
forall a. a -> Maybe a
Just ModName
ns
getModName PName
_           = Maybe ModName
forall a. Maybe a
Nothing

getIdent :: PName -> Ident
getIdent :: PName -> Ident
getIdent (UnQual Ident
n)    = Ident
n
getIdent (Qual ModName
_ Ident
n)    = Ident
n
getIdent (NewName Pass
p Int
i) = String -> Ident
packIdent (String
"__" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pass String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
  where
  pass :: String
pass = case Pass
p of
           Pass
NoPat      -> String
"p"
           Pass
MonoValues -> String
"mv"

isGeneratedName :: PName -> Bool
isGeneratedName :: PName -> Bool
isGeneratedName PName
x =
  case PName
x of
    NewName {} -> Bool
True
    PName
_          -> Bool
False

instance PP PName where
  ppPrec :: Int -> PName -> Doc
ppPrec Int
_ = PName -> Doc
forall a. PPName a => a -> Doc
ppPrefixName

instance PPName PName where
  ppNameFixity :: PName -> Maybe Fixity
ppNameFixity PName
n
    | Ident -> Bool
isInfixIdent Ident
i = Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Assoc -> Int -> Fixity
Fixity Assoc
NonAssoc Int
0) -- FIXME?
    | Bool
otherwise      = Maybe Fixity
forall a. Maybe a
Nothing
    where
    i :: Ident
i   = PName -> Ident
getIdent PName
n

  ppPrefixName :: PName -> Doc
ppPrefixName PName
n = Bool -> Doc -> Doc
optParens (Ident -> Bool
isInfixIdent Ident
i) (Doc
pfx Doc -> Doc -> Doc
<.> Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
i)
    where
    i :: Ident
i   = PName -> Ident
getIdent PName
n
    pfx :: Doc
pfx = case PName -> Maybe ModName
getModName PName
n of
            Just ModName
ns -> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
ns Doc -> Doc -> Doc
<.> String -> Doc
text String
"::"
            Maybe ModName
Nothing -> Doc
empty

  ppInfixName :: PName -> Doc
ppInfixName PName
n
    | Ident -> Bool
isInfixIdent Ident
i = Doc
pfx Doc -> Doc -> Doc
<.> Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
i
    | Bool
otherwise      = String -> [String] -> Doc
forall a. HasCallStack => String -> [String] -> a
panic String
"AST" [ String
"non-symbol infix name:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ PName -> String
forall a. Show a => a -> String
show PName
n ]
    where
    i :: Ident
i   = PName -> Ident
getIdent PName
n
    pfx :: Doc
pfx = case PName -> Maybe ModName
getModName PName
n of
            Just ModName
ns -> ModName -> Doc
forall a. PP a => a -> Doc
pp ModName
ns Doc -> Doc -> Doc
<.> String -> Doc
text String
"::"
            Maybe ModName
Nothing -> Doc
empty