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