-- |
-- 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
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> [Char]
$cshow :: Selector -> [Char]
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show, Eq 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
Ord, 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 -> ()
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 forall a. a -> [a] -> [a]
: forall {t}. (t -> Doc) -> Maybe t -> [Doc]
ppSig Int -> Doc
tupleSig Maybe Int
sig)
      RecordSel Ident
x Maybe [Ident]
sig  -> [Doc] -> Doc
sep (forall a. PP a => a -> Doc
pp Ident
x  forall a. a -> [a] -> [a]
: forall {t}. (t -> Doc) -> Maybe t -> [Doc]
ppSig forall {a}. PP a => [a] -> Doc
recordSig Maybe [Ident]
sig)
      ListSel Int
x Maybe Int
sig    -> [Doc] -> Doc
sep (Int -> Doc
int Int
x forall a. a -> [a] -> [a]
: 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 = 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
_  -> forall a. (Integral a, Show a, Eq a) => a -> Doc
ordinal (Int
xforall 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
<+> forall a. PP a => a -> Doc
pp Ident
x
    ListSel Int
x Maybe Int
_   -> 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]
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n)
    ListSel Int
n Maybe Int
_   -> [Char] -> Ident
packIdent ([Char]
"__" forall a. [a] -> [a] -> [a]
++ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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