1-- |
2-- Module      :  Cryptol.Parser.Selector
3-- Copyright   :  (c) 2013-2016 Galois, Inc.
4-- License     :  BSD3
5-- Maintainer  :  cryptol@galois.com
6-- Stability   :  provisional
7-- Portability :  portable
8
9{-# LANGUAGE Safe #-}
10
11{-# LANGUAGE DeriveAnyClass #-}
12{-# LANGUAGE DeriveGeneric #-}
13{-# LANGUAGE OverloadedStrings #-}
14module Cryptol.Parser.Selector
15  ( Selector(..)
16  , ppSelector
17  , ppNestedSels
18  , selName
19  ) where
20
21import GHC.Generics (Generic)
22import Control.DeepSeq
23import Data.List(intersperse)
24
25import Cryptol.Utils.Ident
26import Cryptol.Utils.PP
27
28
29{- | Selectors are used for projecting from various components.
30Each selector has an option spec to specify the shape of the thing
31that is being selected.  Currently, there is no surface syntax for
32list selectors, but they are used during the desugaring of patterns.
33-}
34
35data Selector = TupleSel Int   (Maybe Int)
36                -- ^ Zero-based tuple selection.
37                -- Optionally specifies the shape of the tuple (one-based).
38
39              | RecordSel Ident (Maybe [Ident])
40                -- ^ Record selection.
41                -- Optionally specifies the shape of the record.
42
43              | ListSel Int    (Maybe Int)
44                -- ^ List selection.
45                -- Optionally specifies the length of the list.
46                deriving (Eq, Show, Ord, Generic, NFData)
47
48instance PP Selector where
49  ppPrec _ sel =
50    case sel of
51      TupleSel x sig    -> int x <+> ppSig tupleSig sig
52      RecordSel x sig  -> pp x  <+> ppSig recordSig sig
53      ListSel x sig    -> int x <+> ppSig listSig sig
54
55    where
56    tupleSig n   = int n
57    recordSig xs = braces $ fsep $ punctuate comma $ map pp xs
58    listSig n    = int n
59
60    ppSig f = maybe empty (\x -> text "/* of" <+> f x <+> text "*/")
61
62
63-- | Display the thing selected by the selector, nicely.
64ppSelector :: Selector -> Doc
65ppSelector sel =
66  case sel of
67    TupleSel x _  -> ordinal (x+1) <+> text "field"
68    RecordSel x _ -> text "field" <+> pp x
69    ListSel x _   -> ordinal x <+> text "element"
70
71-- | The name of a selector (e.g., used in update code)
72selName :: Selector -> Ident
73selName s =
74  case s of
75    RecordSel i _ -> i
76    TupleSel n _  -> packIdent ("_" ++ show n)
77    ListSel n _   -> packIdent ("__" ++ show n)
78
79-- | Show a list of selectors as they appear in a nested selector in an update.
80ppNestedSels :: [Selector] -> Doc
81ppNestedSels = hcat . intersperse "." . map ppS
82  where ppS s = case s of
83                  RecordSel i _ -> text (unpackIdent i)
84                  TupleSel n _ -> int n
85                  ListSel n _  -> brackets (int n) -- not in source
86