BozConstant.hs

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 symTable assignSymbol (Boz boz) =
  resolveBozConstant' symTable assignSymbol boz
resolveBozConstant _ _ _ = error "Can only resolve ExpVal Boz"

resolveBozConstant' :: SymbolTable -> String -> AST.Boz -> ExpVal
resolveBozConstant' symTable assignSymbol boz =
  let entry = M.lookup assignSymbol symTable
  in
    case entry of
      Just (SVariable (TInteger kind) _) ->
        resolveBozConstantInContext boz kind
      Just (SVariable ty _) ->
        error
          $  assignSymbol
          <> " is a "
          <> show ty
          <> "\nBOZ constants can only be resolved in an INTEGER context"
      Just _ -> error
        (assignSymbol
        ++ " is not a scalar variable. \
                                          \Invalid fortran sytax"
        )
      Nothing -> error
        (assignSymbol
        ++ " could not be found. \
                                          \Invalid fortran syntax"
        )

resolveBozConstantInContext :: AST.Boz -> Kind -> ExpVal
resolveBozConstantInContext boz kind =
  let allowedBinaryLength = kind * 8
      maxBinaryValue      = 2 ^ (allowedBinaryLength - 1) - 1
      minBinaryValue      = (-1) * 2 ^ (allowedBinaryLength - 1)
      decimal             = AST.bozAsNatural boz
      overflow            = decimal - maxBinaryValue
  in  if overflow > 0 then Int (minBinaryValue + overflow - 1) else Int decimal

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

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

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

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