-- | Generic constructors and smart constructors to be used in renderers
module Drasil.GOOL.LanguageRenderer.Constructors (
  mkStmt, mkStmtNoEnd, mkStateVal, mkVal, mkStateVar, mkVar, mkStaticVar, 
  VSOp, mkOp, unOpPrec, compEqualPrec, compPrec, addPrec, multPrec, powerPrec, 
  andPrec, orPrec, inPrec, unExpr, unExpr', unExprNumDbl, typeUnExpr, binExpr, 
  binExpr', binExprNumDbl', typeBinExpr
) where

import Drasil.GOOL.InterfaceCommon (VSType, MSStatement, SVariable, SValue,
  TypeSym(..), TypeElim(..), ValueSym(..))
import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, VSUnOp, VSBinOp,
  UnaryOpSym(..), BinaryOpSym(..), OpElim(uOpPrec, bOpPrec), RenderVariable(..),
  RenderValue(..), ValueElim(valuePrec), RenderStatement(..))
import qualified Drasil.GOOL.RendererClassesCommon as RC (uOp, bOp, value)
import Drasil.GOOL.LanguageRenderer (unOpDocD, unOpDocD', binOpDocD, binOpDocD')
import Drasil.GOOL.AST (Terminator(..), Binding(..), OpData, od)
import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.Helpers (toCode, toState, on2StateValues)
import Drasil.GOOL.State (VS)

import Text.PrettyPrint.HughesPJ (Doc, parens, text)
import Data.Composition ((.:))
import Control.Monad (join)

-- Statements

-- | Constructs a statement terminated by a semi-colon
mkStmt :: (CommonRenderSym r) => Doc -> MSStatement r
mkStmt :: forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt = (Doc -> Terminator -> MS (r (Statement r)))
-> Terminator -> Doc -> MS (r (Statement r))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Terminator -> MS (r (Statement r))
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData Terminator
Semi

-- | Constructs a statement without a termination character
mkStmtNoEnd :: (CommonRenderSym r) => Doc -> MSStatement r
mkStmtNoEnd :: forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd = (Doc -> Terminator -> MS (r (Statement r)))
-> Terminator -> Doc -> MS (r (Statement r))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Terminator -> MS (r (Statement r))
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData Terminator
Empty

-- Values --

-- | Constructs a value in a stateful context
mkStateVal :: (CommonRenderSym r) => VSType r -> Doc -> SValue r
mkStateVal :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal = Maybe Int
-> Maybe Integer
-> StateT ValueState Identity (r (Type r))
-> Doc
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VSType r -> Doc -> SValue r
valFromData Maybe Int
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

-- | Constructs a value in a non-stateful context
mkVal :: (CommonRenderSym r) => r (Type r) -> Doc -> SValue r
mkVal :: forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal r (Type r)
t = Maybe Int
-> Maybe Integer
-> VSType r
-> Doc
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VSType r -> Doc -> SValue r
valFromData Maybe Int
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing (r (Type r) -> VSType r
forall a s. a -> State s a
toState r (Type r)
t)

-- Variables --

-- | Constructs a dynamic variable in a stateful context
mkStateVar :: (CommonRenderSym r) => String -> VSType r -> Doc -> SVariable r
mkStateVar :: forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar = Binding
-> String
-> StateT ValueState Identity (r (Type r))
-> Doc
-> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
RenderVariable r =>
Binding -> String -> VSType r -> Doc -> SVariable r
varFromData Binding
Dynamic

-- | Constructs a dynamic variable in a non-stateful context
mkVar :: (CommonRenderSym r) => String -> r (Type r) -> Doc -> SVariable r
mkVar :: forall (r :: * -> *).
CommonRenderSym r =>
String -> r (Type r) -> Doc -> SVariable r
mkVar String
n r (Type r)
t = Binding
-> String
-> VSType r
-> Doc
-> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
RenderVariable r =>
Binding -> String -> VSType r -> Doc -> SVariable r
varFromData Binding
Dynamic String
n (r (Type r) -> VSType r
forall a s. a -> State s a
toState r (Type r)
t)

-- | Constructs a static variable in a stateful context
mkStaticVar :: (CommonRenderSym r) => String -> VSType r -> Doc -> SVariable r
mkStaticVar :: forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStaticVar = Binding
-> String
-> StateT ValueState Identity (r (Type r))
-> Doc
-> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
RenderVariable r =>
Binding -> String -> VSType r -> Doc -> SVariable r
varFromData Binding
Static

-- Operators --

type VSOp r = VS (r OpData)

-- | Construct an operator with given precedence and rendering
mkOp :: (Monad r) => Int -> Doc -> VSOp r
mkOp :: forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
p Doc
d = r OpData -> State ValueState (r OpData)
forall a s. a -> State s a
toState (r OpData -> State ValueState (r OpData))
-> r OpData -> State ValueState (r OpData)
forall a b. (a -> b) -> a -> b
$ OpData -> r OpData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (OpData -> r OpData) -> OpData -> r OpData
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> OpData
od Int
p Doc
d

-- | Construct an operator with typical unary-operator precedence
unOpPrec :: (Monad r) => String -> VSOp r
unOpPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
9 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with equality-comparison-level precedence
compEqualPrec :: (Monad r) => String -> VSOp r
compEqualPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
compEqualPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
4 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with comparison-level precedence
compPrec :: (Monad r) => String -> VSOp r
compPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
compPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
5 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with addition-level precedence
addPrec :: (Monad r) => String -> VSOp r
addPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
addPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
6 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with multiplication-level precedence
multPrec :: (Monad r) => String -> VSOp r
multPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
multPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
7 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with exponentiation-level precedence
powerPrec :: (Monad r) => String -> VSOp r
powerPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
powerPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
8 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with conjunction-level precedence
andPrec :: (Monad r) => String -> VSOp r 
andPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
andPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
3 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Construct an operator with disjunction-level precedence
orPrec :: (Monad r) => String -> VSOp r
orPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
orPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
2 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

inPrec :: (Monad r) => String -> VSOp r
inPrec :: forall (r :: * -> *). Monad r => String -> VSOp r
inPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
2 (Doc -> VSOp r) -> (String -> Doc) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- Expressions --

-- | Constructs a unary expression like ln(v), for some operator ln and value v
unExpr :: (CommonRenderSym r) => VSUnOp r -> SValue r -> SValue r
unExpr :: forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr = StateT
  ValueState Identity (StateT ValueState Identity (r (Value r)))
-> StateT ValueState Identity (r (Value r))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT
   ValueState Identity (StateT ValueState Identity (r (Value r)))
 -> StateT ValueState Identity (r (Value r)))
-> (StateT ValueState Identity (r (UnaryOp r))
    -> StateT ValueState Identity (r (Value r))
    -> StateT
         ValueState Identity (StateT ValueState Identity (r (Value r))))
-> StateT ValueState Identity (r (UnaryOp r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (r (UnaryOp r)
 -> r (Value r) -> StateT ValueState Identity (r (Value r)))
-> StateT ValueState Identity (r (UnaryOp r))
-> StateT ValueState Identity (r (Value r))
-> StateT
     ValueState Identity (StateT ValueState Identity (r (Value r)))
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((Doc -> Doc -> Doc)
-> r (UnaryOp r)
-> r (Value r)
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr Doc -> Doc -> Doc
unOpDocD)

-- | Constructs a unary expression like -v, for some operator - and value v
unExpr' :: (CommonRenderSym r) => VSUnOp r -> SValue r -> SValue r
unExpr' :: forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr' VSUnOp r
u' SValue r
v'= do
  r (UnaryOp r)
u <- VSUnOp r
u'
  r (Value r)
v <- SValue r
v'
  (StateT ValueState Identity (SValue r) -> SValue r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT ValueState Identity (SValue r) -> SValue r)
-> (VSUnOp r -> SValue r -> StateT ValueState Identity (SValue r))
-> VSUnOp r
-> SValue r
-> SValue r
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (r (UnaryOp r) -> r (Value r) -> SValue r)
-> VSUnOp r -> SValue r -> StateT ValueState Identity (SValue r)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr (if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< r (UnaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) (r (Value r) -> Maybe Int
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
v) then Doc -> Doc -> Doc
unOpDocD else Doc -> Doc -> Doc
unOpDocD'))) VSUnOp r
u' SValue r
v'

mkUnExpr :: (CommonRenderSym r) => (Doc -> Doc -> Doc) -> r (UnaryOp r) -> 
  r (Value r) -> SValue r
mkUnExpr :: forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr Doc -> Doc -> Doc
d r (UnaryOp r)
u r (Value r)
v = Int
-> r (Type r) -> Doc -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (r (UnaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) (Doc -> Doc -> Doc
d (r (UnaryOp r) -> Doc
forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Doc
RC.uOp r (UnaryOp r)
u) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v))

-- | To be used in languages where the unary operator returns a double. If the 
-- value passed to the operator is a float, this function preserves that type 
-- by casting the result to a float.
unExprNumDbl :: (CommonRenderSym r) => VSUnOp r -> SValue r -> SValue r
unExprNumDbl :: forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExprNumDbl VSUnOp r
u' SValue r
v' = do
  r (UnaryOp r)
u <- VSUnOp r
u'
  r (Value r)
v <- SValue r
v'
  r (Value r)
w <- (Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr Doc -> Doc -> Doc
unOpDocD r (UnaryOp r)
u r (Value r)
v
  r (Type r) -> r (Value r) -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> r (Value r) -> SValue r
unExprCastFloat (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) r (Value r)
w

-- Only used by unExprNumDbl
unExprCastFloat :: (CommonRenderSym r) => r (Type r) -> r (Value r) -> SValue r
unExprCastFloat :: forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> r (Value r) -> SValue r
unExprCastFloat r (Type r)
t = CodeType -> VS (r (Value r)) -> VS (r (Value r))
forall {r :: * -> *}.
(RenderValue r, TypeSym r) =>
CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t) (VS (r (Value r)) -> VS (r (Value r)))
-> (r (Value r) -> VS (r (Value r)))
-> r (Value r)
-> VS (r (Value r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> VS (r (Value r))
forall a s. a -> State s a
toState
  where castType :: CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType CodeType
Float = VSType r -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ = VS (r (Value r)) -> VS (r (Value r))
forall a. a -> a
id
  
-- | To be used when the type of the value is different from the type of the
-- resulting expression. The type of the result is passed as a parameter.
typeUnExpr :: (CommonRenderSym r) => VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr :: forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr VSUnOp r
u' VSType r
t' SValue r
s' = do 
  r (UnaryOp r)
u <- VSUnOp r
u'
  r (Type r)
t <- VSType r
t'
  r (Value r)
s <- SValue r
s'
  Int -> r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (r (UnaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) r (Type r)
t (Doc -> Doc -> Doc
unOpDocD (r (UnaryOp r) -> Doc
forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Doc
RC.uOp r (UnaryOp r)
u) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
s))

-- | Constructs binary expressions like v + w, for some operator + and values v 
-- and w, parenthesizing v and w if needed.
binExpr :: (CommonRenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr :: forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp r
b' SValue r
v1' SValue r
v2'= do 
  r (BinaryOp r)
b <- VSBinOp r
b'
  r (Type r)
exprType <- SValue r -> SValue r -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> VSType r
numType SValue r
v1' SValue r
v2'
  Doc
exprRender <- (r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender VSBinOp r
b' SValue r
v1' SValue r
v2'
  Int -> r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (r (BinaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
b) r (Type r)
exprType Doc
exprRender

-- | Constructs binary expressions like pow(v,w), for some operator pow and
-- values v and w
binExpr' :: (CommonRenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' :: forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
b' SValue r
v1' SValue r
v2' = do 
  r (Type r)
exprType <- SValue r -> SValue r -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> VSType r
numType SValue r
v1' SValue r
v2'
  Doc
exprRender <- (r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binOpDocDRend VSBinOp r
b' SValue r
v1' SValue r
v2'
  Int -> r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr Int
9 r (Type r)
exprType Doc
exprRender 

-- | To be used in languages where the binary operator returns a double. If 
-- either value passed to the operator is a float, this function preserves that 
-- type by casting the result to a float.
binExprNumDbl' :: (CommonRenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' :: forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' VSBinOp r
b' SValue r
v1' SValue r
v2' = do 
  r (Value r)
v1 <- SValue r
v1'
  r (Value r)
v2 <- SValue r
v2'
  let t1 :: r (Type r)
t1 = r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1
      t2 :: r (Type r)
t2 = r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v2
  r (Value r)
e <- VSBinOp r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
b' SValue r
v1' SValue r
v2'
  r (Type r) -> r (Type r) -> r (Value r) -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> r (Type r) -> r (Value r) -> SValue r
binExprCastFloat r (Type r)
t1 r (Type r)
t2 r (Value r)
e

-- Only used by binExprNumDbl'
binExprCastFloat :: (CommonRenderSym r) => r (Type r) -> r (Type r) -> r (Value r) -> 
  SValue r
binExprCastFloat :: forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> r (Type r) -> r (Value r) -> SValue r
binExprCastFloat r (Type r)
t1 r (Type r)
t2 = CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
forall {r :: * -> *}.
(RenderValue r, TypeSym r) =>
CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t1) (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t2) (VS (r (Value r)) -> VS (r (Value r)))
-> (r (Value r) -> VS (r (Value r)))
-> r (Value r)
-> VS (r (Value r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> VS (r (Value r))
forall a s. a -> State s a
toState
  where castType :: CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType CodeType
Float CodeType
_ = VSType r -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ CodeType
Float = VSType r -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ CodeType
_ = VS (r (Value r)) -> VS (r (Value r))
forall a. a -> a
id

-- | To be used when the types of the values are different from the type of the
-- resulting expression. The type of the result is passed as a parameter.
typeBinExpr :: (CommonRenderSym r) => VSBinOp r -> VSType r -> SValue r -> SValue r 
  -> SValue r
typeBinExpr :: forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp r
b' VSType r
t' SValue r
v1' SValue r
v2' = do
  r (BinaryOp r)
b <- VSBinOp r
b'
  r (Type r)
t <- VSType r
t'
  Doc
bnexr <- (r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender VSBinOp r
b' SValue r
v1' SValue r
v2'
  Int -> r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (r (BinaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
b) r (Type r)
t Doc
bnexr

-- For numeric binary expressions, checks that both types are numeric and 
-- returns result type. Selects the type with lowest precision.
numType :: (CommonRenderSym r) => SValue r-> SValue r -> VSType r
numType :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> VSType r
numType SValue r
v1' SValue r
v2' = do
  r (Value r)
v1 <- SValue r
v1'
  r (Value r)
v2 <- SValue r
v2'
  let t1 :: r (Type r)
t1 = r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1
      t2 :: r (Type r)
t2 = r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v2
      numericType :: CodeType -> CodeType -> r (Type r)
numericType CodeType
Integer CodeType
Integer = r (Type r)
t1
      numericType CodeType
Float CodeType
_ = r (Type r)
t1
      numericType CodeType
_ CodeType
Float = r (Type r)
t2
      numericType CodeType
Double CodeType
_ = r (Type r)
t1
      numericType CodeType
_ CodeType
Double = r (Type r)
t2
      numericType CodeType
_ CodeType
_ = String -> r (Type r)
forall a. HasCallStack => String -> a
error String
"Numeric types required for numeric expression"
  r (Type r) -> VSType r
forall a s. a -> State s a
toState (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ CodeType -> CodeType -> r (Type r)
numericType (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t1) (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t2)

exprRender' :: (r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc) -> 
  VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' :: forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
f VSBinOp r
b' SValue r
v1' SValue r
v2' = do 
  r (BinaryOp r)
b <- VSBinOp r
b' 
  r (Value r)
v1 <- SValue r
v1'
  r (Value r)
v2 <- SValue r
v2'
  Doc -> VS Doc
forall a s. a -> State s a
toState (Doc -> VS Doc) -> Doc -> VS Doc
forall a b. (a -> b) -> a -> b
$ r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
f r (BinaryOp r)
b r (Value r)
v1 r (Value r)
v2

mkExpr :: (CommonRenderSym r) => Int -> r (Type r) -> Doc -> SValue r
mkExpr :: forall (r :: * -> *).
CommonRenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr Int
p r (Type r)
t = Maybe Int
-> Maybe Integer
-> VSType r
-> Doc
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VSType r -> Doc -> SValue r
valFromData (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p) Maybe Integer
forall a. Maybe a
Nothing (r (Type r) -> VSType r
forall a s. a -> State s a
toState r (Type r)
t)

binOpDocDRend :: (CommonRenderSym r) => r (BinaryOp r) -> r (Value r) -> 
  r (Value r) -> Doc
binOpDocDRend :: forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binOpDocDRend r (BinaryOp r)
b r (Value r)
v1 r (Value r)
v2 = Doc -> Doc -> Doc -> Doc
binOpDocD' (r (BinaryOp r) -> Doc
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Doc
RC.bOp r (BinaryOp r)
b) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v1) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v2)

-- Adds parentheses around an expression passed as the left argument to a 
-- left-associative binary operator if the precedence of the expression is less 
-- than the precedence of the operator
exprParensL :: (CommonRenderSym r) => r (BinaryOp r) -> r (Value r) -> Doc
exprParensL :: forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensL r (BinaryOp r)
o r (Value r)
v = (if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< r (BinaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
o) (r (Value r) -> Maybe Int
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
v) then Doc -> Doc
parens else 
  Doc -> Doc
forall a. a -> a
id) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v

-- Adds parentheses around an expression passed as the right argument to a 
-- left-associative binary operator if the precedence of the expression is less 
-- than or equal to the precedence of the operator
exprParensR :: (CommonRenderSym r) => r (BinaryOp r) -> r (Value r) -> Doc
exprParensR :: forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensR r (BinaryOp r)
o r (Value r)
v = (if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= r (BinaryOp r) -> Int
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
o) (r (Value r) -> Maybe Int
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
v) then Doc -> Doc
parens else 
  Doc -> Doc
forall a. a -> a
id) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v

-- Renders binary expression, adding parentheses if needed
binExprRender :: (CommonRenderSym r) =>  r (BinaryOp r) -> r (Value r) -> r (Value r) 
  -> Doc
binExprRender :: forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender r (BinaryOp r)
b r (Value r)
v1 r (Value r)
v2 = 
  let leftExpr :: Doc
leftExpr = r (BinaryOp r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensL r (BinaryOp r)
b r (Value r)
v1
      rightExpr :: Doc
rightExpr = r (BinaryOp r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensR r (BinaryOp r)
b r (Value r)
v2
  in Doc -> Doc -> Doc -> Doc
binOpDocD (r (BinaryOp r) -> Doc
forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Doc
RC.bOp r (BinaryOp r)
b) Doc
leftExpr Doc
rightExpr