module Language.Fortran.Vars.BozConstant
( resolveBozConstant
, bozToInt
, bozToInt1
, bozToInt2
, bozToInt4
, bozToInt8
)
where
import qualified Data.Map as M
import qualified Language.Fortran.AST.Literal.Boz as AST
import Language.Fortran.Vars.Types ( SymbolTableEntry(..)
, SemType(..)
, Kind
, ExpVal(..)
, SymbolTable
)
import Data.Int
resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal
resolveBozConstant :: SymbolTable -> String -> ExpVal -> ExpVal
resolveBozConstant SymbolTable
symTable String
assignSymbol (Boz Boz
b) = Boz -> ExpVal
go Boz
b
where
go :: Boz -> ExpVal
go Boz
boz = case Maybe SymbolTableEntry
entry of
Just (SVariable (TInteger Int
kind) Location
_) ->
Int -> Boz -> ExpVal
bozToInt Int
kind Boz
boz
Just (SVariable Type
ty Location
_) ->
forall a. HasCallStack => String -> a
error
forall a b. (a -> b) -> a -> b
$ String
assignSymbol
forall a. Semigroup a => a -> a -> a
<> String
" is a "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Type
ty
forall a. Semigroup a => a -> a -> a
<> String
"\nBOZ constants can only be resolved in an INTEGER context"
Just SymbolTableEntry
_ -> forall a. HasCallStack => String -> a
error
(String
assignSymbol
forall a. [a] -> [a] -> [a]
++ String
" is not a scalar variable. \
\Invalid fortran sytax"
)
Maybe SymbolTableEntry
Nothing -> forall a. HasCallStack => String -> a
error
(String
assignSymbol
forall a. [a] -> [a] -> [a]
++ String
" could not be found. \
\Invalid fortran syntax"
)
entry :: Maybe SymbolTableEntry
entry = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
assignSymbol SymbolTable
symTable
resolveBozConstant SymbolTable
_ String
_ ExpVal
_ = forall a. HasCallStack => String -> a
error String
"Can only resolve ExpVal Boz"
bozToInt :: Kind -> AST.Boz -> ExpVal
bozToInt :: Int -> Boz -> ExpVal
bozToInt Int
kind Boz
boz = case Int
kind of
Int
1 -> Boz -> ExpVal
bozToInt1 Boz
boz
Int
2 -> Boz -> ExpVal
bozToInt2 Boz
boz
Int
4 -> Boz -> ExpVal
bozToInt4 Boz
boz
Int
8 -> Boz -> ExpVal
bozToInt8 Boz
boz
Int
k -> Boz -> Int -> ExpVal
bozAsTwosCompExplicit Boz
boz Int
k
bozToInt1 :: AST.Boz -> ExpVal
bozToInt1 :: Boz -> ExpVal
bozToInt1 = Int -> ExpVal
Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
AST.bozAsTwosComp @Int8
bozToInt2 :: AST.Boz -> ExpVal
bozToInt2 :: Boz -> ExpVal
bozToInt2 = Int -> ExpVal
Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
AST.bozAsTwosComp @Int16
bozToInt4 :: AST.Boz -> ExpVal
bozToInt4 :: Boz -> ExpVal
bozToInt4 = Int -> ExpVal
Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
AST.bozAsTwosComp @Int32
bozToInt8 :: AST.Boz -> ExpVal
bozToInt8 :: Boz -> ExpVal
bozToInt8 = Int -> ExpVal
Int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
AST.bozAsTwosComp @Int64
bozAsTwosCompExplicit :: AST.Boz -> Kind -> ExpVal
bozAsTwosCompExplicit :: Boz -> Int -> ExpVal
bozAsTwosCompExplicit Boz
boz Int
kind =
let allowedBinaryLength :: Int
allowedBinaryLength = Int
kind forall a. Num a => a -> a -> a
* Int
8
maxBinaryValue :: Int
maxBinaryValue = Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
allowedBinaryLength forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
- Int
1
minBinaryValue :: Int
minBinaryValue = (-Int
1) forall a. Num a => a -> a -> a
* Int
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
allowedBinaryLength forall a. Num a => a -> a -> a
- Int
1)
decimal :: Int
decimal = forall a. (Num a, Eq a) => Boz -> a
AST.bozAsNatural Boz
boz
overflow :: Int
overflow = Int
decimal forall a. Num a => a -> a -> a
- Int
maxBinaryValue
in if Int
overflow forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> ExpVal
Int (Int
minBinaryValue forall a. Num a => a -> a -> a
+ Int
overflow forall a. Num a => a -> a -> a
- Int
1) else Int -> ExpVal
Int Int
decimal