{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Cryptol.Parser.Selector
( Selector(..)
, ppSelector
, ppNestedSels
, selName
) where
import GHC.Generics (Generic)
import Control.DeepSeq
import Data.List(intersperse)
import Cryptol.Utils.Ident
import Cryptol.Utils.PP
data Selector = TupleSel Int (Maybe Int)
| RecordSel Ident (Maybe [Ident])
| ListSel Int (Maybe Int)
deriving (Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Eq Selector
Eq Selector
-> (Selector -> Selector -> Ordering)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool)
-> (Selector -> Selector -> Selector)
-> (Selector -> Selector -> Selector)
-> Ord Selector
Selector -> Selector -> Bool
Selector -> Selector -> Ordering
Selector -> Selector -> Selector
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 :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmax :: Selector -> Selector -> Selector
>= :: Selector -> Selector -> Bool
$c>= :: Selector -> Selector -> Bool
> :: Selector -> Selector -> Bool
$c> :: Selector -> Selector -> Bool
<= :: Selector -> Selector -> Bool
$c<= :: Selector -> Selector -> Bool
< :: Selector -> Selector -> Bool
$c< :: Selector -> Selector -> Bool
compare :: Selector -> Selector -> Ordering
$ccompare :: Selector -> Selector -> Ordering
$cp1Ord :: Eq Selector
Ord, (forall x. Selector -> Rep Selector x)
-> (forall x. Rep Selector x -> Selector) -> Generic Selector
forall x. Rep Selector x -> Selector
forall x. Selector -> Rep Selector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Selector x -> Selector
$cfrom :: forall x. Selector -> Rep Selector x
Generic, Selector -> ()
(Selector -> ()) -> NFData Selector
forall a. (a -> ()) -> NFData a
rnf :: Selector -> ()
$crnf :: Selector -> ()
NFData)
instance PP Selector where
ppPrec :: Int -> Selector -> Doc
ppPrec Int
_ Selector
sel =
case Selector
sel of
TupleSel Int
x Maybe Int
sig -> [Doc] -> Doc
sep (Int -> Doc
int Int
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Int -> Doc) -> Maybe Int -> [Doc]
forall t. (t -> Doc) -> Maybe t -> [Doc]
ppSig Int -> Doc
tupleSig Maybe Int
sig)
RecordSel Ident
x Maybe [Ident]
sig -> [Doc] -> Doc
sep (Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ([Ident] -> Doc) -> Maybe [Ident] -> [Doc]
forall t. (t -> Doc) -> Maybe t -> [Doc]
ppSig [Ident] -> Doc
forall a. PP a => [a] -> Doc
recordSig Maybe [Ident]
sig)
ListSel Int
x Maybe Int
sig -> [Doc] -> Doc
sep (Int -> Doc
int Int
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Int -> Doc) -> Maybe Int -> [Doc]
forall t. (t -> Doc) -> Maybe t -> [Doc]
ppSig Int -> Doc
listSig Maybe Int
sig)
where
tupleSig :: Int -> Doc
tupleSig Int
n = Int -> Doc
int Int
n
recordSig :: [a] -> Doc
recordSig [a]
xs = [Doc] -> Doc
ppRecord ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. PP a => a -> Doc
pp [a]
xs
listSig :: Int -> Doc
listSig Int
n = Int -> Doc
int Int
n
ppSig :: (t -> Doc) -> Maybe t -> [Doc]
ppSig t -> Doc
f = [Doc] -> (t -> [Doc]) -> Maybe t -> [Doc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\t
x -> [String -> Doc
text String
"/* of" Doc -> Doc -> Doc
<+> t -> Doc
f t
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"*/"])
ppSelector :: Selector -> Doc
ppSelector :: Selector -> Doc
ppSelector Selector
sel =
case Selector
sel of
TupleSel Int
x Maybe Int
_ -> Int -> Doc
forall a. (Integral a, Show a, Eq a) => a -> Doc
ordinal (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Doc -> Doc -> Doc
<+> String -> Doc
text String
"field"
RecordSel Ident
x Maybe [Ident]
_ -> String -> Doc
text String
"field" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
x
ListSel Int
x Maybe Int
_ -> Int -> Doc
forall a. (Integral a, Show a, Eq a) => a -> Doc
ordinal Int
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"element"
selName :: Selector -> Ident
selName :: Selector -> Ident
selName Selector
s =
case Selector
s of
RecordSel Ident
i Maybe [Ident]
_ -> Ident
i
TupleSel Int
n Maybe Int
_ -> String -> Ident
packIdent (String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
ListSel Int
n Maybe Int
_ -> String -> Ident
packIdent (String
"__" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
ppNestedSels :: [Selector] -> Doc
ppNestedSels :: [Selector] -> Doc
ppNestedSels = [Doc] -> Doc
hcat ([Doc] -> Doc) -> ([Selector] -> [Doc]) -> [Selector] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
"." ([Doc] -> [Doc]) -> ([Selector] -> [Doc]) -> [Selector] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selector -> Doc) -> [Selector] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Selector -> Doc
ppS
where ppS :: Selector -> Doc
ppS Selector
s = case Selector
s of
RecordSel Ident
i Maybe [Ident]
_ -> String -> Doc
text (Ident -> String
unpackIdent Ident
i)
TupleSel Int
n Maybe Int
_ -> Int -> Doc
int Int
n
ListSel Int
n Maybe Int
_ -> Doc -> Doc
brackets (Int -> Doc
int Int
n)