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

{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}

module Cryptol.Utils.Ident
  ( -- * Module names
    ModName
  , modNameToText
  , textToModName
  , modNameChunks
  , packModName
  , preludeName
  , preludeReferenceName
  , floatName
  , suiteBName
  , arrayName
  , primeECName
  , interactiveName
  , noModuleName
  , exprModName

  , isParamInstModName
  , paramInstModName
  , notParamInstModName

    -- * Identifiers
  , Ident
  , packIdent
  , packInfix
  , unpackIdent
  , mkIdent
  , mkInfix
  , isInfixIdent
  , nullIdent
  , identText
  , modParamIdent

    -- * Identifiers for primitives
  , PrimIdent(..)
  , prelPrim
  , floatPrim
  , arrayPrim
  , suiteBPrim
  , primeECPrim
  ) where

import           Control.DeepSeq (NFData)
import           Data.Char (isSpace)
import           Data.List (unfoldr)
import qualified Data.Text as T
import           Data.String (IsString(..))
import           GHC.Generics (Generic)


-- | Module names are just text.
data ModName = ModName T.Text
  deriving (ModName -> ModName -> Bool
(ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool) -> Eq ModName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModName -> ModName -> Bool
$c/= :: ModName -> ModName -> Bool
== :: ModName -> ModName -> Bool
$c== :: ModName -> ModName -> Bool
Eq,Eq ModName
Eq ModName
-> (ModName -> ModName -> Ordering)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> ModName)
-> (ModName -> ModName -> ModName)
-> Ord ModName
ModName -> ModName -> Bool
ModName -> ModName -> Ordering
ModName -> ModName -> ModName
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 :: ModName -> ModName -> ModName
$cmin :: ModName -> ModName -> ModName
max :: ModName -> ModName -> ModName
$cmax :: ModName -> ModName -> ModName
>= :: ModName -> ModName -> Bool
$c>= :: ModName -> ModName -> Bool
> :: ModName -> ModName -> Bool
$c> :: ModName -> ModName -> Bool
<= :: ModName -> ModName -> Bool
$c<= :: ModName -> ModName -> Bool
< :: ModName -> ModName -> Bool
$c< :: ModName -> ModName -> Bool
compare :: ModName -> ModName -> Ordering
$ccompare :: ModName -> ModName -> Ordering
$cp1Ord :: Eq ModName
Ord,Int -> ModName -> ShowS
[ModName] -> ShowS
ModName -> String
(Int -> ModName -> ShowS)
-> (ModName -> String) -> ([ModName] -> ShowS) -> Show ModName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModName] -> ShowS
$cshowList :: [ModName] -> ShowS
show :: ModName -> String
$cshow :: ModName -> String
showsPrec :: Int -> ModName -> ShowS
$cshowsPrec :: Int -> ModName -> ShowS
Show,(forall x. ModName -> Rep ModName x)
-> (forall x. Rep ModName x -> ModName) -> Generic ModName
forall x. Rep ModName x -> ModName
forall x. ModName -> Rep ModName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModName x -> ModName
$cfrom :: forall x. ModName -> Rep ModName x
Generic)

instance NFData ModName

modNameToText :: ModName -> T.Text
modNameToText :: ModName -> Text
modNameToText (ModName Text
x) = Text
x

textToModName :: T.Text -> ModName
textToModName :: Text -> ModName
textToModName = Text -> ModName
ModName

modNameChunks :: ModName -> [String]
modNameChunks :: ModName -> [String]
modNameChunks  = (Text -> Maybe (String, Text)) -> Text -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (String, Text)
step (Text -> [String]) -> (ModName -> Text) -> ModName -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> Text
modNameToText (ModName -> Text) -> (ModName -> ModName) -> ModName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> ModName
notParamInstModName
  where
  step :: Text -> Maybe (String, Text)
step Text
str
    | Text -> Bool
T.null Text
str = Maybe (String, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise  = case Text -> Text -> (Text, Text)
T.breakOn Text
modSep Text
str of
                     (Text
a,Text
b) -> (String, Text) -> Maybe (String, Text)
forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
a,Int -> Text -> Text
T.drop (Text -> Int
T.length Text
modSep) Text
b)

isParamInstModName :: ModName -> Bool
isParamInstModName :: ModName -> Bool
isParamInstModName (ModName Text
x) = Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x

-- | Convert a parameterized module's name to the name of the module
-- containing the same definitions but with explicit parameters on each
-- definition.
paramInstModName :: ModName -> ModName
paramInstModName :: ModName -> ModName
paramInstModName (ModName Text
x)
  | Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text -> ModName
ModName Text
x
  | Bool
otherwise = Text -> ModName
ModName (Text -> Text -> Text
T.append Text
modInstPref Text
x)


notParamInstModName :: ModName -> ModName
notParamInstModName :: ModName -> ModName
notParamInstModName (ModName Text
x)
  | Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text -> ModName
ModName (Int -> Text -> Text
T.drop (Text -> Int
T.length Text
modInstPref) Text
x)
  | Bool
otherwise = Text -> ModName
ModName Text
x


packModName :: [T.Text] -> ModName
packModName :: [Text] -> ModName
packModName [Text]
strs = Text -> ModName
textToModName (Text -> [Text] -> Text
T.intercalate Text
modSep ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim [Text]
strs))
  where
  -- trim space off of the start and end of the string
  trim :: Text -> Text
trim Text
str = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace ((Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
str)

modSep :: T.Text
modSep :: Text
modSep  = Text
"::"

modInstPref :: T.Text
modInstPref :: Text
modInstPref = Text
"`"


preludeName :: ModName
preludeName :: ModName
preludeName  = [Text] -> ModName
packModName [Text
"Cryptol"]

preludeReferenceName :: ModName
preludeReferenceName :: ModName
preludeReferenceName = [Text] -> ModName
packModName [Text
"Cryptol",Text
"Reference"]

floatName :: ModName
floatName :: ModName
floatName = [Text] -> ModName
packModName [Text
"Float"]

arrayName :: ModName
arrayName :: ModName
arrayName  = [Text] -> ModName
packModName [Text
"Array"]

suiteBName :: ModName
suiteBName :: ModName
suiteBName = [Text] -> ModName
packModName [Text
"SuiteB"]

primeECName :: ModName
primeECName :: ModName
primeECName = [Text] -> ModName
packModName [Text
"PrimeEC"]

interactiveName :: ModName
interactiveName :: ModName
interactiveName  = [Text] -> ModName
packModName [Text
"<interactive>"]

noModuleName :: ModName
noModuleName :: ModName
noModuleName = [Text] -> ModName
packModName [Text
"<none>"]

exprModName :: ModName
exprModName :: ModName
exprModName = [Text] -> ModName
packModName [Text
"<expr>"]


--------------------------------------------------------------------------------

-- | Identifiers, along with a flag that indicates whether or not they're infix
-- operators. The boolean is present just as cached information from the lexer,
-- and never used during comparisons.
data Ident = Ident Bool T.Text
             deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show,(forall x. Ident -> Rep Ident x)
-> (forall x. Rep Ident x -> Ident) -> Generic Ident
forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic)

instance Eq Ident where
  Ident
a == :: Ident -> Ident -> Bool
== Ident
b = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
a Ident
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  Ident
a /= :: Ident -> Ident -> Bool
/= Ident
b = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
a Ident
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ

instance Ord Ident where
  compare :: Ident -> Ident -> Ordering
compare (Ident Bool
_ Text
i1) (Ident Bool
_ Text
i2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
i1 Text
i2

instance IsString Ident where
  fromString :: String -> Ident
fromString String
str = Text -> Ident
mkIdent (String -> Text
T.pack String
str)

instance NFData Ident

packIdent :: String -> Ident
packIdent :: String -> Ident
packIdent  = Text -> Ident
mkIdent (Text -> Ident) -> (String -> Text) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

packInfix :: String -> Ident
packInfix :: String -> Ident
packInfix  = Text -> Ident
mkInfix (Text -> Ident) -> (String -> Text) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

unpackIdent :: Ident -> String
unpackIdent :: Ident -> String
unpackIdent  = Text -> String
T.unpack (Text -> String) -> (Ident -> Text) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
identText

mkIdent :: T.Text -> Ident
mkIdent :: Text -> Ident
mkIdent  = Bool -> Text -> Ident
Ident Bool
False

mkInfix :: T.Text -> Ident
mkInfix :: Text -> Ident
mkInfix  = Bool -> Text -> Ident
Ident Bool
True

isInfixIdent :: Ident -> Bool
isInfixIdent :: Ident -> Bool
isInfixIdent (Ident Bool
b Text
_) = Bool
b

nullIdent :: Ident -> Bool
nullIdent :: Ident -> Bool
nullIdent (Ident Bool
_ Text
t) = Text -> Bool
T.null Text
t

identText :: Ident -> T.Text
identText :: Ident -> Text
identText (Ident Bool
_ Text
t) = Text
t

modParamIdent :: Ident -> Ident
modParamIdent :: Ident -> Ident
modParamIdent (Ident Bool
x Text
t) = Bool -> Text -> Ident
Ident Bool
x (Text -> Text -> Text
T.append (String -> Text
T.pack String
"module parameter ") Text
t)


--------------------------------------------------------------------------------

{- | A way to identify primitives: we used to use just 'Ident', but this
isn't good anymore as now we have primitives in multiple modules.
This is used as a key when we need to lookup details about a specific
primitive.  Also, this is intended to mostly be used internally, so
we don't store the fixity flag of the `Ident` -}
data PrimIdent = PrimIdent ModName T.Text
  deriving (PrimIdent -> PrimIdent -> Bool
(PrimIdent -> PrimIdent -> Bool)
-> (PrimIdent -> PrimIdent -> Bool) -> Eq PrimIdent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimIdent -> PrimIdent -> Bool
$c/= :: PrimIdent -> PrimIdent -> Bool
== :: PrimIdent -> PrimIdent -> Bool
$c== :: PrimIdent -> PrimIdent -> Bool
Eq,Eq PrimIdent
Eq PrimIdent
-> (PrimIdent -> PrimIdent -> Ordering)
-> (PrimIdent -> PrimIdent -> Bool)
-> (PrimIdent -> PrimIdent -> Bool)
-> (PrimIdent -> PrimIdent -> Bool)
-> (PrimIdent -> PrimIdent -> Bool)
-> (PrimIdent -> PrimIdent -> PrimIdent)
-> (PrimIdent -> PrimIdent -> PrimIdent)
-> Ord PrimIdent
PrimIdent -> PrimIdent -> Bool
PrimIdent -> PrimIdent -> Ordering
PrimIdent -> PrimIdent -> PrimIdent
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 :: PrimIdent -> PrimIdent -> PrimIdent
$cmin :: PrimIdent -> PrimIdent -> PrimIdent
max :: PrimIdent -> PrimIdent -> PrimIdent
$cmax :: PrimIdent -> PrimIdent -> PrimIdent
>= :: PrimIdent -> PrimIdent -> Bool
$c>= :: PrimIdent -> PrimIdent -> Bool
> :: PrimIdent -> PrimIdent -> Bool
$c> :: PrimIdent -> PrimIdent -> Bool
<= :: PrimIdent -> PrimIdent -> Bool
$c<= :: PrimIdent -> PrimIdent -> Bool
< :: PrimIdent -> PrimIdent -> Bool
$c< :: PrimIdent -> PrimIdent -> Bool
compare :: PrimIdent -> PrimIdent -> Ordering
$ccompare :: PrimIdent -> PrimIdent -> Ordering
$cp1Ord :: Eq PrimIdent
Ord,Int -> PrimIdent -> ShowS
[PrimIdent] -> ShowS
PrimIdent -> String
(Int -> PrimIdent -> ShowS)
-> (PrimIdent -> String)
-> ([PrimIdent] -> ShowS)
-> Show PrimIdent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimIdent] -> ShowS
$cshowList :: [PrimIdent] -> ShowS
show :: PrimIdent -> String
$cshow :: PrimIdent -> String
showsPrec :: Int -> PrimIdent -> ShowS
$cshowsPrec :: Int -> PrimIdent -> ShowS
Show,(forall x. PrimIdent -> Rep PrimIdent x)
-> (forall x. Rep PrimIdent x -> PrimIdent) -> Generic PrimIdent
forall x. Rep PrimIdent x -> PrimIdent
forall x. PrimIdent -> Rep PrimIdent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrimIdent x -> PrimIdent
$cfrom :: forall x. PrimIdent -> Rep PrimIdent x
Generic)

-- | A shortcut to make (non-infix) primitives in the prelude.
prelPrim :: T.Text -> PrimIdent
prelPrim :: Text -> PrimIdent
prelPrim = ModName -> Text -> PrimIdent
PrimIdent ModName
preludeName

floatPrim :: T.Text -> PrimIdent
floatPrim :: Text -> PrimIdent
floatPrim = ModName -> Text -> PrimIdent
PrimIdent ModName
floatName

suiteBPrim :: T.Text -> PrimIdent
suiteBPrim :: Text -> PrimIdent
suiteBPrim = ModName -> Text -> PrimIdent
PrimIdent ModName
suiteBName

primeECPrim :: T.Text -> PrimIdent
primeECPrim :: Text -> PrimIdent
primeECPrim = ModName -> Text -> PrimIdent
PrimIdent ModName
primeECName

arrayPrim :: T.Text -> PrimIdent
arrayPrim :: Text -> PrimIdent
arrayPrim = ModName -> Text -> PrimIdent
PrimIdent ModName
arrayName

instance NFData PrimIdent