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
)
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
bozToInt :: Int -> ExpVal -> ExpVal
bozToInt :: Int -> ExpVal -> ExpVal
bozToInt Int
kind (Boz Boz
boz) = Boz -> Int -> ExpVal
resolveBozConstantInContext Boz
boz Int
kind
bozToInt2 :: ExpVal -> ExpVal
bozToInt2 :: ExpVal -> ExpVal
bozToInt2 = Int -> ExpVal -> ExpVal
bozToInt Int
2
bozToInt4 :: ExpVal -> ExpVal
bozToInt4 :: ExpVal -> ExpVal
bozToInt4 = Int -> ExpVal -> ExpVal
bozToInt Int
4
bozToInt8 :: ExpVal -> ExpVal
bozToInt8 :: ExpVal -> ExpVal
bozToInt8 = Int -> ExpVal -> ExpVal
bozToInt Int
8