content: -- |
  -- Module      :  Cryptol.Parser.Name
  -- Copyright   :  (c) 2015-2016 Galois, Inc.
  -- License     :  BSD3
  -- Maintainer  :  cryptol@galois.com
  -- Stability   :  provisional
  -- Portability :  portable
  
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE Safe #-}
  
  module Cryptol.Parser.Name where
  
  import Cryptol.Utils.Fixity
  import Cryptol.Utils.Ident
  import Cryptol.Utils.PP
  import Cryptol.Utils.Panic (panic)
  
  import           Control.DeepSeq
  import           GHC.Generics (Generic)
  
  
  -- Names -----------------------------------------------------------------------
  
  -- | Names that originate in the parser.
  data PName = UnQual !Ident
               -- ^ Unqualified names like @x@, @Foo@, or @+@.
             | Qual !ModName !Ident
               -- ^ Qualified names like @Foo::bar@ or @module::!@.
             | NewName !Pass !Int
               -- ^ Fresh names generated by a pass.
               deriving (Eq,Ord,Show,Generic)
  
  -- | Passes that can generate fresh names.
  data Pass = NoPat
            | MonoValues
            | ExpandPropGuards String
              deriving (Eq,Ord,Show,Generic)
  
  instance NFData PName
  instance NFData Pass
  
  mkUnqual :: Ident -> PName
  mkUnqual  = UnQual
  
  mkQual :: ModName -> Ident -> PName
  mkQual  = Qual
  
  -- | Compute a `PName` for the definition site corresponding to the given
  -- `OrigName`.   Usually this is an unqualified name, but names that come
  -- from module parameters are qualified with the corresponding parameter name.
  origNameToDefPName :: OrigName -> PName
  origNameToDefPName og = toPName (ogName og)
    where
    toPName =
      case ogFromParam og of
        Nothing -> UnQual
        Just sig -> Qual (identToModName sig)
  
  getModName :: PName -> Maybe ModName
  getModName (Qual ns _) = Just ns
  getModName _           = Nothing
  
  getIdent :: PName -> Ident
  getIdent (UnQual n)    = n
  getIdent (Qual _ n)    = n
  getIdent (NewName p i) = packIdent ("__" ++ pass ++ show i)
    where
    pass = case p of
             NoPat              -> "p"
             MonoValues         -> "mv"
             ExpandPropGuards _ -> "epg"
  
  isGeneratedName :: PName -> Bool
  isGeneratedName x =
    case x of
      NewName {} -> True
      _          -> False
  
  instance PP PName where
    ppPrec _ = ppPrefixName
  
  instance PPName PName where
    ppNameFixity n
      | isInfixIdent i = Just (Fixity NonAssoc 0) -- FIXME?
      | otherwise      = Nothing
      where
      i   = getIdent n
  
    ppPrefixName n = optParens (isInfixIdent i) (pfx <.> pp i)
      where
      i   = getIdent n
      pfx = case getModName n of
              Just ns -> pp ns <.> text "::"
              Nothing -> mempty
  
    ppInfixName n
      | isInfixIdent i = pfx <.> pp i
      | otherwise      = panic "AST" [ "non-symbol infix name:" ++ show n ]
      where
      i   = getIdent n
      pfx = case getModName n of
              Just ns -> pp ns <.> text "::"
              Nothing -> mempty
  