{- | 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).
-}

{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}

module Language.Fortran.AST.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

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

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

-- | UNSAFE. Parses a BOZ literal constant string.
--
-- Looks for prefix or suffix. Strips the quotes from the string (single quotes
-- only).
parseBoz :: String -> Boz
parseBoz :: String -> Boz
parseBoz String
s =
    case String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
List.uncons String
s of
      Maybe (Char, String)
Nothing -> Boz
forall {a}. a
errInvalid
      Just (Char
pc, String
ps) -> case Char -> Maybe BozPrefix
parsePrefix Char
pc of
                         Just BozPrefix
p -> BozPrefix -> String -> Boz
Boz BozPrefix
p (ShowS
forall {a}. [a] -> [a]
shave String
ps)
                         Maybe BozPrefix
Nothing -> case Char -> Maybe BozPrefix
parsePrefix (String -> Char
forall a. [a] -> a
List.last String
s) of
                                      Just BozPrefix
p -> BozPrefix -> String -> Boz
Boz BozPrefix
p (ShowS
forall {a}. [a] -> [a]
shave (ShowS
forall {a}. [a] -> [a]
init String
s))
                                      Maybe BozPrefix
Nothing -> Boz
forall {a}. a
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
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
BozPrefixO
      | Char
p' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'z', Char
'x'] = BozPrefix -> Maybe BozPrefix
forall a. a -> Maybe a
Just BozPrefix
BozPrefixZ
      | Bool
otherwise            = Maybe BozPrefix
forall a. Maybe a
Nothing
      where p' :: Char
p' = Char -> Char
Char.toLower Char
p
    errInvalid :: a
errInvalid = String -> a
forall a. HasCallStack => String -> a
error String
"Language.Fortran.AST.BOZ.parseBoz: invalid BOZ string"
    -- | Remove the first and last elements in a list.
    shave :: [a] -> [a]
shave = [a] -> [a]
forall {a}. [a] -> [a]
tail ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall {a}. [a] -> [a]
init

-- | Pretty print a BOZ constant. Uses prefix style, and @z@ over nonstandard
--   @x@ for hexadecimal.
prettyBoz :: Boz -> String
prettyBoz :: Boz -> String
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 -> String
bozString Boz
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
  where prettyBozPrefix :: BozPrefix -> Char
prettyBozPrefix = \case
          BozPrefix
BozPrefixB -> Char
'b'
          BozPrefix
BozPrefixO -> Char
'o'
          BozPrefix
BozPrefixZ -> Char
'z'