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

import GOOL.Drasil.ClassInterface (VSType, MSStatement, SVariable, SValue, TypeSym(..), 
  TypeElim(..), ValueSym(..))
import GOOL.Drasil.RendererClasses (RenderSym, VSUnOp, VSBinOp, UnaryOpSym(..),
  BinaryOpSym(..), OpElim(uOpPrec, bOpPrec), RenderVariable(..), 
  RenderValue(..), ValueElim(valuePrec), RenderStatement(..))
import qualified GOOL.Drasil.RendererClasses as RC (uOp, bOp, value)
import GOOL.Drasil.LanguageRenderer (unOpDocD, unOpDocD', binOpDocD, binOpDocD')
import GOOL.Drasil.AST (Terminator(..), Binding(..), OpData, od)
import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.Helpers (toCode, toState, on2StateValues)
import GOOL.Drasil.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 :: (RenderSym r) => Doc -> MSStatement r
mkStmt :: Doc -> MSStatement r
mkStmt = (Doc -> Terminator -> MSStatement r)
-> Terminator -> Doc -> MSStatement r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData Terminator
Semi

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

-- Values --

-- | Constructs a value in a stateful context
mkStateVal :: (RenderSym r) => VSType r -> Doc -> SValue r
mkStateVal :: VSType r -> Doc -> SValue r
mkStateVal = Maybe Int -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData Maybe Int
forall a. Maybe a
Nothing

-- | Constructs a value in a non-stateful context
mkVal :: (RenderSym r) => r (Type r) -> Doc -> SValue r
mkVal :: r (Type r) -> Doc -> SValue r
mkVal t :: r (Type r)
t = Maybe Int -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData Maybe Int
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 :: (RenderSym r) => String -> VSType r -> Doc -> SVariable r
mkStateVar :: String -> VSType r -> Doc -> SVariable r
mkStateVar = Binding -> String -> VSType r -> Doc -> SVariable 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 :: (RenderSym r) => String -> r (Type r) -> Doc -> SVariable r
mkVar :: String -> r (Type r) -> Doc -> SVariable r
mkVar n :: String
n t :: r (Type r)
t = Binding -> String -> VSType r -> Doc -> SVariable 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 :: (RenderSym r) => String -> VSType r -> Doc -> SVariable r
mkStaticVar :: String -> VSType r -> Doc -> SVariable r
mkStaticVar = Binding -> String -> VSType r -> Doc -> SVariable 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 :: Int -> Doc -> VSOp r
mkOp p :: Int
p d :: Doc
d = r OpData -> VSOp r
forall a s. a -> State s a
toState (r OpData -> VSOp r) -> r OpData -> VSOp r
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 :: String -> VSOp r
unOpPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
compEqualPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
compPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
addPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
multPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
powerPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
andPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: String -> VSOp r
orPrec = Int -> Doc -> VSOp r
forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp 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 :: (RenderSym r) => VSUnOp r -> SValue r -> SValue r
unExpr :: VSUnOp r -> SValue r -> SValue r
unExpr = 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 :: * -> *).
RenderSym 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' :: (RenderSym r) => VSUnOp r -> SValue r -> SValue r
unExpr' :: VSUnOp r -> SValue r -> SValue r
unExpr' = 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 :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr Doc -> Doc -> Doc
unOpDocD')

mkUnExpr :: (RenderSym r) => (Doc -> Doc -> Doc) -> r (UnaryOp r) -> 
  r (Value r) -> SValue r
mkUnExpr :: (Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr d :: Doc -> Doc -> Doc
d u :: r (UnaryOp r)
u v :: r (Value r)
v = Int -> r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
RenderSym 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 :: (RenderSym r) => VSUnOp r -> SValue r -> SValue r
unExprNumDbl :: VSUnOp r -> SValue r -> SValue r
unExprNumDbl u' :: VSUnOp r
u' v' :: 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 :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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 :: (RenderSym r) => r (Type r) -> r (Value r) -> SValue r
unExprCastFloat :: r (Type r) -> r (Value r) -> SValue r
unExprCastFloat t :: r (Type r)
t = CodeType -> SValue r -> SValue 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) (SValue r -> SValue r)
-> (r (Value r) -> SValue r) -> r (Value r) -> SValue r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> SValue r
forall a s. a -> State s a
toState
  where castType :: CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType 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 _ = 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 :: (RenderSym r) => VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr :: VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr u' :: VSUnOp r
u' t' :: VSType r
t' s' :: 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 :: * -> *).
RenderSym 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 :: (RenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr :: VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr b' :: VSBinOp r
b' v1' :: SValue r
v1' v2' :: SValue r
v2'= do 
  r (BinaryOp r)
b <- VSBinOp r
b'
  r (Type r)
exprType <- SValue r -> SValue r -> VSType r
forall (r :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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' :: (RenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' :: VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' b' :: VSBinOp r
b' v1' :: SValue r
v1' v2' :: SValue r
v2' = do 
  r (Type r)
exprType <- SValue r -> SValue r -> VSType r
forall (r :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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 :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr 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' :: (RenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' :: VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' b' :: VSBinOp r
b' v1' :: SValue r
v1' v2' :: 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 :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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 :: (RenderSym r) => r (Type r) -> r (Type r) -> r (Value r) -> 
  SValue r
binExprCastFloat :: r (Type r) -> r (Type r) -> r (Value r) -> SValue r
binExprCastFloat t1 :: r (Type r)
t1 t2 :: r (Type r)
t2 = CodeType -> CodeType -> SValue r -> SValue 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) (SValue r -> SValue r)
-> (r (Value r) -> SValue r) -> r (Value r) -> SValue r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> SValue r
forall a s. a -> State s a
toState
  where castType :: CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType 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 _ 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 _ _ = 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 :: (RenderSym r) => VSBinOp r -> VSType r -> SValue r -> SValue r 
  -> SValue r
typeBinExpr :: VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr b' :: VSBinOp r
b' t' :: VSType r
t' v1' :: SValue r
v1' v2' :: 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 :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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 :: (RenderSym r) => SValue r-> SValue r -> VSType r
numType :: SValue r -> SValue r -> VSType r
numType v1' :: SValue r
v1' v2' :: 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 Integer Integer = r (Type r)
t1
      numericType Float _ = r (Type r)
t1
      numericType _ Float = r (Type r)
t2
      numericType Double _ = r (Type r)
t1
      numericType _ Double = r (Type r)
t2
      numericType _ _ = String -> r (Type r)
forall a. HasCallStack => String -> a
error "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' :: (r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' f :: r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
f b' :: VSBinOp r
b' v1' :: SValue r
v1' v2' :: 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 :: (RenderSym r) => Int -> r (Type r) -> Doc -> SValue r
mkExpr :: Int -> r (Type r) -> Doc -> SValue r
mkExpr p :: Int
p t :: r (Type r)
t= Maybe Int -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p) (r (Type r) -> VSType r
forall a s. a -> State s a
toState r (Type r)
t)

binOpDocDRend :: (RenderSym r) => r (BinaryOp r) -> r (Value r) -> 
  r (Value r) -> Doc
binOpDocDRend :: r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binOpDocDRend b :: r (BinaryOp r)
b v1 :: r (Value r)
v1 v2 :: 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 :: (RenderSym r) => r (BinaryOp r) -> r (Value r) -> Doc
exprParensL :: r (BinaryOp r) -> r (Value r) -> Doc
exprParensL o :: r (BinaryOp r)
o v :: 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 :: (RenderSym r) => r (BinaryOp r) -> r (Value r) -> Doc
exprParensR :: r (BinaryOp r) -> r (Value r) -> Doc
exprParensR o :: r (BinaryOp r)
o v :: 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 :: (RenderSym r) =>  r (BinaryOp r) -> r (Value r) -> r (Value r) 
  -> Doc
binExprRender :: r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender b :: r (BinaryOp r)
b v1 :: r (Value r)
v1 v2 :: r (Value r)
v2 = 
  let leftExpr :: Doc
leftExpr = r (BinaryOp r) -> r (Value r) -> Doc
forall (r :: * -> *).
RenderSym 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 :: * -> *).
RenderSym 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