-- |
-- 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
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> [Char]
(Int -> Selector -> ShowS)
-> (Selector -> [Char]) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Selector -> ShowS
showsPrec :: Int -> Selector -> ShowS
$cshow :: Selector -> [Char]
show :: Selector -> [Char]
$cshowList :: [Selector] -> ShowS
showList :: [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
$ccompare :: Selector -> Selector -> Ordering
compare :: Selector -> Selector -> Ordering
$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
>= :: Selector -> Selector -> Bool
$cmax :: Selector -> Selector -> Selector
max :: Selector -> Selector -> Selector
$cmin :: Selector -> Selector -> Selector
min :: Selector -> Selector -> 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
$cfrom :: forall x. Selector -> Rep Selector x
from :: forall x. Selector -> Rep Selector x
$cto :: forall x. Rep Selector x -> Selector
to :: forall x. Rep Selector x -> Selector
Generic, Selector -> ()
(Selector -> ()) -> NFData Selector
forall a. (a -> ()) -> NFData a
$crnf :: Selector -> ()
rnf :: 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 -> [[Char] -> Doc
text [Char]
"/* of" Doc -> Doc -> Doc
<+> t -> Doc
f t
x Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"*/"])


-- | 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
<+> [Char] -> Doc
text [Char]
"field"
    RecordSel Ident
x Maybe [Ident]
_ -> [Char] -> Doc
text [Char]
"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
<+> [Char] -> Doc
text [Char]
"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
_  -> [Char] -> Ident
packIdent ([Char]
"_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
    ListSel Int
n Maybe Int
_   -> [Char] -> Ident
packIdent ([Char]
"__" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
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]
_ -> [Char] -> Doc
text (Ident -> [Char]
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