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

{-# 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


{- | Selectors are used for projecting from various components.
Each selector has an option spec to specify the shape of the thing
that is being selected.  Currently, there is no surface syntax for
list selectors, but they are used during the desugaring of patterns.
-}

data Selector = TupleSel Int   (Maybe Int)
                -- ^ Zero-based tuple selection.
                -- Optionally specifies the shape of the tuple (one-based).

              | RecordSel Ident (Maybe [Ident])
                -- ^ Record selection.
                -- Optionally specifies the shape of the record.

              | ListSel Int    (Maybe Int)
                -- ^ List selection.
                -- Optionally specifies the length of the list.
                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    -> Int -> Doc
int Int
x Doc -> Doc -> Doc
<+> (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  -> Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
x  Doc -> Doc -> Doc
<+> ([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    -> Int -> Doc
int Int
x Doc -> Doc -> Doc
<+> (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
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([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 Doc
empty (\t
x -> String -> Doc
text String
"/* of" Doc -> Doc -> Doc
<+> t -> Doc
f t
x Doc -> Doc -> Doc
<+> String -> Doc
text String
"*/")


-- | Display the thing selected by the selector, nicely.
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"

-- | The name of a selector (e.g., used in update code)
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)

-- | Show a list of selectors as they appear in a nested selector in an update.
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) -- not in source