-- | 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 :: forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal = forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData forall a. Maybe a
Nothing

-- | Constructs a value in a non-stateful context
mkVal :: (RenderSym r) => r (Type r) -> Doc -> SValue r
mkVal :: forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal r (Type r)
t = forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData forall a. Maybe a
Nothing (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 :: forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar = 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 :: forall (r :: * -> *).
RenderSym r =>
String -> r (Type r) -> Doc -> SVariable r
mkVar String
n r (Type r)
t = forall (r :: * -> *).
RenderVariable r =>
Binding -> String -> VSType r -> Doc -> SVariable r
varFromData Binding
Dynamic String
n (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 :: forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStaticVar = 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 = forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
9 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
4 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
5 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
6 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
7 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
8 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
3 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 = forall (r :: * -> *). Monad r => Int -> Doc -> VSOp r
mkOp Int
2 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 :: forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (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' :: forall (r :: * -> *).
RenderSym 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'
  (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> r (UnaryOp r) -> r (Value r) -> SValue r
mkUnExpr (if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
< forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) (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 :: (RenderSym r) => (Doc -> Doc -> Doc) -> r (UnaryOp r) -> 
  r (Value r) -> SValue r
mkUnExpr :: forall (r :: * -> *).
RenderSym 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 = forall (r :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) (forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) (Doc -> Doc -> Doc
d (forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Doc
RC.uOp r (UnaryOp r)
u) (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 :: forall (r :: * -> *).
RenderSym 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 <- 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
  forall (r :: * -> *).
RenderSym r =>
r (Type r) -> r (Value r) -> SValue r
unExprCastFloat (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 :: forall (r :: * -> *).
RenderSym r =>
r (Type r) -> r (Value r) -> SValue r
unExprCastFloat r (Type r)
t = forall {r :: * -> *}.
(RenderValue r, TypeSym r) =>
CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. a -> State s a
toState
  where castType :: CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType CodeType
Float = forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ = 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 :: forall (r :: * -> *).
RenderSym 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'
  forall (r :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Int
uOpPrec r (UnaryOp r)
u) r (Type r)
t (Doc -> Doc -> Doc
unOpDocD (forall (r :: * -> *). OpElim r => r (UnaryOp r) -> Doc
RC.uOp r (UnaryOp r)
u) (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 :: forall (r :: * -> *).
RenderSym 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 <- forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> VSType r
numType SValue r
v1' SValue r
v2'
  Doc
exprRender <- forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender VSBinOp r
b' SValue r
v1' SValue r
v2'
  forall (r :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (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' :: forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
b' SValue r
v1' SValue r
v2' = do 
  r (Type r)
exprType <- forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> VSType r
numType SValue r
v1' SValue r
v2'
  Doc
exprRender <- forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binOpDocDRend VSBinOp r
b' SValue r
v1' SValue r
v2'
  forall (r :: * -> *).
RenderSym 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' :: (RenderSym r) => VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' :: forall (r :: * -> *).
RenderSym 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 = forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1
      t2 :: r (Type r)
t2 = forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v2
  r (Value r)
e <- forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
b' SValue r
v1' SValue r
v2'
  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 :: forall (r :: * -> *).
RenderSym r =>
r (Type r) -> r (Type r) -> r (Value r) -> SValue r
binExprCastFloat r (Type r)
t1 r (Type r)
t2 = forall {r :: * -> *}.
(RenderValue r, TypeSym r) =>
CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t1) (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. a -> State s a
toState
  where castType :: CodeType -> CodeType -> VS (r (Value r)) -> VS (r (Value r))
castType CodeType
Float CodeType
_ = forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ CodeType
Float = forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast forall (r :: * -> *). TypeSym r => VSType r
float
        castType CodeType
_ CodeType
_ = 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 :: forall (r :: * -> *).
RenderSym 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 <- forall (r :: * -> *).
(r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc)
-> VSBinOp r -> SValue r -> SValue r -> VS Doc
exprRender' forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> r (Value r) -> Doc
binExprRender VSBinOp r
b' SValue r
v1' SValue r
v2'
  forall (r :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr (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 :: forall (r :: * -> *).
RenderSym 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 = forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1
      t2 :: r (Type r)
t2 = 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
_ = forall a. HasCallStack => String -> a
error String
"Numeric types required for numeric expression"
  forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ CodeType -> CodeType -> r (Type r)
numericType (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t1) (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'
  forall a s. a -> State s a
toState 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 :: forall (r :: * -> *).
RenderSym r =>
Int -> r (Type r) -> Doc -> SValue r
mkExpr Int
p r (Type r)
t= forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData (forall a. a -> Maybe a
Just Int
p) (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 :: forall (r :: * -> *).
RenderSym 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' (forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Doc
RC.bOp r (BinaryOp r)
b) (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v1) (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 :: forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensL r (BinaryOp r)
o r (Value r)
v = (if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
< forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
o) (forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
v) then Doc -> Doc
parens else 
  forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ 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 :: forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensR r (BinaryOp r)
o r (Value r)
v = (if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
<= forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Int
bOpPrec r (BinaryOp r)
o) (forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
v) then Doc -> Doc
parens else 
  forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ 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 :: forall (r :: * -> *).
RenderSym 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 = forall (r :: * -> *).
RenderSym r =>
r (BinaryOp r) -> r (Value r) -> Doc
exprParensL r (BinaryOp r)
b r (Value r)
v1
      rightExpr :: Doc
rightExpr = 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 (forall (r :: * -> *). OpElim r => r (BinaryOp r) -> Doc
RC.bOp r (BinaryOp r)
b) Doc
leftExpr Doc
rightExpr