module Language.Fortran.Vars.BozConstant
  ( resolveBozConstant
  , bozToInt
  , bozToInt2
  , bozToInt4
  , bozToInt8
  )
where

import           Data.Char                      ( digitToInt
                                                , intToDigit
                                                , toLower
                                                )
import qualified Data.Map                       as M
import           Numeric                        ( readInt
                                                , showIntAtBase
                                                )
import           Text.Read                      ( ReadS )

import qualified Language.Fortran.AST.Boz       as AST
import           Language.Fortran.Vars.Types    ( SymbolTableEntry(..)
                                                , Type(..)
                                                , SemType(..)
                                                , Kind
                                                , ExpVal(..)
                                                , SymbolTable
                                                )

-- | Given 'SymbolTable', contextual symbol name and BOZ Constant
-- ('ExpVal' constructed with Boz String), resolve BOZ Constant considering
-- contextual symbol.
--
-- Currently, it only resolves BOZ Constants in context of INTEGER.
resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal
resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal
resolveBozConstant SymbolTable
symTable String
assignSymbol (Boz Boz
boz) =
  SymbolTable -> String -> Boz -> ExpVal
resolveBozConstant' SymbolTable
symTable String
assignSymbol Boz
boz
resolveBozConstant SymbolTable
_ String
_ ExpVal
_ = String -> ExpVal
forall a. HasCallStack => String -> a
error String
"Can only resolve ExpVal Boz"

resolveBozConstant' :: SymbolTable -> String -> AST.Boz -> ExpVal
resolveBozConstant' :: SymbolTable -> String -> Boz -> ExpVal
resolveBozConstant' SymbolTable
symTable String
assignSymbol Boz
boz =
  let entry :: Maybe SymbolTableEntry
entry = String -> SymbolTable -> Maybe SymbolTableEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
assignSymbol SymbolTable
symTable
  in
    case Maybe SymbolTableEntry
entry of
      Just (SVariable (TInteger Int
kind) Location
_) ->
        Boz -> Int -> ExpVal
resolveBozConstantInContext Boz
boz Int
kind
      Just (SVariable Type
ty Location
_) ->
        String -> ExpVal
forall a. HasCallStack => String -> a
error
          (String -> ExpVal) -> String -> ExpVal
forall a b. (a -> b) -> a -> b
$  String
assignSymbol
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is a "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Show a => a -> String
show Type
ty
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nBOZ constants can only be resolved in an INTEGER context"
      Just SymbolTableEntry
_ -> String -> ExpVal
forall a. HasCallStack => String -> a
error
        (String
assignSymbol
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a scalar variable. \
                                          \Invalid fortran sytax"
        )
      Maybe SymbolTableEntry
Nothing -> String -> ExpVal
forall a. HasCallStack => String -> a
error
        (String
assignSymbol
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" could not be found. \
                                          \Invalid fortran syntax"
        )

resolveBozConstantInContext :: AST.Boz -> Kind -> ExpVal
resolveBozConstantInContext :: Boz -> Int -> ExpVal
resolveBozConstantInContext Boz
boz Int
kind =
  let allowedBinaryLength :: Int
allowedBinaryLength = Int
kind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
      maxBinaryValue :: Int
maxBinaryValue      = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
allowedBinaryLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      minBinaryValue :: Int
minBinaryValue      = (-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
allowedBinaryLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      decimal :: Int
decimal             = Boz -> Int
forall a. (Num a, Eq a) => Boz -> a
AST.bozAsNatural Boz
boz
      overflow :: Int
overflow            = Int
decimal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxBinaryValue
  in  if Int
overflow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> ExpVal
Int (Int
minBinaryValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
overflow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else Int -> ExpVal
Int Int
decimal

-- Convert BOZ string to integer of specific kind
bozToInt :: Int -> ExpVal -> ExpVal
bozToInt :: Int -> ExpVal -> ExpVal
bozToInt Int
kind (Boz Boz
boz) = Boz -> Int -> ExpVal
resolveBozConstantInContext Boz
boz Int
kind

-- Convert BOZ string to integer*2
bozToInt2 :: ExpVal -> ExpVal
bozToInt2 :: ExpVal -> ExpVal
bozToInt2 = Int -> ExpVal -> ExpVal
bozToInt Int
2

-- Convert BOZ string to integer*4
bozToInt4 :: ExpVal -> ExpVal
bozToInt4 :: ExpVal -> ExpVal
bozToInt4 = Int -> ExpVal -> ExpVal
bozToInt Int
4

-- Convert BOZ string to integer*8
bozToInt8 :: ExpVal -> ExpVal
bozToInt8 :: ExpVal -> ExpVal
bozToInt8 = Int -> ExpVal -> ExpVal
bozToInt Int
8