{- | 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
  { Boz -> BozPrefix
bozPrefix :: BozPrefix
  , Boz -> [Char]
bozString :: String

  , Boz -> Conforming
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    (Int -> Boz -> ShowS
[Boz] -> ShowS
Boz -> [Char]
(Int -> Boz -> ShowS)
-> (Boz -> [Char]) -> ([Boz] -> ShowS) -> Show Boz
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Boz -> ShowS
showsPrec :: Int -> Boz -> ShowS
$cshow :: Boz -> [Char]
show :: Boz -> [Char]
$cshowList :: [Boz] -> ShowS
showList :: [Boz] -> ShowS
Show, (forall x. Boz -> Rep Boz x)
-> (forall x. Rep Boz x -> Boz) -> Generic Boz
forall x. Rep Boz x -> Boz
forall x. Boz -> Rep Boz x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Boz -> Rep Boz x
from :: forall x. Boz -> Rep Boz x
$cto :: forall x. Rep Boz x -> Boz
to :: forall x. Rep Boz x -> Boz
Generic, Typeable Boz
Typeable Boz =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Boz -> c Boz)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Boz)
-> (Boz -> Constr)
-> (Boz -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Boz))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boz))
-> ((forall b. Data b => b -> b) -> Boz -> Boz)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r)
-> (forall u. (forall d. Data d => d -> u) -> Boz -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Boz -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Boz -> m Boz)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Boz -> m Boz)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Boz -> m Boz)
-> Data Boz
Boz -> Constr
Boz -> DataType
(forall b. Data b => b -> b) -> Boz -> Boz
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Boz -> u
forall u. (forall d. Data d => d -> u) -> Boz -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boz
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boz -> c Boz
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boz)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boz)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boz -> c Boz
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Boz -> c Boz
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boz
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Boz
$ctoConstr :: Boz -> Constr
toConstr :: Boz -> Constr
$cdataTypeOf :: Boz -> DataType
dataTypeOf :: Boz -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boz)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Boz)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boz)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Boz)
$cgmapT :: (forall b. Data b => b -> b) -> Boz -> Boz
gmapT :: (forall b. Data b => b -> b) -> Boz -> Boz
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Boz -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Boz -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Boz -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Boz -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Boz -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Boz -> m Boz
Data, Typeable, Eq Boz
Eq Boz =>
(Boz -> Boz -> Ordering)
-> (Boz -> Boz -> Bool)
-> (Boz -> Boz -> Bool)
-> (Boz -> Boz -> Bool)
-> (Boz -> Boz -> Bool)
-> (Boz -> Boz -> Boz)
-> (Boz -> Boz -> Boz)
-> Ord Boz
Boz -> Boz -> Bool
Boz -> Boz -> Ordering
Boz -> Boz -> Boz
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
$ccompare :: Boz -> Boz -> Ordering
compare :: Boz -> Boz -> Ordering
$c< :: Boz -> Boz -> Bool
< :: Boz -> Boz -> Bool
$c<= :: Boz -> Boz -> Bool
<= :: Boz -> Boz -> Bool
$c> :: Boz -> Boz -> Bool
> :: Boz -> Boz -> Bool
$c>= :: Boz -> Boz -> Bool
>= :: Boz -> Boz -> Bool
$cmax :: Boz -> Boz -> Boz
max :: Boz -> Boz -> Boz
$cmin :: Boz -> Boz -> Boz
min :: Boz -> Boz -> Boz
Ord)
    deriving anyclass (Boz -> ()
(Boz -> ()) -> NFData Boz
forall a. (a -> ()) -> NFData a
$crnf :: Boz -> ()
rnf :: Boz -> ()
NFData, Int -> Boz -> Doc
[Boz] -> Doc
Boz -> Doc
(Int -> Boz -> Doc) -> (Boz -> Doc) -> ([Boz] -> Doc) -> Out Boz
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Boz -> Doc
docPrec :: Int -> Boz -> Doc
$cdoc :: Boz -> Doc
doc :: Boz -> Doc
$cdocList :: [Boz] -> Doc
docList :: [Boz] -> Doc
Out)

-- | Tests prefix & strings match, ignoring conforming/nonconforming flags.
instance Eq Boz where
    Boz
b1 == :: Boz -> Boz -> Bool
== Boz
b2 =     Boz -> BozPrefix
bozPrefix Boz
b1 BozPrefix -> BozPrefix -> Bool
forall a. Eq a => a -> a -> Bool
== Boz -> BozPrefix
bozPrefix Boz
b2
                Bool -> Bool -> Bool
&& Boz -> [Char]
bozString Boz
b1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Boz -> [Char]
bozString Boz
b2

data BozPrefix
  = BozPrefixB              -- ^ binary (bitstring)
  | BozPrefixO              -- ^ octal
  | BozPrefixZ Conforming   -- ^ hex, including nonstandard @x@
    deriving stock    (Int -> BozPrefix -> ShowS
[BozPrefix] -> ShowS
BozPrefix -> [Char]
(Int -> BozPrefix -> ShowS)
-> (BozPrefix -> [Char])
-> ([BozPrefix] -> ShowS)
-> Show BozPrefix
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BozPrefix -> ShowS
showsPrec :: Int -> BozPrefix -> ShowS
$cshow :: BozPrefix -> [Char]
show :: BozPrefix -> [Char]
$cshowList :: [BozPrefix] -> ShowS
showList :: [BozPrefix] -> ShowS
Show, (forall x. BozPrefix -> Rep BozPrefix x)
-> (forall x. Rep BozPrefix x -> BozPrefix) -> Generic BozPrefix
forall x. Rep BozPrefix x -> BozPrefix
forall x. BozPrefix -> Rep BozPrefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BozPrefix -> Rep BozPrefix x
from :: forall x. BozPrefix -> Rep BozPrefix x
$cto :: forall x. Rep BozPrefix x -> BozPrefix
to :: forall x. Rep BozPrefix x -> BozPrefix
Generic, Typeable BozPrefix
Typeable BozPrefix =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BozPrefix -> c BozPrefix)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BozPrefix)
-> (BozPrefix -> Constr)
-> (BozPrefix -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BozPrefix))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BozPrefix))
-> ((forall b. Data b => b -> b) -> BozPrefix -> BozPrefix)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BozPrefix -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BozPrefix -> r)
-> (forall u. (forall d. Data d => d -> u) -> BozPrefix -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BozPrefix -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix)
-> Data BozPrefix
BozPrefix -> Constr
BozPrefix -> DataType
(forall b. Data b => b -> b) -> BozPrefix -> BozPrefix
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BozPrefix -> u
forall u. (forall d. Data d => d -> u) -> BozPrefix -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BozPrefix
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BozPrefix -> c BozPrefix
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BozPrefix)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BozPrefix)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BozPrefix -> c BozPrefix
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BozPrefix -> c BozPrefix
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BozPrefix
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BozPrefix
$ctoConstr :: BozPrefix -> Constr
toConstr :: BozPrefix -> Constr
$cdataTypeOf :: BozPrefix -> DataType
dataTypeOf :: BozPrefix -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BozPrefix)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BozPrefix)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BozPrefix)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BozPrefix)
$cgmapT :: (forall b. Data b => b -> b) -> BozPrefix -> BozPrefix
gmapT :: (forall b. Data b => b -> b) -> BozPrefix -> BozPrefix
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BozPrefix -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BozPrefix -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BozPrefix -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BozPrefix -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BozPrefix -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BozPrefix -> m BozPrefix
Data, Typeable, Eq BozPrefix
Eq BozPrefix =>
(BozPrefix -> BozPrefix -> Ordering)
-> (BozPrefix -> BozPrefix -> Bool)
-> (BozPrefix -> BozPrefix -> Bool)
-> (BozPrefix -> BozPrefix -> Bool)
-> (BozPrefix -> BozPrefix -> Bool)
-> (BozPrefix -> BozPrefix -> BozPrefix)
-> (BozPrefix -> BozPrefix -> BozPrefix)
-> Ord BozPrefix
BozPrefix -> BozPrefix -> Bool
BozPrefix -> BozPrefix -> Ordering
BozPrefix -> BozPrefix -> BozPrefix
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
$ccompare :: BozPrefix -> BozPrefix -> Ordering
compare :: BozPrefix -> BozPrefix -> Ordering
$c< :: BozPrefix -> BozPrefix -> Bool
< :: BozPrefix -> BozPrefix -> Bool
$c<= :: BozPrefix -> BozPrefix -> Bool
<= :: BozPrefix -> BozPrefix -> Bool
$c> :: BozPrefix -> BozPrefix -> Bool
> :: BozPrefix -> BozPrefix -> Bool
$c>= :: BozPrefix -> BozPrefix -> Bool
>= :: BozPrefix -> BozPrefix -> Bool
$cmax :: BozPrefix -> BozPrefix -> BozPrefix
max :: BozPrefix -> BozPrefix -> BozPrefix
$cmin :: BozPrefix -> BozPrefix -> BozPrefix
min :: BozPrefix -> BozPrefix -> BozPrefix
Ord)
    deriving anyclass (BozPrefix -> ()
(BozPrefix -> ()) -> NFData BozPrefix
forall a. (a -> ()) -> NFData a
$crnf :: BozPrefix -> ()
rnf :: BozPrefix -> ()
NFData, Int -> BozPrefix -> Doc
[BozPrefix] -> Doc
BozPrefix -> Doc
(Int -> BozPrefix -> Doc)
-> (BozPrefix -> Doc) -> ([BozPrefix] -> Doc) -> Out BozPrefix
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> BozPrefix -> Doc
docPrec :: Int -> BozPrefix -> Doc
$cdoc :: BozPrefix -> Doc
doc :: BozPrefix -> Doc
$cdocList :: [BozPrefix] -> Doc
docList :: [BozPrefix] -> Doc
Out)

-- | Ignores conforming/nonconforming flags.
instance Eq BozPrefix where
    BozPrefix
p1 == :: BozPrefix -> BozPrefix -> Bool
== BozPrefix
p2 = case (BozPrefix
p1, BozPrefix
p2) of (BozPrefix
BozPrefixB,   BozPrefix
BozPrefixB)   -> Bool
True
                                (BozPrefix
BozPrefixO,   BozPrefix
BozPrefixO)   -> Bool
True
                                (BozPrefixZ{}, BozPrefixZ{}) -> Bool
True
                                (BozPrefix, BozPrefix)
_                            -> Bool
False

data Conforming = Conforming | Nonconforming
    deriving stock    (Conforming -> Conforming -> Bool
(Conforming -> Conforming -> Bool)
-> (Conforming -> Conforming -> Bool) -> Eq Conforming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Conforming -> Conforming -> Bool
== :: Conforming -> Conforming -> Bool
$c/= :: Conforming -> Conforming -> Bool
/= :: Conforming -> Conforming -> Bool
Eq, Eq Conforming
Eq Conforming =>
(Conforming -> Conforming -> Ordering)
-> (Conforming -> Conforming -> Bool)
-> (Conforming -> Conforming -> Bool)
-> (Conforming -> Conforming -> Bool)
-> (Conforming -> Conforming -> Bool)
-> (Conforming -> Conforming -> Conforming)
-> (Conforming -> Conforming -> Conforming)
-> Ord Conforming
Conforming -> Conforming -> Bool
Conforming -> Conforming -> Ordering
Conforming -> Conforming -> Conforming
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
$ccompare :: Conforming -> Conforming -> Ordering
compare :: Conforming -> Conforming -> Ordering
$c< :: Conforming -> Conforming -> Bool
< :: Conforming -> Conforming -> Bool
$c<= :: Conforming -> Conforming -> Bool
<= :: Conforming -> Conforming -> Bool
$c> :: Conforming -> Conforming -> Bool
> :: Conforming -> Conforming -> Bool
$c>= :: Conforming -> Conforming -> Bool
>= :: Conforming -> Conforming -> Bool
$cmax :: Conforming -> Conforming -> Conforming
max :: Conforming -> Conforming -> Conforming
$cmin :: Conforming -> Conforming -> Conforming
min :: Conforming -> Conforming -> Conforming
Ord, Int -> Conforming -> ShowS
[Conforming] -> ShowS
Conforming -> [Char]
(Int -> Conforming -> ShowS)
-> (Conforming -> [Char])
-> ([Conforming] -> ShowS)
-> Show Conforming
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Conforming -> ShowS
showsPrec :: Int -> Conforming -> ShowS
$cshow :: Conforming -> [Char]
show :: Conforming -> [Char]
$cshowList :: [Conforming] -> ShowS
showList :: [Conforming] -> ShowS
Show, (forall x. Conforming -> Rep Conforming x)
-> (forall x. Rep Conforming x -> Conforming) -> Generic Conforming
forall x. Rep Conforming x -> Conforming
forall x. Conforming -> Rep Conforming x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Conforming -> Rep Conforming x
from :: forall x. Conforming -> Rep Conforming x
$cto :: forall x. Rep Conforming x -> Conforming
to :: forall x. Rep Conforming x -> Conforming
Generic, Typeable Conforming
Typeable Conforming =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Conforming -> c Conforming)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Conforming)
-> (Conforming -> Constr)
-> (Conforming -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Conforming))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Conforming))
-> ((forall b. Data b => b -> b) -> Conforming -> Conforming)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Conforming -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Conforming -> r)
-> (forall u. (forall d. Data d => d -> u) -> Conforming -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Conforming -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Conforming -> m Conforming)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Conforming -> m Conforming)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Conforming -> m Conforming)
-> Data Conforming
Conforming -> Constr
Conforming -> DataType
(forall b. Data b => b -> b) -> Conforming -> Conforming
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Conforming -> u
forall u. (forall d. Data d => d -> u) -> Conforming -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Conforming
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Conforming -> c Conforming
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Conforming)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Conforming)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Conforming -> c Conforming
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Conforming -> c Conforming
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Conforming
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Conforming
$ctoConstr :: Conforming -> Constr
toConstr :: Conforming -> Constr
$cdataTypeOf :: Conforming -> DataType
dataTypeOf :: Conforming -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Conforming)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Conforming)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Conforming)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Conforming)
$cgmapT :: (forall b. Data b => b -> b) -> Conforming -> Conforming
gmapT :: (forall b. Data b => b -> b) -> Conforming -> Conforming
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Conforming -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Conforming -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Conforming -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Conforming -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Conforming -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Conforming -> m Conforming
Data, Typeable)
    deriving anyclass (Conforming -> ()
(Conforming -> ()) -> NFData Conforming
forall a. (a -> ()) -> NFData a
$crnf :: Conforming -> ()
rnf :: Conforming -> ()
NFData, Int -> Conforming -> Doc
[Conforming] -> Doc
Conforming -> Doc
(Int -> Conforming -> Doc)
-> (Conforming -> Doc) -> ([Conforming] -> Doc) -> Out Conforming
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Conforming -> Doc
docPrec :: Int -> Conforming -> Doc
$cdoc :: Conforming -> Doc
doc :: Conforming -> Doc
$cdocList :: [Conforming] -> Doc
docList :: [Conforming] -> Doc
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 :: [Char] -> Boz
parseBoz [Char]
s =
    case [Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
List.uncons [Char]
s of
      Maybe (Char, [Char])
Nothing -> Boz
errInvalid
      Just (Char
pc, [Char]
ps) -> case Char -> Maybe BozPrefix
parsePrefix Char
pc of
                         Just BozPrefix
p -> BozPrefix -> [Char] -> Conforming -> Boz
Boz BozPrefix
p (ShowS
forall {a}. [a] -> [a]
shave [Char]
ps) Conforming
Conforming
                         Maybe BozPrefix
Nothing -> case Char -> Maybe BozPrefix
parsePrefix ([Char] -> Char
forall a. HasCallStack => [a] -> a
List.last [Char]
s) of
                                      Just BozPrefix
p -> BozPrefix -> [Char] -> Conforming -> Boz
Boz BozPrefix
p (ShowS
forall {a}. [a] -> [a]
shave (ShowS
forall a. HasCallStack => [a] -> [a]
init [Char]
s)) Conforming
Nonconforming
                                      Maybe BozPrefix
Nothing -> Boz
errInvalid
  where
    parsePrefix :: Char -> Maybe BozPrefix
parsePrefix Char
p
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b' = BozPrefix -> Maybe BozPrefix
forall a. a -> Maybe a
Just (BozPrefix -> Maybe BozPrefix) -> BozPrefix -> Maybe BozPrefix
forall a b. (a -> b) -> a -> b
$ BozPrefix
BozPrefixB
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'o' = BozPrefix -> Maybe BozPrefix
forall a. a -> Maybe a
Just (BozPrefix -> Maybe BozPrefix) -> BozPrefix -> Maybe BozPrefix
forall a b. (a -> b) -> a -> b
$ BozPrefix
BozPrefixO
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'z' = BozPrefix -> Maybe BozPrefix
forall a. a -> Maybe a
Just (BozPrefix -> Maybe BozPrefix) -> BozPrefix -> Maybe BozPrefix
forall a b. (a -> b) -> a -> b
$ Conforming -> BozPrefix
BozPrefixZ Conforming
Conforming
      | Char
p' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' = BozPrefix -> Maybe BozPrefix
forall a. a -> Maybe a
Just (BozPrefix -> Maybe BozPrefix) -> BozPrefix -> Maybe BozPrefix
forall a b. (a -> b) -> a -> b
$ Conforming -> BozPrefix
BozPrefixZ Conforming
Nonconforming
      | Bool
otherwise = Maybe BozPrefix
forall a. Maybe a
Nothing
      where p' :: Char
p' = Char -> Char
Char.toLower Char
p
    errInvalid :: Boz
errInvalid = [Char] -> Boz
forall a. HasCallStack => [Char] -> a
error ([Char]
"Language.Fortran.AST.BOZ.parseBoz: invalid BOZ string: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> [Char]
show [Char]
s)
    -- | Remove the first and last elements in a list.
    shave :: [a] -> [a]
shave = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. HasCallStack => [a] -> [a]
init

-- | Pretty print a BOZ constant. Uses prefix style (ignores the postfix field),
--   and @z@ over nonstandard @x@ for hexadecimal.
prettyBoz :: Boz -> String
prettyBoz :: Boz -> [Char]
prettyBoz Boz
b = BozPrefix -> Char
prettyBozPrefix (Boz -> BozPrefix
bozPrefix Boz
b) Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: Boz -> [Char]
bozString Boz
b [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"'"
  where prettyBozPrefix :: BozPrefix -> Char
prettyBozPrefix = \case BozPrefix
BozPrefixB   -> Char
'b'
                                BozPrefix
BozPrefixO   -> Char
'o'
                                BozPrefixZ{} -> Char
'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 :: forall a. (Num a, Eq a) => Boz -> a
bozAsNatural (Boz BozPrefix
pfx [Char]
str Conforming
_) = [(a, [Char])] -> a
forall {c} {b}. [(c, b)] -> c
runReadS ([(a, [Char])] -> a) -> [(a, [Char])] -> a
forall a b. (a -> b) -> a -> b
$ ReadS a
parser [Char]
str
  where
    runReadS :: [(c, b)] -> c
runReadS = (c, b) -> c
forall a b. (a, b) -> a
fst ((c, b) -> c) -> ([(c, b)] -> (c, b)) -> [(c, b)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(c, b)] -> (c, b)
forall a. HasCallStack => [a] -> a
head
    parser :: ReadS a
parser = case BozPrefix
pfx of BozPrefix
BozPrefixB   -> a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Num.readInt a
2 (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) Char -> Int
binDigitVal
                         -- (on GHC >=9.2, 'Num.readBin')
                         BozPrefix
BozPrefixO   -> ReadS a
forall a. (Eq a, Num a) => ReadS a
Num.readOct
                         BozPrefixZ{} -> ReadS a
forall a. (Eq a, Num a) => ReadS a
Num.readHex
    binDigitVal :: Char -> Int
binDigitVal = \case Char
'0' -> Int
0
                        Char
'1' -> Int
1
                        Char
_   -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
bozAsTwosComp Boz
boz =
    if   Bool
msbIsSet
    then a
asNat a -> a -> a
forall a. Num a => a -> a -> a
- (a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
bitCount)
    else a
asNat
  where
    msbIsSet :: Bool
msbIsSet = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
asNat (Int
bitCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    asNat :: a
asNat    = Boz -> a
forall a. (Num a, Eq a) => Boz -> a
bozAsNatural Boz
boz
    bitCount :: Int
bitCount = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
asNat