content: {- | Supporting code for handling Fortran BOZ literal constants.
  
  Using the definition from the latest Fortran standards (F2003, F2008), BOZ
  constants are bitstrings (untyped!) which have basically no implicit rules. How
  they're interpreted depends on context (they are generally limited to DATA
  statements and a small handful of intrinsic functions).
  
  Note that currently, we don't store BOZ constants as bitstrings. Storing them in
  their string representation is easy and in that form, they're easy to safely
  resolve to an integer. An alternate option would be to store them as the
  bitstring "B" of BOZ, and only implement functions on that. For simple uses
  (integer), I'm doubtful that would provide extra utility or performance, but it
  may be more sensible in the future. For now, you may retrieve a bitstring by
  converting to a numeric type and using something like 'showIntAtBase', or a
  'Bits' instance.
  
  This type carries _some_ syntactic information that doesn't change meaning. The
  expectation is that most users won't want to inspect 'Boz' values, usually just
  convert them, so we do it for convenience for checking syntax conformance. Note
  that not all info is retained -- which of single or double quotes were used is
  not recorded, for example.
  -}
  
  module Language.Fortran.AST.Literal.Boz where
  
  import           GHC.Generics
  import           Data.Data
  import           Control.DeepSeq                ( NFData )
  import           Text.PrettyPrint.GenericPretty ( Out )
  
  import qualified Data.List as List
  import qualified Data.Char as Char
  import qualified Numeric   as Num
  
  import           Data.Bits
  
  -- | A Fortran BOZ literal constant.
  --
  -- The prefix defines the characters allowed in the string:
  --
  --   * @B@: @[01]@
  --   * @O@: @[0-7]@
  --   * @Z@: @[0-9 a-f A-F]@
  data Boz = Boz
    { bozPrefix :: BozPrefix
    , bozString :: String
  
    , bozPrefixWasPostfix :: Conforming
    -- ^ Was the prefix actually postfix i.e. @'123'z@? This is non-standard
    --   syntax, disabled by default in gfortran. Syntactic info.
    } deriving stock    (Show, Generic, Data, Typeable, Ord)
      deriving anyclass (NFData, Out)
  
  -- | Tests prefix & strings match, ignoring conforming/nonconforming flags.
  instance Eq Boz where
      b1 == b2 =     bozPrefix b1 == bozPrefix b2
                  && bozString b1 == bozString b2
  
  data BozPrefix
    = BozPrefixB              -- ^ binary (bitstring)
    | BozPrefixO              -- ^ octal
    | BozPrefixZ Conforming   -- ^ hex, including nonstandard @x@
      deriving stock    (Show, Generic, Data, Typeable, Ord)
      deriving anyclass (NFData, Out)
  
  -- | Ignores conforming/nonconforming flags.
  instance Eq BozPrefix where
      p1 == p2 = case (p1, p2) of (BozPrefixB,   BozPrefixB)   -> True
                                  (BozPrefixO,   BozPrefixO)   -> True
                                  (BozPrefixZ{}, BozPrefixZ{}) -> True
                                  _                            -> False
  
  data Conforming = Conforming | Nonconforming
      deriving stock    (Eq, Ord, Show, Generic, Data, Typeable)
      deriving anyclass (NFData, Out)
  
  -- | UNSAFE. Parses a BOZ literal constant string.
  --
  -- Looks for prefix or postfix. Strips the quotes from the string (single quotes
  -- only).
  parseBoz :: String -> Boz
  parseBoz s =
      case List.uncons s of
        Nothing -> errInvalid
        Just (pc, ps) -> case parsePrefix pc of
                           Just p -> Boz p (shave ps) Conforming
                           Nothing -> case parsePrefix (List.last s) of
                                        Just p -> Boz p (shave (init s)) Nonconforming
                                        Nothing -> errInvalid
    where
      parsePrefix p
        | p' == 'b' = Just $ BozPrefixB
        | p' == 'o' = Just $ BozPrefixO
        | p' == 'z' = Just $ BozPrefixZ Conforming
        | p' == 'x' = Just $ BozPrefixZ Nonconforming
        | otherwise = Nothing
        where p' = Char.toLower p
      errInvalid = error ("Language.Fortran.AST.BOZ.parseBoz: invalid BOZ string: " <> show s)
      -- | Remove the first and last elements in a list.
      shave = tail . init
  
  -- | Pretty print a BOZ constant. Uses prefix style (ignores the postfix field),
  --   and @z@ over nonstandard @x@ for hexadecimal.
  prettyBoz :: Boz -> String
  prettyBoz b = prettyBozPrefix (bozPrefix b) : '\'' : bozString b <> "'"
    where prettyBozPrefix = \case BozPrefixB   -> 'b'
                                  BozPrefixO   -> 'o'
                                  BozPrefixZ{} -> 'z'
  
  -- | Resolve a BOZ constant as a natural (positive integer).
  --
  -- Is actually polymorphic over the output type, but you probably want to
  -- resolve to 'Integer' or 'Natural' usually.
  --
  -- We assume the 'Boz' is well-formed, thus don't bother with digit predicates.
  bozAsNatural :: (Num a, Eq a) => Boz -> a
  bozAsNatural (Boz pfx str _) = runReadS $ parser str
    where
      runReadS = fst . head
      parser = case pfx of BozPrefixB   -> Num.readInt 2 (const True) binDigitVal
                           -- (on GHC >=9.2, 'Num.readBin')
                           BozPrefixO   -> Num.readOct
                           BozPrefixZ{} -> Num.readHex
      binDigitVal = \case '0' -> 0
                          '1' -> 1
                          _   -> error "Language.Fortran.AST.BOZ.bozAsNatural: invalid BOZ string"
  
  -- | Resolve a BOZ constant as a two's complement integer.
  --
  -- Note that the value will depend on the size of the output type.
  bozAsTwosComp :: (Num a, Eq a, FiniteBits a) => Boz -> a
  bozAsTwosComp boz =
      if   msbIsSet
      then asNat - (2 ^ bitCount)
      else asNat
    where
      msbIsSet = testBit asNat (bitCount - 1)
      asNat    = bozAsNatural boz
      bitCount = finiteBitSize asNat
  