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

import Drasil.Shared.InterfaceCommon (TypeSym(..), ValueSym(..), getCodeType,
  TypeElim)
import Drasil.Shared.RendererClassesCommon (VSUnOp, VSBinOp,
  OpElim(uOpPrec, bOpPrec), RenderVariable(..), RenderValue(..),
  ValueElim(valuePrec), RenderStatement(..))
import qualified Drasil.Shared.RendererClassesCommon as RC (uOp, bOp, value)
import Drasil.Shared.LanguageRenderer (unOpDocD, unOpDocD', binOpDocD, binOpDocD')
import Drasil.Shared.AST (Terminator(..), AttachmentTag(..), OpData, od,
  TypeData, td)
import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.Helpers (toCode, toState, on2StateValues)
import Drasil.Shared.State (MS, 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 :: (RenderStatement r stmt) => Doc -> MS (r stmt)
mkStmt :: forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmt = (Doc -> Terminator -> MS (r stmt))
-> Terminator -> Doc -> MS (r stmt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Terminator -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> Terminator -> MS (r stmt)
stmtFromData Terminator
Semi

-- | Constructs a statement without a termination character
mkStmtNoEnd :: (RenderStatement r stmt) => Doc -> MS (r stmt)
mkStmtNoEnd :: forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd = (Doc -> Terminator -> MS (r stmt))
-> Terminator -> Doc -> MS (r stmt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> Terminator -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> Terminator -> MS (r stmt)
stmtFromData Terminator
Empty

-- Values --

-- | Constructs a value in a stateful context
mkStateVal :: (RenderValue r var val typ) => VS (r typ) -> Doc -> VS (r val)
mkStateVal :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> Doc -> VS (r val)
mkStateVal = Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
valFromData Maybe Int
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

-- | Constructs a value in a non-stateful context
mkVal :: (RenderValue r var val typ) => r typ -> Doc -> VS (r val)
mkVal :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
r typ -> Doc -> VS (r val)
mkVal r typ
t = Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
valFromData Maybe Int
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing (r typ -> VS (r typ)
forall a s. a -> State s a
toState r typ
t)

-- Variables --

-- | Constructs an instance-level variable in a stateful context
mkStateVar
  :: (RenderVariable r var typ)
  => String -> VS (r typ) -> Doc -> VS (r var)
mkStateVar :: forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
String -> VS (r typ) -> Doc -> VS (r var)
mkStateVar = AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
varFromData AttachmentTag
InstanceLevel

-- | Constructs an instance-level variable in a non-stateful context
mkVar :: (RenderVariable r var typ) => String -> r typ -> Doc -> VS (r var)
mkVar :: forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
String -> r typ -> Doc -> VS (r var)
mkVar String
n r typ
t = AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
varFromData AttachmentTag
InstanceLevel String
n (r typ -> VS (r typ)
forall a s. a -> State s a
toState r typ
t)

-- | Constructs a classLevel variable in a stateful context
mkClassVar
  :: (RenderVariable r var typ)
  => String -> VS (r typ) -> Doc -> VS (r var)
mkClassVar :: forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
String -> VS (r typ) -> Doc -> VS (r var)
mkClassVar = AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
RenderVariable r var typ =>
AttachmentTag -> String -> VS (r typ) -> Doc -> VS (r var)
varFromData AttachmentTag
ClassLevel

-- Types --
typeFromData :: (Monad r) => CodeType -> String -> Doc -> VS (r TypeData)
typeFromData :: forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
t String
s Doc
d = r TypeData -> StateT ValueState Identity (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r TypeData -> StateT ValueState Identity (r TypeData))
-> r TypeData -> StateT ValueState Identity (r TypeData)
forall a b. (a -> b) -> a -> b
$ TypeData -> r TypeData
forall a. a -> r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeData -> r TypeData) -> TypeData -> r TypeData
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> TypeData
td CodeType
t String
s Doc
d

-- 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
  :: (OpElim r, RenderValue r var val typ, ValueElim r val, ValueSym r val typ)
  => VSUnOp r -> VS (r val) -> VS (r val)
unExpr :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val,
 ValueSym r val typ) =>
VSUnOp r -> VS (r val) -> VS (r val)
unExpr = StateT ValueState Identity (StateT ValueState Identity (r val))
-> StateT ValueState Identity (r val)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT ValueState Identity (StateT ValueState Identity (r val))
 -> StateT ValueState Identity (r val))
-> (VSUnOp r
    -> StateT ValueState Identity (r val)
    -> StateT ValueState Identity (StateT ValueState Identity (r val)))
-> VSUnOp r
-> StateT ValueState Identity (r val)
-> StateT ValueState Identity (r val)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (r OpData -> r val -> StateT ValueState Identity (r val))
-> VSUnOp r
-> StateT ValueState Identity (r val)
-> StateT ValueState Identity (StateT ValueState Identity (r val))
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((Doc -> Doc -> Doc)
-> r OpData -> r val -> StateT ValueState Identity (r val)
forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val,
 ValueSym r val typ) =>
(Doc -> Doc -> Doc) -> r OpData -> r val -> VS (r val)
mkUnExpr Doc -> Doc -> Doc
unOpDocD)

-- | Constructs a unary expression like -v, for some operator - and value v
unExpr'
  :: (OpElim r, RenderValue r var val typ, ValueElim r val, ValueSym r val typ)
  => VSUnOp r -> VS (r val) -> VS (r val)
unExpr' :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val,
 ValueSym r val typ) =>
VSUnOp r -> VS (r val) -> VS (r val)
unExpr' VSUnOp r
u' VS (r val)
v'= do
  u <- VSUnOp r
u'
  v <- v'
  (join .: on2StateValues (mkUnExpr
    (if any (< uOpPrec u) (valuePrec v)
       then unOpDocD
        else unOpDocD')))
    u' v'

mkUnExpr
  :: (OpElim r, RenderValue r var val typ, ValueElim r val, ValueSym r val typ)
  => (Doc -> Doc -> Doc) -> r OpData -> r val -> VS (r val)
mkUnExpr :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val,
 ValueSym r val typ) =>
(Doc -> Doc -> Doc) -> r OpData -> r val -> VS (r val)
mkUnExpr Doc -> Doc -> Doc
d r OpData
u r val
v = Int -> r typ -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
Int -> r typ -> Doc -> VS (r val)
mkExpr (r OpData -> Int
forall (r :: * -> *). OpElim r => r OpData -> Int
uOpPrec r OpData
u) (r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
valueType r val
v) (Doc -> Doc -> Doc
d (r OpData -> Doc
forall (r :: * -> *). OpElim r => r OpData -> Doc
RC.uOp r OpData
u) (r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
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
  ::
    ( OpElim r
    , RenderValue r var val typ
    , TypeSym r typ
    , TypeElim r typ
    , ValueElim r val
    , ValueSym r val typ
    )
  => VSUnOp r -> VS (r val) -> VS (r val)
unExprNumDbl :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, TypeSym r typ,
 TypeElim r typ, ValueElim r val, ValueSym r val typ) =>
VSUnOp r -> VS (r val) -> VS (r val)
unExprNumDbl VSUnOp r
u' VS (r val)
v' = do
  u <- VSUnOp r
u'
  v <- v'
  w <- mkUnExpr unOpDocD u v
  unExprCastFloat (valueType v) w

-- Only used by unExprNumDbl
unExprCastFloat
  :: (TypeSym r typ, RenderValue r var val typ, TypeElim r typ)
  => r typ -> r val -> VS (r val)
unExprCastFloat :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, RenderValue r var val typ, TypeElim r typ) =>
r typ -> r val -> VS (r val)
unExprCastFloat r typ
t = CodeType -> VS (r val) -> VS (r val)
forall {k} {r :: k -> *} {var :: k} {val :: k} {typ :: k}.
(RenderValue r var val typ, TypeSym r typ) =>
CodeType -> VS (r val) -> VS (r val)
castType (r typ -> CodeType
forall {k} (r :: k -> *) (typ :: k).
TypeElim r typ =>
r typ -> CodeType
getCodeType r typ
t) (VS (r val) -> VS (r val))
-> (r val -> VS (r val)) -> r val -> VS (r val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r val -> VS (r val)
forall a s. a -> State s a
toState
  where castType :: CodeType -> VS (r val) -> VS (r val)
castType CodeType
Float = VS (r typ) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> VS (r val) -> VS (r val)
cast VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
float
        castType CodeType
_ = VS (r val) -> VS (r val)
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
  :: (OpElim r, RenderValue r var val typ, ValueElim r val)
  => VSUnOp r -> VS (r typ) -> VS (r val) -> VS (r val)
typeUnExpr :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val) =>
VSUnOp r -> VS (r typ) -> VS (r val) -> VS (r val)
typeUnExpr VSUnOp r
u' VS (r typ)
t' VS (r val)
s' = do
  u <- VSUnOp r
u'
  t <- t'
  s <- s'
  mkExpr (uOpPrec u) t (unOpDocD (RC.uOp u) (RC.value s))

-- | Constructs binary expressions like v + w, for some operator + and values v
-- and w, parenthesizing v and w if needed.
binExpr
  ::
    ( OpElim r
    , RenderValue r var val typ
    , TypeElim r typ
    , ValueElim r val
    , ValueSym r val typ
    )
  => VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExpr :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, TypeElim r typ,
 ValueElim r val, ValueSym r val typ) =>
VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExpr VSBinOp r
b' VS (r val)
v1' VS (r val)
v2'= do
  b <- VSBinOp r
b'
  exprType <- numType v1' v2'
  exprRender <- exprRender' binExprRender b' v1' v2'
  mkExpr (bOpPrec b) exprType exprRender

-- | Constructs binary expressions like pow(v,w), for some operator pow and
-- values v and w
binExpr'
  ::
    ( OpElim r
    , RenderValue r var val typ
    , TypeElim r typ
    , ValueElim r val
    , ValueSym r val typ
    )
  => VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExpr' :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, TypeElim r typ,
 ValueElim r val, ValueSym r val typ) =>
VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExpr' VSBinOp r
b' VS (r val)
v1' VS (r val)
v2' = do
  exprType <- VS (r val) -> VS (r val) -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k) (val :: k).
(TypeElim r typ, ValueSym r val typ) =>
VS (r val) -> VS (r val) -> VS (r typ)
numType VS (r val)
v1' VS (r val)
v2'
  exprRender <- exprRender' binOpDocDRend b' v1' v2'
  mkExpr 9 exprType 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'
  ::
    ( OpElim r
    , RenderValue r var val typ
    , TypeSym r typ
    , TypeElim r typ
    , ValueElim r val
    , ValueSym r val typ
    )
  => VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExprNumDbl' :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, TypeSym r typ,
 TypeElim r typ, ValueElim r val, ValueSym r val typ) =>
VSBinOp r -> VS (r val) -> VS (r val) -> VS (r val)
binExprNumDbl' VSBinOp r
b' VS (r val)
v1' VS (r val)
v2' = do
  v1 <- VS (r val)
v1'
  v2 <- v2'
  let t1 = r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
valueType r val
v1
      t2 = r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
valueType r val
v2
  e <- binExpr' b' v1' v2'
  binExprCastFloat t1 t2 e

-- Only used by binExprNumDbl'
binExprCastFloat
  :: (RenderValue r var val typ, TypeSym r typ, TypeElim r typ)
  => r typ -> r typ -> r val -> VS (r val)
binExprCastFloat :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
(RenderValue r var val typ, TypeSym r typ, TypeElim r typ) =>
r typ -> r typ -> r val -> VS (r val)
binExprCastFloat r typ
t1 r typ
t2 = CodeType -> CodeType -> VS (r val) -> VS (r val)
forall {k} {r :: k -> *} {var :: k} {val :: k} {typ :: k}.
(RenderValue r var val typ, TypeSym r typ) =>
CodeType -> CodeType -> VS (r val) -> VS (r val)
castType (r typ -> CodeType
forall {k} (r :: k -> *) (typ :: k).
TypeElim r typ =>
r typ -> CodeType
getCodeType r typ
t1) (r typ -> CodeType
forall {k} (r :: k -> *) (typ :: k).
TypeElim r typ =>
r typ -> CodeType
getCodeType r typ
t2) (VS (r val) -> VS (r val))
-> (r val -> VS (r val)) -> r val -> VS (r val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r val -> VS (r val)
forall a s. a -> State s a
toState
  where castType :: CodeType -> CodeType -> VS (r val) -> VS (r val)
castType CodeType
Float CodeType
_ = VS (r typ) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> VS (r val) -> VS (r val)
cast VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
float
        castType CodeType
_ CodeType
Float = VS (r typ) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> VS (r val) -> VS (r val)
cast VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
float
        castType CodeType
_ CodeType
_ = VS (r val) -> VS (r val)
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
  :: (OpElim r, RenderValue r var val typ, ValueElim r val)
  => VSBinOp r -> VS (r typ) -> VS (r val) -> VS (r val) -> VS (r val)
typeBinExpr :: forall (r :: * -> *) var val typ.
(OpElim r, RenderValue r var val typ, ValueElim r val) =>
VSBinOp r -> VS (r typ) -> VS (r val) -> VS (r val) -> VS (r val)
typeBinExpr VSBinOp r
b' VS (r typ)
t' VS (r val)
v1' VS (r val)
v2' = do
  b <- VSBinOp r
b'
  t <- t'
  bnexr <- exprRender' binExprRender b' v1' v2'
  mkExpr (bOpPrec b) t bnexr

-- For numeric binary expressions, checks that both types are numeric and
-- returns result type. Selects the type with lowest precision.
numType
  :: (TypeElim r typ, ValueSym r val typ)
  => VS (r val)-> VS (r val) -> VS (r typ)
numType :: forall {k} (r :: k -> *) (typ :: k) (val :: k).
(TypeElim r typ, ValueSym r val typ) =>
VS (r val) -> VS (r val) -> VS (r typ)
numType VS (r val)
v1' VS (r val)
v2' = do
  v1 <- VS (r val)
v1'
  v2 <- v2'
  let t1 = r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
valueType r val
v1
      t2 = r val -> r typ
forall {k} (r :: k -> *) (val :: k) (typ :: k).
ValueSym r val typ =>
r val -> r typ
valueType r val
v2
      numericType CodeType
Integer CodeType
Integer = r typ
t1
      numericType CodeType
Float CodeType
_ = r typ
t1
      numericType CodeType
_ CodeType
Float = r typ
t2
      numericType CodeType
Double CodeType
_ = r typ
t1
      numericType CodeType
_ CodeType
Double = r typ
t2
      numericType CodeType
_ CodeType
_ = String -> r typ
forall a. HasCallStack => String -> a
error String
"Numeric types required for numeric expression"
  toState $ numericType (getCodeType t1) (getCodeType t2)

exprRender' :: (r OpData -> r val -> r val -> Doc) ->
  VSBinOp r -> VS (r val) -> VS (r val) -> VS Doc
exprRender' :: forall (r :: * -> *) val.
(r OpData -> r val -> r val -> Doc)
-> VSBinOp r -> VS (r val) -> VS (r val) -> VS Doc
exprRender' r OpData -> r val -> r val -> Doc
f VSBinOp r
b' VS (r val)
v1' VS (r val)
v2' = do
  b <- VSBinOp r
b'
  v1 <- v1'
  v2 <- v2'
  toState $ f b v1 v2

mkExpr :: (RenderValue r var val typ) => Int -> r typ -> Doc -> VS (r val)
mkExpr :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
Int -> r typ -> Doc -> VS (r val)
mkExpr Int
p r typ
t = Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
Maybe Int -> Maybe Integer -> VS (r typ) -> Doc -> VS (r val)
valFromData (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p) Maybe Integer
forall a. Maybe a
Nothing (r typ -> VS (r typ)
forall a s. a -> State s a
toState r typ
t)

binOpDocDRend
  :: (OpElim r, ValueElim r val)
  => r OpData -> r val -> r val -> Doc
binOpDocDRend :: forall (r :: * -> *) val.
(OpElim r, ValueElim r val) =>
r OpData -> r val -> r val -> Doc
binOpDocDRend r OpData
b r val
v1 r val
v2 = Doc -> Doc -> Doc -> Doc
binOpDocD' (r OpData -> Doc
forall (r :: * -> *). OpElim r => r OpData -> Doc
RC.bOp r OpData
b) (r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
v1) (r val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
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 :: (OpElim r, ValueElim r val) => r OpData -> r val -> Doc
exprParensL :: forall (r :: * -> *) val.
(OpElim r, ValueElim r val) =>
r OpData -> r val -> Doc
exprParensL r OpData
o r val
v = (if (Int -> Bool) -> Maybe Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< r OpData -> Int
forall (r :: * -> *). OpElim r => r OpData -> Int
bOpPrec r OpData
o) (r val -> Maybe Int
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Maybe Int
valuePrec r val
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 val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
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 :: (OpElim r, ValueElim r val) => r OpData -> r val -> Doc
exprParensR :: forall (r :: * -> *) val.
(OpElim r, ValueElim r val) =>
r OpData -> r val -> Doc
exprParensR r OpData
o r val
v = (if (Int -> Bool) -> Maybe Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= r OpData -> Int
forall (r :: * -> *). OpElim r => r OpData -> Int
bOpPrec r OpData
o) (r val -> Maybe Int
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Maybe Int
valuePrec r val
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 val -> Doc
forall {k} (r :: k -> *) (val :: k).
ValueElim r val =>
r val -> Doc
RC.value r val
v

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