module Language.Bluespec.Classic.AST.Id
( Id
, addIdProp
, addIdProps
, createPositionString
, enumId
, getIdBase
, getIdBaseString
, getIdPosition
, getIdProps
, getIdQual
, getIdQualString
, getIdString
, mkId
, mkQId
, ppConId
, ppId
, ppVarId
, qualEq
, setBadId
, setIdProps
, IdProp(..)
, Longname
) where
import Data.Char (isDigit)
import qualified Data.List as L
import Text.PrettyPrint.HughesPJClass
import Language.Bluespec.Classic.AST.Builtin.FStrings
import Language.Bluespec.Classic.AST.FString
import Language.Bluespec.Classic.AST.Position
import Language.Bluespec.Lex
import Language.Bluespec.Prelude
import Language.Bluespec.Pretty
import Language.Bluespec.Util
data Id = Id { Id -> Position
id_pos :: !Position,
Id -> FString
id_mfs :: !FString,
Id -> FString
id_fs :: !FString,
Id -> [IdProp]
id_props :: [IdProp]
}
idEq :: Id -> Id -> Bool
idEq :: Id -> Id -> Bool
idEq Id
a Id
b = (Id -> FString
id_fs Id
a FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== Id -> FString
id_fs Id
b) Bool -> Bool -> Bool
&& (Id -> FString
id_mfs Id
a FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== Id -> FString
id_mfs Id
b)
idCompare :: Id -> Id -> Ordering
idCompare :: Id -> Id -> Ordering
idCompare Id
a Id
b = case (FString -> FString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Id -> FString
id_fs Id
a) (Id -> FString
id_fs Id
b)) of
Ordering
EQ -> FString -> FString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Id -> FString
id_mfs Id
a) (Id -> FString
id_mfs Id
b)
Ordering
LT -> Ordering
LT
Ordering
GT -> Ordering
GT
instance Eq Id where
Id
a == :: Id -> Id -> Bool
== Id
b = Id -> Id -> Bool
idEq Id
a Id
b
instance Ord Id where
compare :: Id -> Id -> Ordering
compare = Id -> Id -> Ordering
idCompare
instance Show Id where
show :: Id -> String
show = Id -> String
show_brief
instance Pretty Id where
pPrintPrec :: PDetail -> Rational -> Id -> Doc
pPrintPrec PDetail
d Rational
_p Id
i
| PDetail
d PDetail -> PDetail -> Bool
forall a. Eq a => a -> a -> Bool
== PDetail
pdDebug
= String -> Doc
text (Id -> String
local_show Id
i)
| Bool
otherwise
= if (Int
dbgLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1)
then String -> Doc
text ((Id -> String
getIdString Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
else String -> Doc
text (Id -> String
getIdString Id
i)
instance HasPosition Id where
getPosition :: Id -> Position
getPosition Id
i = Id -> Position
getIdPosition Id
i
local_show :: Id -> String
local_show :: Id -> String
local_show Id
id' =
let
pos :: Position
pos = Id -> Position
getIdPosition Id
id'
mfs :: String
mfs = Id -> String
getIdQualString Id
id'
fs :: String
fs = Id -> String
getIdBaseString Id
id'
str :: String
str = Position -> String
forall a. Show a => a -> String
show Position
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
ShowS
forall a. Show a => a -> String
show String
mfs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
ShowS
forall a. Show a => a -> String
show String
fs
in String
str
show_brief :: Id -> String
show_brief :: Id -> String
show_brief Id
i =
case (FString -> String
getFString (Id -> FString
id_mfs Id
i), FString -> String
getFString (Id -> FString
id_fs Id
i)) of
(String
"", String
str) -> ShowS
add_props String
str
(String
pkg, String
str) -> ShowS
add_props (String
pkg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"::" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str)
where add_props :: ShowS
add_props String
str | [IdProp] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Id -> [IdProp]
id_props Id
i) = String
str
| Bool
otherwise = String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ [IdProp] -> String
forall a. Show a => a -> String
show (Id -> [IdProp]
id_props Id
i)
createPositionString :: Position -> String
createPositionString :: Position -> String
createPositionString Position
_ = String
"<NoPos>"
enumId :: String -> Position -> Int -> Id
enumId :: String -> Position -> Int -> Id
enumId String
str Position
pos Int
index =
let id_str :: FString
id_str = Int -> String -> FString
tmpFString Int
index (String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. ToString a => a -> String
itos Int
index)
in Id -> Id
setBadId
(Position -> FString -> FString -> [IdProp] -> Id
Id Position
pos FString
fsEmpty FString
id_str [])
getIdBase :: Id -> FString
getIdBase :: Id -> FString
getIdBase Id
a = Id -> FString
id_fs Id
a
getIdBaseString :: Id -> String
getIdBaseString :: Id -> String
getIdBaseString Id
a = FString -> String
getFString (FString -> String) -> FString -> String
forall a b. (a -> b) -> a -> b
$ Id -> FString
getIdBase Id
a
getIdPosition :: Id -> Position
getIdPosition :: Id -> Position
getIdPosition Id
a = Id -> Position
id_pos Id
a
getIdProps :: Id -> [IdProp]
getIdProps :: Id -> [IdProp]
getIdProps Id
a = Id -> [IdProp]
id_props Id
a
getIdQual :: Id -> FString
getIdQual :: Id -> FString
getIdQual Id
a = Id -> FString
id_mfs Id
a
getIdQualString :: Id -> String
getIdQualString :: Id -> String
getIdQualString Id
a = FString -> String
getFString (FString -> String) -> FString -> String
forall a b. (a -> b) -> a -> b
$ Id -> FString
getIdQual Id
a
getIdString :: Id -> String
getIdString :: Id -> String
getIdString Id
a | FString
mfs FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== FString
fsEmpty = FString -> String
getFString FString
fs
| Bool
otherwise = FString -> String
getFString FString
mfs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ FString -> String
getFString FString
fs
where mfs :: FString
mfs = Id -> FString
getIdQual Id
a
fs :: FString
fs = Id -> FString
getIdBase Id
a
mkId :: Position -> FString -> Id
mkId :: Position -> FString -> Id
mkId Position
pos FString
fs =
let value :: Id
value = Position -> FString -> FString -> [IdProp] -> Id
Id Position
pos FString
fsEmpty FString
fs []
in
Id
value
mkQId :: Position -> FString -> FString -> Id
mkQId :: Position -> FString -> FString -> Id
mkQId Position
pos FString
mfs FString
fs
| FString
fs FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== FString
fsEmpty = Position -> FString -> FString -> [IdProp] -> Id
Id Position
pos FString
fsEmpty FString
fsEmpty []
| Char
fHead:String
_ <- FString -> String
getFString FString
fs
, Char -> Bool
isDigit Char
fHead = Position -> FString -> FString -> [IdProp] -> Id
Id Position
pos FString
fsEmpty FString
fs []
| Bool
otherwise = Position -> FString -> FString -> [IdProp] -> Id
Id Position
pos FString
mfs FString
fs []
ppConId :: PDetail -> Id -> Doc
ppConId :: PDetail -> Id -> Doc
ppConId PDetail
d Id
i
| PDetail
d PDetail -> PDetail -> Bool
forall a. Eq a => a -> a -> Bool
== PDetail
pdDebug
= PDetail -> Rational -> Id -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
pdDebug Rational
0 Id
i
| Bool
otherwise
=
case (Id -> String
getIdBaseString Id
i) of
String
"->" -> String -> Doc
text String
"(->)"
s :: String
s@(Char
_:String
_) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
s -> String -> Doc
text String
s
String
_ -> String -> Doc
text (Id -> String
getIdStringCon Id
i)
ppId :: PDetail -> Id -> Doc
ppId :: PDetail -> Id -> Doc
ppId PDetail
d Id
i
| PDetail
d PDetail -> PDetail -> Bool
forall a. Eq a => a -> a -> Bool
== PDetail
pdDebug
= PDetail -> Rational -> Id -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
pdDebug Rational
0 Id
i
| Bool
otherwise
= if (Int
dbgLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1)
then case (Id -> String
getIdBaseString Id
i) of
String
"->" -> String -> Doc
text String
"(->)"
s :: String
s@(Char
c:String
_) | Char -> Bool
isDigit Char
c -> String -> Doc
text( String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text ((Id -> String
getIdString Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
Char
'$':Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text (Id -> String
getIdString Id
i)
String
_ -> String -> Doc
text (String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
getIdString Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
else case (Id -> String
getIdBaseString Id
i) of
String
"->" -> String -> Doc
text String
"(->)"
s :: String
s@(Char
c:String
_) | Char -> Bool
isDigit Char
c -> String -> Doc
text String
s
Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text (Id -> String
getIdString Id
i)
Char
'$':Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text (Id -> String
getIdString Id
i)
String
_ -> String -> Doc
text (String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++Id -> String
getIdString Id
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")")
ppVarId :: PDetail -> Id -> Doc
ppVarId :: PDetail -> Id -> Doc
ppVarId PDetail
d Id
i
| PDetail
d PDetail -> PDetail -> Bool
forall a. Eq a => a -> a -> Bool
== PDetail
pdDebug
= PDetail -> Rational -> Id -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
pdDebug Rational
0 Id
i
| Bool
otherwise
= if (Int
dbgLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1)
then case (Id -> String
getIdBaseString Id
i) of
String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSym String
s -> String -> Doc
text (String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
getIdStringOp Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)) String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
")")
Char
'$':Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text ((Id -> String
getIdStringVar Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
String
_ -> String -> Doc
text ((Id -> String
getIdStringVar Id
i) String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Position -> String
createPositionString (Id -> Position
getIdPosition Id
i)))
else case (Id -> String
getIdBaseString Id
i) of
String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSym String
s -> String -> Doc
text (String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++Id -> String
getIdStringOp Id
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
Char
'$':Char
c:String
_ | Char -> Bool
isIdChar Char
c -> String -> Doc
text (Id -> String
getIdStringVar Id
i)
String
_ -> String -> Doc
text (Id -> String
getIdStringVar Id
i)
qualEq :: Id -> Id -> Bool
qualEq :: Id -> Id -> Bool
qualEq Id
a Id
b | Id -> FString
getIdQual Id
a FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== FString
fsEmpty Bool -> Bool -> Bool
|| Id -> FString
getIdQual Id
b FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== FString
fsEmpty = Id -> FString
getIdBase Id
a FString -> FString -> Bool
forall a. Eq a => a -> a -> Bool
== Id -> FString
getIdBase Id
b
qualEq Id
a Id
b = Id
a Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
b
setBadId :: Id -> Id
setBadId :: Id -> Id
setBadId Id
idx = Id -> IdProp -> Id
addIdProp Id
idx IdProp
IdP_bad_name
setIdProps :: Id -> [IdProp] -> Id
setIdProps :: Id -> [IdProp] -> Id
setIdProps Id
a [IdProp]
l = Id
a { id_props = l }
getIdStringCon :: Id -> String
getIdStringCon :: Id -> String
getIdStringCon = Id -> String
getIdString
getIdStringVar :: Id -> String
getIdStringVar :: Id -> String
getIdStringVar = Id -> String
getIdString
getIdStringOp :: Id -> String
getIdStringOp :: Id -> String
getIdStringOp = Id -> String
getIdString
data IdProp = IdPCanFire
| IdPWillFire
| IdPProbe
| IdPInternal
| IdPReady
| IdPGeneratedIfc
| IdPMeth
| IdPCommutativeTCon
| IdP_enable
| IdP_keep
| IdP_keepEvenUnused
| IdPRule
| IdPSplitRule
| IdPDict
| IdPRenaming
| IdP_suffixed
| IdP_SuffixCount Integer
| IdP_bad_name
| IdP_from_rhs
| IdP_signed
| IdP_NakedInst
| IdPDisplayName FString
| IdP_hide
| IdP_hide_all
| IdP_TypeJoin Id Id
| IdPMethodPredicate
| IdPInlinedPositions [Position]
| IdPParserGenerated
deriving (IdProp -> IdProp -> Bool
(IdProp -> IdProp -> Bool)
-> (IdProp -> IdProp -> Bool) -> Eq IdProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdProp -> IdProp -> Bool
== :: IdProp -> IdProp -> Bool
$c/= :: IdProp -> IdProp -> Bool
/= :: IdProp -> IdProp -> Bool
Eq, Eq IdProp
Eq IdProp =>
(IdProp -> IdProp -> Ordering)
-> (IdProp -> IdProp -> Bool)
-> (IdProp -> IdProp -> Bool)
-> (IdProp -> IdProp -> Bool)
-> (IdProp -> IdProp -> Bool)
-> (IdProp -> IdProp -> IdProp)
-> (IdProp -> IdProp -> IdProp)
-> Ord IdProp
IdProp -> IdProp -> Bool
IdProp -> IdProp -> Ordering
IdProp -> IdProp -> IdProp
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 :: IdProp -> IdProp -> Ordering
compare :: IdProp -> IdProp -> Ordering
$c< :: IdProp -> IdProp -> Bool
< :: IdProp -> IdProp -> Bool
$c<= :: IdProp -> IdProp -> Bool
<= :: IdProp -> IdProp -> Bool
$c> :: IdProp -> IdProp -> Bool
> :: IdProp -> IdProp -> Bool
$c>= :: IdProp -> IdProp -> Bool
>= :: IdProp -> IdProp -> Bool
$cmax :: IdProp -> IdProp -> IdProp
max :: IdProp -> IdProp -> IdProp
$cmin :: IdProp -> IdProp -> IdProp
min :: IdProp -> IdProp -> IdProp
Ord, Int -> IdProp -> ShowS
[IdProp] -> ShowS
IdProp -> String
(Int -> IdProp -> ShowS)
-> (IdProp -> String) -> ([IdProp] -> ShowS) -> Show IdProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdProp -> ShowS
showsPrec :: Int -> IdProp -> ShowS
$cshow :: IdProp -> String
show :: IdProp -> String
$cshowList :: [IdProp] -> ShowS
showList :: [IdProp] -> ShowS
Show)
instance Pretty IdProp where
pPrintPrec :: PDetail -> Rational -> IdProp -> Doc
pPrintPrec PDetail
d Rational
_ (IdPInlinedPositions [Position]
poss) =
Bool -> Doc -> Doc
pparen Bool
True (String -> Doc
text String
"IdPInlinedPositions" Doc -> Doc -> Doc
<+> PDetail -> Rational -> [Position] -> Doc
forall a. Pretty a => PDetail -> Rational -> a -> Doc
pPrintPrec PDetail
d Rational
0 [Position]
poss)
pPrintPrec PDetail
_ Rational
_ IdProp
prop = String -> Doc
text (IdProp -> String
forall a. Show a => a -> String
show IdProp
prop)
addIdProp :: Id -> IdProp -> Id
addIdProp :: Id -> IdProp -> Id
addIdProp Id
a IdProp
prop = Id -> [IdProp] -> Id
setIdProps Id
a ([IdProp] -> [IdProp] -> [IdProp]
forall a. Eq a => [a] -> [a] -> [a]
L.union (Id -> [IdProp]
getIdProps Id
a) [IdProp
prop])
addIdProps :: Id -> [IdProp] -> Id
addIdProps :: Id -> [IdProp] -> Id
addIdProps Id
a [IdProp]
propl = Id -> [IdProp] -> Id
setIdProps Id
a ([IdProp] -> [IdProp] -> [IdProp]
forall a. Eq a => [a] -> [a] -> [a]
L.union (Id -> [IdProp]
getIdProps Id
a) [IdProp]
propl)
type Longname = [Id]