{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}
-- |
-- Module      : Data.Array.Accelerate.Trafo.Algebra
-- Copyright   : [2012..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Algebraic simplifications of scalar expressions, including constant folding
-- and using algebraic properties of particular operator-operand combinations.
--

module Data.Array.Accelerate.Trafo.Algebra (

  evalPrimApp,

) where

import Data.Array.Accelerate.AST
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Analysis.Match
import Data.Array.Accelerate.Pretty.Print                           ( primOperator, isInfix, opName )
import Data.Array.Accelerate.Trafo.Environment
import Data.Array.Accelerate.Type

import qualified Data.Array.Accelerate.Debug.Stats                  as Stats

import Data.Bits
import Data.Monoid
import Data.Text                                                    ( Text )
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Render.Text
import GHC.Float                                                    ( float2Double, double2Float )
import Prelude                                                      hiding ( exp )
import qualified Prelude                                            as P


-- Propagate constant expressions, which are either constant valued expressions
-- or constant let bindings. Be careful not to follow self-cycles.
--
propagate
    :: forall env aenv exp.
       Gamma env env aenv
    -> OpenExp env aenv exp
    -> Maybe exp
propagate :: Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env = OpenExp env aenv exp -> Maybe exp
forall e. OpenExp env aenv e -> Maybe e
cvtE
  where
    cvtE :: OpenExp env aenv e -> Maybe e
    cvtE :: OpenExp env aenv e -> Maybe e
cvtE OpenExp env aenv e
exp = case OpenExp env aenv e
exp of
      Const ScalarType e
_ e
c                                 -> e -> Maybe e
forall a. a -> Maybe a
Just e
c
      PrimConst PrimConst e
c                               -> e -> Maybe e
forall a. a -> Maybe a
Just (PrimConst e -> e
forall a. PrimConst a -> a
evalPrimConst PrimConst e
c)
      Evar (Var ScalarType e
_  Idx env e
ix)
        | OpenExp env aenv e
e             <- Idx env e -> Gamma env env aenv -> OpenExp env aenv e
forall env' t env aenv.
HasCallStack =>
Idx env' t -> Gamma env env' aenv -> OpenExp env aenv t
prjExp Idx env e
ix Gamma env env aenv
env
        , Maybe (e :~: e)
Nothing       <- OpenExp env aenv e -> OpenExp env aenv e -> Maybe (e :~: e)
forall env aenv s t.
OpenExp env aenv s -> OpenExp env aenv t -> Maybe (s :~: t)
matchOpenExp OpenExp env aenv e
exp OpenExp env aenv e
e   -> OpenExp env aenv e -> Maybe e
forall e. OpenExp env aenv e -> Maybe e
cvtE OpenExp env aenv e
e
      OpenExp env aenv e
Nil                                       -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Pair OpenExp env aenv t1
e1 OpenExp env aenv t2
e2                                -> (,) (t1 -> t2 -> (t1, t2)) -> Maybe t1 -> Maybe (t2 -> (t1, t2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenExp env aenv t1 -> Maybe t1
forall e. OpenExp env aenv e -> Maybe e
cvtE OpenExp env aenv t1
e1 Maybe (t2 -> (t1, t2)) -> Maybe t2 -> Maybe (t1, t2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpenExp env aenv t2 -> Maybe t2
forall e. OpenExp env aenv e -> Maybe e
cvtE OpenExp env aenv t2
e2
      OpenExp env aenv e
_                                         -> Maybe e
forall a. Maybe a
Nothing


-- Attempt to evaluate primitive function applications
--
evalPrimApp
    :: forall env aenv a r.
       Gamma env env aenv
    -> PrimFun (a -> r)
    -> OpenExp env aenv a
    -> (Any, OpenExp env aenv r)
evalPrimApp :: Gamma env env aenv
-> PrimFun (a -> r)
-> OpenExp env aenv a
-> (Any, OpenExp env aenv r)
evalPrimApp Gamma env env aenv
env PrimFun (a -> r)
f OpenExp env aenv a
x
  -- First attempt to move constant values towards the left
  | Just OpenExp env aenv a
r      <- PrimFun (a -> r)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall env aenv a r.
PrimFun (a -> r)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
commutes PrimFun (a -> r)
f OpenExp env aenv a
x Gamma env env aenv
env     = Gamma env env aenv
-> PrimFun (a -> r)
-> OpenExp env aenv a
-> (Any, OpenExp env aenv r)
forall env aenv a r.
Gamma env env aenv
-> PrimFun (a -> r)
-> OpenExp env aenv a
-> (Any, OpenExp env aenv r)
evalPrimApp Gamma env env aenv
env PrimFun (a -> r)
f OpenExp env aenv a
r
--  | Just r      <- associates f x       = r

  -- Now attempt to evaluate any expressions
  | Bool
otherwise
  = (Any, OpenExp env aenv r)
-> (OpenExp env aenv r -> (Any, OpenExp env aenv r))
-> Maybe (OpenExp env aenv r)
-> (Any, OpenExp env aenv r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Any
Any Bool
False, PrimFun (a -> r) -> OpenExp env aenv a -> OpenExp env aenv r
forall a r env aenv.
PrimFun (a -> r) -> OpenExp env aenv a -> OpenExp env aenv r
PrimApp PrimFun (a -> r)
f OpenExp env aenv a
x) (Bool -> Any
Any Bool
True,)
  (Maybe (OpenExp env aenv r) -> (Any, OpenExp env aenv r))
-> Maybe (OpenExp env aenv r) -> (Any, OpenExp env aenv r)
forall a b. (a -> b) -> a -> b
$ case PrimFun (a -> r)
f of
      PrimAdd NumType a
ty                -> NumType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> (a, a) :-> a
evalAdd NumType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimSub NumType a
ty                -> NumType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> (a, a) :-> a
evalSub NumType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimMul NumType a
ty                -> NumType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> (a, a) :-> a
evalMul NumType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimNeg NumType a
ty                -> NumType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> a :-> a
evalNeg NumType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAbs NumType a
ty                -> NumType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> a :-> a
evalAbs NumType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimSig NumType a
ty                -> NumType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. NumType a -> a :-> a
evalSig NumType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimQuot IntegralType a
ty               -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalQuot IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimRem IntegralType a
ty                -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalRem IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimQuotRem IntegralType a
ty            -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalQuotRem IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimIDiv IntegralType a
ty               -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalIDiv IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimMod IntegralType a
ty                -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalMod IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimDivMod IntegralType a
ty             -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalDivMod IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimBAnd IntegralType a
ty               -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalBAnd IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimBOr IntegralType a
ty                -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalBOr IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimBXor IntegralType a
ty               -> IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, a) :-> a
evalBXor IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimBNot IntegralType a
ty               -> IntegralType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> a :-> a
evalBNot IntegralType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimBShiftL IntegralType a
ty            -> IntegralType a
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, Int) :-> a
evalBShiftL IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, Int)
x Gamma env env aenv
env
      PrimBShiftR IntegralType a
ty            -> IntegralType a
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, Int) :-> a
evalBShiftR IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, Int)
x Gamma env env aenv
env
      PrimBRotateL IntegralType a
ty           -> IntegralType a
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, Int) :-> a
evalBRotateL IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, Int)
x Gamma env env aenv
env
      PrimBRotateR IntegralType a
ty           -> IntegralType a
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. IntegralType a -> (a, Int) :-> a
evalBRotateR IntegralType a
ty OpenExp env aenv a
OpenExp env aenv (a, Int)
x Gamma env env aenv
env
      PrimPopCount IntegralType a
ty           -> IntegralType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv Int)
forall a. IntegralType a -> a :-> Int
evalPopCount IntegralType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimCountLeadingZeros IntegralType a
ty  -> IntegralType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv Int)
forall a. IntegralType a -> a :-> Int
evalCountLeadingZeros IntegralType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimCountTrailingZeros IntegralType a
ty -> IntegralType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv Int)
forall a. IntegralType a -> a :-> Int
evalCountTrailingZeros IntegralType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimFDiv FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> (a, a) :-> a
evalFDiv FloatingType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimRecip FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalRecip FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimSin FloatingType a
ty                -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalSin FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimCos FloatingType a
ty                -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalCos FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimTan FloatingType a
ty                -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalTan FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAsin FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAsin FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAcos FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAcos FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAtan FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAtan FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimSinh FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalSinh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimCosh FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalCosh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimTanh FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalTanh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAsinh FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAsinh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAcosh FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAcosh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimAtanh FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalAtanh FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimExpFloating FloatingType a
ty        -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalExpFloating FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimSqrt FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalSqrt FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimLog FloatingType a
ty                -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> a :-> a
evalLog FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimFPow FloatingType a
ty               -> FloatingType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> (a, a) :-> a
evalFPow FloatingType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimLogBase FloatingType a
ty            -> FloatingType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> (a, a) :-> a
evalLogBase FloatingType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimAtan2 FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. FloatingType a -> (a, a) :-> a
evalAtan2 FloatingType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimTruncate FloatingType a
ta IntegralType b
tb        -> FloatingType a
-> IntegralType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. FloatingType a -> IntegralType b -> a :-> b
evalTruncate FloatingType a
ta IntegralType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimRound FloatingType a
ta IntegralType b
tb           -> FloatingType a
-> IntegralType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. FloatingType a -> IntegralType b -> a :-> b
evalRound FloatingType a
ta IntegralType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimFloor FloatingType a
ta IntegralType b
tb           -> FloatingType a
-> IntegralType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. FloatingType a -> IntegralType b -> a :-> b
evalFloor FloatingType a
ta IntegralType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimCeiling FloatingType a
ta IntegralType b
tb         -> FloatingType a
-> IntegralType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. FloatingType a -> IntegralType b -> a :-> b
evalCeiling FloatingType a
ta IntegralType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimIsNaN FloatingType a
ty              -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. FloatingType a -> a :-> PrimBool
evalIsNaN FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimIsInfinite FloatingType a
ty         -> FloatingType a
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. FloatingType a -> a :-> PrimBool
evalIsInfinite FloatingType a
ty OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimLt SingleType a
ty                 -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalLt SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimGt SingleType a
ty                 -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalGt SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimLtEq SingleType a
ty               -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalLtEq SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimGtEq SingleType a
ty               -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalGtEq SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimEq SingleType a
ty                 -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalEq SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimNEq SingleType a
ty                -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. SingleType a -> (a, a) :-> PrimBool
evalNEq SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimMax SingleType a
ty                -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. SingleType a -> (a, a) :-> a
evalMax SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimMin SingleType a
ty                -> SingleType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall a. SingleType a -> (a, a) :-> a
evalMin SingleType a
ty OpenExp env aenv a
OpenExp env aenv (a, a)
x Gamma env env aenv
env
      PrimFun (a -> r)
PrimLAnd                  -> OpenExp env aenv (PrimBool, PrimBool)
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
(PrimBool, PrimBool) :-> PrimBool
evalLAnd OpenExp env aenv a
OpenExp env aenv (PrimBool, PrimBool)
x Gamma env env aenv
env
      PrimFun (a -> r)
PrimLOr                   -> OpenExp env aenv (PrimBool, PrimBool)
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
(PrimBool, PrimBool) :-> PrimBool
evalLOr OpenExp env aenv a
OpenExp env aenv (PrimBool, PrimBool)
x Gamma env env aenv
env
      PrimFun (a -> r)
PrimLNot                  -> OpenExp env aenv PrimBool
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
PrimBool :-> PrimBool
evalLNot OpenExp env aenv a
OpenExp env aenv PrimBool
x Gamma env env aenv
env
      PrimFromIntegral IntegralType a
ta NumType b
tb    -> IntegralType a
-> NumType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. IntegralType a -> NumType b -> a :-> b
evalFromIntegral IntegralType a
ta NumType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env
      PrimToFloating NumType a
ta FloatingType b
tb      -> NumType a
-> FloatingType b
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall a b. NumType a -> FloatingType b -> a :-> b
evalToFloating NumType a
ta FloatingType b
tb OpenExp env aenv a
OpenExp env aenv a
x Gamma env env aenv
env


-- Discriminate binary functions that commute, and if so return the operands in
-- a stable ordering. If only one of the arguments is a constant, this is placed
-- to the left of the operator. Returning Nothing indicates no change is made.
--
commutes
    :: forall env aenv a r.
       PrimFun (a -> r)
    -> OpenExp env aenv a
    -> Gamma env env aenv
    -> Maybe (OpenExp env aenv a)
commutes :: PrimFun (a -> r)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
commutes PrimFun (a -> r)
f OpenExp env aenv a
x Gamma env env aenv
env = case PrimFun (a -> r)
f of
  PrimAdd NumType a
_     -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimMul NumType a
_     -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimBAnd IntegralType a
_    -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimBOr IntegralType a
_     -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimBXor IntegralType a
_    -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimEq SingleType a
_      -> OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (a, a)
x
  PrimNEq SingleType a
_     -> OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (a, a)
x
  PrimMax SingleType a
_     -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimMin SingleType a
_     -> OpenExp env aenv (r, r) -> Maybe (OpenExp env aenv (r, r))
forall b.
OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle OpenExp env aenv a
OpenExp env aenv (r, r)
x
  PrimFun (a -> r)
_             -> Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing
  where
    swizzle :: OpenExp env aenv (b,b) -> Maybe (OpenExp env aenv (b,b))
    swizzle :: OpenExp env aenv (b, b) -> Maybe (OpenExp env aenv (b, b))
swizzle (Pair OpenExp env aenv t1
a OpenExp env aenv t2
b)
      | Maybe t1
Nothing         <- Gamma env env aenv -> OpenExp env aenv t1 -> Maybe t1
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv t1
a
      , Just t2
_          <- Gamma env env aenv -> OpenExp env aenv t2 -> Maybe t2
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv t2
b
      = Text
-> Maybe (OpenExp env aenv (t2, t1))
-> Maybe (OpenExp env aenv (t2, t1))
forall a. Text -> a -> a
Stats.ruleFired (Text -> PrimFun (a -> r) -> Text
forall f. Text -> PrimFun f -> Text
pprFun Text
"commutes" PrimFun (a -> r)
f)
      (Maybe (OpenExp env aenv (t2, t1))
 -> Maybe (OpenExp env aenv (t2, t1)))
-> Maybe (OpenExp env aenv (t2, t1))
-> Maybe (OpenExp env aenv (t2, t1))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv (t2, t1) -> Maybe (OpenExp env aenv (t2, t1))
forall a. a -> Maybe a
Just (OpenExp env aenv (t2, t1) -> Maybe (OpenExp env aenv (t2, t1)))
-> OpenExp env aenv (t2, t1) -> Maybe (OpenExp env aenv (t2, t1))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv t2
-> OpenExp env aenv t1 -> OpenExp env aenv (t2, t1)
forall env aenv t1 t2.
OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
Pair OpenExp env aenv t2
b OpenExp env aenv t1
a

--    TLM: changing the ordering here when neither term can be reduced can be
--         disadvantageous: for example in (x &&* y), the user might have put a
--         simpler condition first that is designed to fail fast.
--
--      | Nothing         <- propagate env a
--      , Nothing         <- propagate env b
--      , hashOpenExp a > hashOpenExp b
--      = Just $ Tuple (NilTup `SnocTup` b `SnocTup` a)

    swizzle OpenExp env aenv (b, b)
_
      = Maybe (OpenExp env aenv (b, b))
forall a. Maybe a
Nothing


{--
-- Determine if successive applications of a binary operator will associate, and
-- if so move them to the left. That is:
--
--   a + (b + c)  -->  (a + b) + c
--
-- Returning Nothing indicates no change is made.
--
-- TLM: we might get into trouble here, as we've lost track of where the user
--      has explicitly put parenthesis.
--
-- TLM: BROKEN!! does not correctly change the sign of expressions when flipping
--      (-x+y) or (-y+x).
--
associates
    :: (Elt a, Elt r)
    => PrimFun (a -> r)
    -> OpenExp env aenv a
    -> Maybe (OpenExp env aenv r)
associates fun exp = case fun of
  PrimAdd _     -> swizzle fun exp [PrimAdd ty, PrimSub ty]
  PrimSub _     -> swizzle fun exp [PrimAdd ty, PrimSub ty]
  PrimLAnd      -> swizzle fun exp [fun]
  PrimLOr       -> swizzle fun exp [fun]
  _             -> swizzle fun exp [fun]
  where
    -- TODO: check the list of ops is complete (and correct)
    ty  = undefined
    ops = [ PrimMul ty, PrimFDiv ty, PrimAdd ty, PrimSub ty, PrimBAnd ty, PrimBOr ty, PrimBXor ty ]

    swizzle :: (Elt a, Elt r) => PrimFun (a -> r) -> OpenExp env aenv a -> [PrimFun (a -> r)] -> Maybe (OpenExp env aenv r)
    swizzle f x lvl
      | Just Refl       <- matches f ops
      , Just (a,bc)     <- untup2 x
      , PrimApp g y     <- bc
      , Just Refl       <- matches g lvl
      , Just (b,c)      <- untup2 y
      = Stats.ruleFired (pprFun "associates" f)
      $ Just $ PrimApp g (tup2 (PrimApp f (tup2 (a,b)), c))

    swizzle _ _ _
      = Nothing

    matches :: (Elt s, Elt t) => PrimFun (s -> a) -> [PrimFun (t -> a)] -> Maybe (s :=: t)
    matches _ []        = Nothing
    matches f (x:xs)
      | Just Refl       <- matchPrimFun' f x
      = Just Refl

      | otherwise
      = matches f xs
--}


-- Helper functions
-- ----------------

type a :-> b = forall env aenv. OpenExp env aenv a -> Gamma env env aenv -> Maybe (OpenExp env aenv b)

eval1 :: SingleType b -> (a -> b) -> a :-> b
eval1 :: SingleType b -> (a -> b) -> a :-> b
eval1 SingleType b
tp a -> b
f OpenExp env aenv a
x Gamma env env aenv
env
  | Just a
a <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x   = Text -> Maybe (OpenExp env aenv b) -> Maybe (OpenExp env aenv b)
forall a. Text -> a -> a
Stats.substitution Text
"constant fold" (Maybe (OpenExp env aenv b) -> Maybe (OpenExp env aenv b))
-> (OpenExp env aenv b -> Maybe (OpenExp env aenv b))
-> OpenExp env aenv b
-> Maybe (OpenExp env aenv b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenExp env aenv b -> Maybe (OpenExp env aenv b)
forall a. a -> Maybe a
Just (OpenExp env aenv b -> Maybe (OpenExp env aenv b))
-> OpenExp env aenv b -> Maybe (OpenExp env aenv b)
forall a b. (a -> b) -> a -> b
$ ScalarType b -> b -> OpenExp env aenv b
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const (SingleType b -> ScalarType b
forall a. SingleType a -> ScalarType a
SingleScalarType SingleType b
tp) (a -> b
f a
a)
  | Bool
otherwise                   = Maybe (OpenExp env aenv b)
forall a. Maybe a
Nothing

eval2 :: SingleType c -> (a -> b -> c) -> (a,b) :-> c
eval2 :: SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 SingleType c
tp a -> b -> c
f (OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv b
y)) Gamma env env aenv
env
  | Just a
a <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  , Just b
b <- Gamma env env aenv -> OpenExp env aenv b -> Maybe b
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv b
y
  = Text -> Maybe (OpenExp env aenv c) -> Maybe (OpenExp env aenv c)
forall a. Text -> a -> a
Stats.substitution Text
"constant fold"
  (Maybe (OpenExp env aenv c) -> Maybe (OpenExp env aenv c))
-> Maybe (OpenExp env aenv c) -> Maybe (OpenExp env aenv c)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv c -> Maybe (OpenExp env aenv c)
forall a. a -> Maybe a
Just (OpenExp env aenv c -> Maybe (OpenExp env aenv c))
-> OpenExp env aenv c -> Maybe (OpenExp env aenv c)
forall a b. (a -> b) -> a -> b
$ ScalarType c -> c -> OpenExp env aenv c
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const (SingleType c -> ScalarType c
forall a. SingleType a -> ScalarType a
SingleScalarType SingleType c
tp) (a -> b -> c
f a
a b
b)
eval2 SingleType c
_ a -> b -> c
_ OpenExp env aenv (a, b)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv c)
forall a. Maybe a
Nothing

fromBool :: Bool -> PrimBool
fromBool :: Bool -> PrimBool
fromBool Bool
False = PrimBool
0
fromBool Bool
True  = PrimBool
1

toBool :: PrimBool -> Bool
toBool :: PrimBool -> Bool
toBool PrimBool
0 = Bool
False
toBool PrimBool
_ = Bool
True

bool1 :: (a -> Bool) -> a :-> PrimBool
bool1 :: (a -> Bool) -> a :-> PrimBool
bool1 a -> Bool
f OpenExp env aenv a
x Gamma env env aenv
env
  | Just a
a <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  = Text
-> Maybe (OpenExp env aenv PrimBool)
-> Maybe (OpenExp env aenv PrimBool)
forall a. Text -> a -> a
Stats.substitution Text
"constant fold"
  (Maybe (OpenExp env aenv PrimBool)
 -> Maybe (OpenExp env aenv PrimBool))
-> (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool
-> Maybe (OpenExp env aenv PrimBool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 (Bool -> PrimBool
fromBool (a -> Bool
f a
a))
bool1 a -> Bool
_ OpenExp env aenv a
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv PrimBool)
forall a. Maybe a
Nothing

bool2 :: (a -> b -> Bool) -> (a,b) :-> PrimBool
bool2 :: (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> b -> Bool
f (OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv b
y)) Gamma env env aenv
env
  | Just a
a <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  , Just b
b <- Gamma env env aenv -> OpenExp env aenv b -> Maybe b
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv b
y
  = Text
-> Maybe (OpenExp env aenv PrimBool)
-> Maybe (OpenExp env aenv PrimBool)
forall a. Text -> a -> a
Stats.substitution Text
"constant fold"
  (Maybe (OpenExp env aenv PrimBool)
 -> Maybe (OpenExp env aenv PrimBool))
-> Maybe (OpenExp env aenv PrimBool)
-> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 (Bool -> PrimBool
fromBool (a -> b -> Bool
f a
a b
b))
bool2 a -> b -> Bool
_ OpenExp env aenv (a, b)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv PrimBool)
forall a. Maybe a
Nothing

tup2 :: (OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 :: (OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 (OpenExp env aenv a
a,OpenExp env aenv b
b) = OpenExp env aenv a -> OpenExp env aenv b -> OpenExp env aenv (a, b)
forall env aenv t1 t2.
OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
Pair OpenExp env aenv a
a OpenExp env aenv b
b

untup2 :: OpenExp env aenv (a, b) -> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 :: OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, b)
exp
  | Pair OpenExp env aenv t1
a OpenExp env aenv t2
b <- OpenExp env aenv (a, b)
exp = (OpenExp env aenv t1, OpenExp env aenv t2)
-> Maybe (OpenExp env aenv t1, OpenExp env aenv t2)
forall a. a -> Maybe a
Just (OpenExp env aenv t1
a, OpenExp env aenv t2
b)
  | Bool
otherwise       = Maybe (OpenExp env aenv a, OpenExp env aenv b)
forall a. Maybe a
Nothing


pprFun :: Text -> PrimFun f -> Text
pprFun :: Text -> PrimFun f -> Text
pprFun Text
rule PrimFun f
f
  = SimpleDocStream Keyword -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict
  (SimpleDocStream Keyword -> Text)
-> (Doc Keyword -> SimpleDocStream Keyword) -> Doc Keyword -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Keyword -> SimpleDocStream Keyword
forall ann. Doc ann -> SimpleDocStream ann
layoutCompact
  (Doc Keyword -> Text) -> Doc Keyword -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Keyword
forall a ann. Pretty a => a -> Doc ann
pretty Text
rule Doc Keyword -> Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Keyword
f'
  where
    op :: Operator
op = PrimFun f -> Operator
forall a. PrimFun a -> Operator
primOperator PrimFun f
f
    f' :: Doc Keyword
f' = if Operator -> Bool
isInfix Operator
op
           then Doc Keyword -> Doc Keyword
forall ann. Doc ann -> Doc ann
parens (Operator -> Doc Keyword
opName Operator
op)
           else Operator -> Doc Keyword
opName Operator
op


-- Methods of Num
-- --------------

evalAdd :: NumType a -> (a,a) :-> a
evalAdd :: NumType a -> (a, a) :-> a
evalAdd ty :: NumType a
ty@(IntegralNumType IntegralType a
ty') | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalAdd' NumType a
ty
evalAdd ty :: NumType a
ty@(FloatingNumType FloatingType a
ty') | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalAdd' NumType a
ty

evalAdd' :: (Eq a, Num a) => NumType a -> (a,a) :-> a
evalAdd' :: NumType a -> (a, a) :-> a
evalAdd' NumType a
_  (OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv a
y)) Gamma env env aenv
env
  | Just a
a      <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  , a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x+0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
y

evalAdd' NumType a
ty OpenExp env aenv (a, a)
arg Gamma env env aenv
env
  = SingleType a
-> (a -> a -> a)
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType NumType a
ty) a -> a -> a
forall a. Num a => a -> a -> a
(+) OpenExp env aenv (a, a)
arg Gamma env env aenv
env


evalSub :: NumType a -> (a,a) :-> a
evalSub :: NumType a -> (a, a) :-> a
evalSub ty :: NumType a
ty@(IntegralNumType IntegralType a
ty') | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalSub' NumType a
ty
evalSub ty :: NumType a
ty@(FloatingNumType FloatingType a
ty') | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalSub' NumType a
ty

evalSub' :: forall a. (Eq a, Num a) => NumType a -> (a,a) :-> a
evalSub' :: NumType a -> (a, a) :-> a
evalSub' NumType a
ty (OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv a
y)) Gamma env env aenv
env
  | Just a
b      <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  , a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x-0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

  | Maybe a
Nothing     <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  , Just a
b      <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"-y+x"
  (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just (OpenExp env aenv a -> Maybe (OpenExp env aenv a))
-> ((Any, OpenExp env aenv a) -> OpenExp env aenv a)
-> (Any, OpenExp env aenv a)
-> Maybe (OpenExp env aenv a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Any, OpenExp env aenv a) -> OpenExp env aenv a
forall a b. (a, b) -> b
snd ((Any, OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> (Any, OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ Gamma env env aenv
-> PrimFun ((a, a) -> a)
-> OpenExp env aenv (a, a)
-> (Any, OpenExp env aenv a)
forall env aenv a r.
Gamma env env aenv
-> PrimFun (a -> r)
-> OpenExp env aenv a
-> (Any, OpenExp env aenv r)
evalPrimApp Gamma env env aenv
env (NumType a -> PrimFun ((a, a) -> a)
forall a. NumType a -> PrimFun ((a, a) -> a)
PrimAdd NumType a
ty) (ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp (-a
b) OpenExp env aenv a -> OpenExp env aenv a -> OpenExp env aenv (a, a)
forall env aenv t1 t2.
OpenExp env aenv t1
-> OpenExp env aenv t2 -> OpenExp env aenv (t1, t2)
`Pair` OpenExp env aenv a
x)
  -- (Tuple $ NilTup `SnocTup` Const (fromElt (-b)) `SnocTup` x)

  | Just a :~: a
Refl   <- OpenExp env aenv a -> OpenExp env aenv a -> Maybe (a :~: a)
forall env aenv s t.
OpenExp env aenv s -> OpenExp env aenv t -> Maybe (s :~: t)
matchOpenExp OpenExp env aenv a
x OpenExp env aenv a
y
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x-x"
  (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just (OpenExp env aenv a -> Maybe (OpenExp env aenv a))
-> OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
0
  where
    tp :: ScalarType a
tp = SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType a -> ScalarType a) -> SingleType a -> ScalarType a
forall a b. (a -> b) -> a -> b
$ NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType NumType a
ty

evalSub' NumType a
ty OpenExp env aenv (a, a)
arg Gamma env env aenv
env
  = SingleType a
-> (a -> a -> a)
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType NumType a
ty) (-) OpenExp env aenv (a, a)
arg Gamma env env aenv
env


evalMul :: NumType a -> (a,a) :-> a
evalMul :: NumType a -> (a, a) :-> a
evalMul ty :: NumType a
ty@(IntegralNumType IntegralType a
ty') | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalMul' NumType a
ty
evalMul ty :: NumType a
ty@(FloatingNumType FloatingType a
ty') | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty' = NumType a -> (a, a) :-> a
forall a. (Eq a, Num a) => NumType a -> (a, a) :-> a
evalMul' NumType a
ty

evalMul' :: (Eq a, Num a) => NumType a -> (a,a) :-> a
evalMul' :: NumType a -> (a, a) :-> a
evalMul' NumType a
_  (OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv a
y)) Gamma env env aenv
env
  | Just a
a      <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  , Maybe a
Nothing     <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  = case a
a of
      a
0         -> Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x*0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x
      a
1         -> Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x*1" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
y
      a
_         -> Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing

evalMul' NumType a
ty OpenExp env aenv (a, a)
arg Gamma env env aenv
env
  = SingleType a
-> (a -> a -> a)
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType NumType a
ty) a -> a -> a
forall a. Num a => a -> a -> a
(*) OpenExp env aenv (a, a)
arg Gamma env env aenv
env

evalNeg :: NumType a -> a :-> a
evalNeg :: NumType a -> a :-> a
evalNeg NumType a
_                    OpenExp env aenv a
x Gamma env env aenv
_   | PrimApp PrimNeg{} OpenExp env aenv a
x' <- OpenExp env aenv a
x       = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"negate/negate" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x'
evalNeg (IntegralNumType IntegralType a
ty) OpenExp env aenv a
x Gamma env env aenv
env | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a
-> (a -> a)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a
forall a. Num a => a -> a
negate OpenExp env aenv a
x Gamma env env aenv
env
evalNeg (FloatingNumType FloatingType a
ty) OpenExp env aenv a
x Gamma env env aenv
env | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a
-> (a -> a)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Num a => a -> a
negate OpenExp env aenv a
x Gamma env env aenv
env

evalAbs :: NumType a -> a :-> a
evalAbs :: NumType a -> a :-> a
evalAbs (IntegralNumType IntegralType a
ty) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a
forall a. Num a => a -> a
abs
evalAbs (FloatingNumType FloatingType a
ty) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Num a => a -> a
abs

evalSig :: NumType a -> a :-> a
evalSig :: NumType a -> a :-> a
evalSig (IntegralNumType IntegralType a
ty) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a
forall a. Num a => a -> a
signum
evalSig (FloatingNumType FloatingType a
ty) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Num a => a -> a
signum


-- Methods of Integral & Bits
-- --------------------------

evalQuot :: IntegralType a -> (a,a) :-> a
evalQuot :: IntegralType a -> (a, a) :-> a
evalQuot IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | Just OpenExp env aenv (a, a)
qr    <- IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalQuotRem IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  , Just (OpenExp env aenv a
q,OpenExp env aenv a
_) <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
qr
  = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
q
evalQuot IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing

evalRem :: IntegralType a -> (a,a) :-> a
evalRem :: IntegralType a -> (a, a) :-> a
evalRem IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | Just OpenExp env aenv (a, a)
qr    <- IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalQuotRem IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  , Just (OpenExp env aenv a
_,OpenExp env aenv a
r) <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
qr
  = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
r
evalRem IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing

evalQuotRem :: forall a. IntegralType a -> (a,a) :-> (a,a)
evalQuotRem :: IntegralType a -> (a, a) :-> (a, a)
evalQuotRem IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty
  , Just (OpenExp env aenv a
x, OpenExp env aenv a
y)  <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
exp
  , Just a
b       <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  = case a
b of
      a
0 -> Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing
      a
1 -> Text
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a. Text -> a -> a
Stats.ruleFired Text
"quotRem x 1" (Maybe (OpenExp env aenv (a, a))
 -> Maybe (OpenExp env aenv (a, a)))
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a. a -> Maybe a
Just ((OpenExp env aenv a, OpenExp env aenv a) -> OpenExp env aenv (a, a)
forall env aenv a b.
(OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 (OpenExp env aenv a
x, ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
0))
      a
_ -> case Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x of
             Maybe a
Nothing -> Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing
             Just a
a  -> Text
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a. Text -> a -> a
Stats.substitution Text
"constant fold"
                      (Maybe (OpenExp env aenv (a, a))
 -> Maybe (OpenExp env aenv (a, a)))
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a. a -> Maybe a
Just (OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a)))
-> OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ let (a
u,a
v) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
a a
b
                               in  (OpenExp env aenv a, OpenExp env aenv a) -> OpenExp env aenv (a, a)
forall env aenv a b.
(OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 (ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
u, ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
v)
  where
    tp :: ScalarType a
tp = SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType a -> ScalarType a) -> SingleType a -> ScalarType a
forall a b. (a -> b) -> a -> b
$ NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty
evalQuotRem IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing


evalIDiv :: IntegralType a -> (a,a) :-> a
evalIDiv :: IntegralType a -> (a, a) :-> a
evalIDiv IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | Just OpenExp env aenv (a, a)
dm    <- IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalDivMod IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  , Just (OpenExp env aenv a
d,OpenExp env aenv a
_) <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
dm
  = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
d
evalIDiv IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing

evalMod :: IntegralType a -> (a,a) :-> a
evalMod :: IntegralType a -> (a, a) :-> a
evalMod IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | Just OpenExp env aenv (a, a)
dm    <- IntegralType a
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv (a, a))
forall a. IntegralType a -> (a, a) :-> (a, a)
evalDivMod IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  , Just (OpenExp env aenv a
_,OpenExp env aenv a
m) <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
dm
  = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
m
evalMod IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv a)
forall a. Maybe a
Nothing

evalDivMod :: forall a. IntegralType a -> (a,a) :-> (a,a)
evalDivMod :: IntegralType a -> (a, a) :-> (a, a)
evalDivMod IntegralType a
ty OpenExp env aenv (a, a)
exp Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty
  , Just (OpenExp env aenv a
x, OpenExp env aenv a
y)  <- OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 OpenExp env aenv (a, a)
exp
  , Just a
b       <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  = case a
b of
      a
0 -> Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing
      a
1 -> Text
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a. Text -> a -> a
Stats.ruleFired Text
"divMod x 1" (Maybe (OpenExp env aenv (a, a))
 -> Maybe (OpenExp env aenv (a, a)))
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a. a -> Maybe a
Just ((OpenExp env aenv a, OpenExp env aenv a) -> OpenExp env aenv (a, a)
forall env aenv a b.
(OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 (OpenExp env aenv a
x, ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
0))
      a
_ -> case Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x of
             Maybe a
Nothing -> Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing
             Just a
a  -> Text
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a. Text -> a -> a
Stats.substitution Text
"constant fold"
                      (Maybe (OpenExp env aenv (a, a))
 -> Maybe (OpenExp env aenv (a, a)))
-> Maybe (OpenExp env aenv (a, a))
-> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a. a -> Maybe a
Just (OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a)))
-> OpenExp env aenv (a, a) -> Maybe (OpenExp env aenv (a, a))
forall a b. (a -> b) -> a -> b
$ let (a
u,a
v) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b
                               in  (OpenExp env aenv a, OpenExp env aenv a) -> OpenExp env aenv (a, a)
forall env aenv a b.
(OpenExp env aenv a, OpenExp env aenv b) -> OpenExp env aenv (a, b)
tup2 (ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
u, ScalarType a -> a -> OpenExp env aenv a
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType a
tp a
v)
  where
    tp :: ScalarType a
tp = SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType a -> ScalarType a) -> SingleType a -> ScalarType a
forall a b. (a -> b) -> a -> b
$ NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty
evalDivMod IntegralType a
_ OpenExp env aenv (a, a)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv (a, a))
forall a. Maybe a
Nothing

evalBAnd :: IntegralType a -> (a,a) :-> a
evalBAnd :: IntegralType a -> (a, a) :-> a
evalBAnd IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a -> a
forall a. Bits a => a -> a -> a
(.&.)

evalBOr :: IntegralType a -> (a,a) :-> a
evalBOr :: IntegralType a -> (a, a) :-> a
evalBOr IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = IntegralType a -> (a, a) :-> a
forall a. (Eq a, Num a, Bits a) => IntegralType a -> (a, a) :-> a
evalBOr' IntegralType a
ty

evalBOr' :: (Eq a, Num a, Bits a) => IntegralType a -> (a,a) :-> a
evalBOr' :: IntegralType a -> (a, a) :-> a
evalBOr' IntegralType a
_ (OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv a
y)) Gamma env env aenv
env
  | Just a
0 <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
x
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x .|. 0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
y

evalBOr' IntegralType a
ty OpenExp env aenv (a, a)
arg Gamma env env aenv
env
  = SingleType a
-> (a -> a -> a)
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) OpenExp env aenv (a, a)
arg Gamma env env aenv
env

evalBXor :: IntegralType a -> (a,a) :-> a
evalBXor :: IntegralType a -> (a, a) :-> a
evalBXor IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a -> a
forall a. Bits a => a -> a -> a
xor

evalBNot :: IntegralType a -> a :-> a
evalBNot :: IntegralType a -> a :-> a
evalBNot IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> a
forall a. Bits a => a -> a
complement

evalBShiftL :: IntegralType a -> (a,Int) :-> a
evalBShiftL :: IntegralType a -> (a, Int) :-> a
evalBShiftL IntegralType a
_ (OpenExp env aenv (a, Int)
-> Maybe (OpenExp env aenv a, OpenExp env aenv Int)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv Int
i)) Gamma env env aenv
env
  | Just Int
0 <- Gamma env env aenv -> OpenExp env aenv Int -> Maybe Int
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv Int
i
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x `shiftL` 0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

evalBShiftL IntegralType a
ty OpenExp env aenv (a, Int)
arg Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a
-> (a -> Int -> a)
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL OpenExp env aenv (a, Int)
arg Gamma env env aenv
env

evalBShiftR :: IntegralType a -> (a,Int) :-> a
evalBShiftR :: IntegralType a -> (a, Int) :-> a
evalBShiftR IntegralType a
_ (OpenExp env aenv (a, Int)
-> Maybe (OpenExp env aenv a, OpenExp env aenv Int)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv Int
i)) Gamma env env aenv
env
  | Just Int
0 <- Gamma env env aenv -> OpenExp env aenv Int -> Maybe Int
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv Int
i
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x `shiftR` 0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

evalBShiftR IntegralType a
ty OpenExp env aenv (a, Int)
arg Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a
-> (a -> Int -> a)
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR OpenExp env aenv (a, Int)
arg Gamma env env aenv
env

evalBRotateL :: IntegralType a -> (a,Int) :-> a
evalBRotateL :: IntegralType a -> (a, Int) :-> a
evalBRotateL IntegralType a
_ (OpenExp env aenv (a, Int)
-> Maybe (OpenExp env aenv a, OpenExp env aenv Int)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv Int
i)) Gamma env env aenv
env
  | Just Int
0 <- Gamma env env aenv -> OpenExp env aenv Int -> Maybe Int
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv Int
i
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x `rotateL` 0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x
evalBRotateL IntegralType a
ty OpenExp env aenv (a, Int)
arg Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a
-> (a -> Int -> a)
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateL OpenExp env aenv (a, Int)
arg Gamma env env aenv
env

evalBRotateR :: IntegralType a -> (a,Int) :-> a
evalBRotateR :: IntegralType a -> (a, Int) :-> a
evalBRotateR IntegralType a
_ (OpenExp env aenv (a, Int)
-> Maybe (OpenExp env aenv a, OpenExp env aenv Int)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv Int
i)) Gamma env env aenv
env
  | Just Int
0 <- Gamma env env aenv -> OpenExp env aenv Int -> Maybe Int
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv Int
i
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x `rotateR` 0" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x
evalBRotateR IntegralType a
ty OpenExp env aenv (a, Int)
arg Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType a
-> (a -> Int -> a)
-> OpenExp env aenv (a, Int)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType a
ty) a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateR OpenExp env aenv (a, Int)
arg Gamma env env aenv
env

evalPopCount :: IntegralType a -> a :-> Int
evalPopCount :: IntegralType a -> a :-> Int
evalPopCount IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType Int -> (a -> Int) -> a :-> Int
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType Int -> SingleType Int
forall a. NumType a -> SingleType a
NumSingleType (NumType Int -> SingleType Int) -> NumType Int -> SingleType Int
forall a b. (a -> b) -> a -> b
$ IntegralType Int -> NumType Int
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Int
TypeInt) a -> Int
forall a. Bits a => a -> Int
popCount

evalCountLeadingZeros :: IntegralType a -> a :-> Int
evalCountLeadingZeros :: IntegralType a -> a :-> Int
evalCountLeadingZeros IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType Int -> (a -> Int) -> a :-> Int
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType Int -> SingleType Int
forall a. NumType a -> SingleType a
NumSingleType (NumType Int -> SingleType Int) -> NumType Int -> SingleType Int
forall a b. (a -> b) -> a -> b
$ IntegralType Int -> NumType Int
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Int
TypeInt) a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros

evalCountTrailingZeros :: IntegralType a -> a :-> Int
evalCountTrailingZeros :: IntegralType a -> a :-> Int
evalCountTrailingZeros IntegralType a
ty | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = SingleType Int -> (a -> Int) -> a :-> Int
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType Int -> SingleType Int
forall a. NumType a -> SingleType a
NumSingleType (NumType Int -> SingleType Int) -> NumType Int -> SingleType Int
forall a b. (a -> b) -> a -> b
$ IntegralType Int -> NumType Int
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Int
TypeInt) a -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros


-- Methods of Fractional & Floating
-- --------------------------------

evalFDiv :: FloatingType a -> (a,a) :-> a
evalFDiv :: FloatingType a -> (a, a) :-> a
evalFDiv FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = FloatingType a -> (a, a) :-> a
forall a. (Fractional a, Eq a) => FloatingType a -> (a, a) :-> a
evalFDiv' FloatingType a
ty

evalFDiv' :: (Fractional a, Eq a) => FloatingType a -> (a,a) :-> a
evalFDiv' :: FloatingType a -> (a, a) :-> a
evalFDiv' FloatingType a
_ (OpenExp env aenv (a, a)
-> Maybe (OpenExp env aenv a, OpenExp env aenv a)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv a
x,OpenExp env aenv a
y)) Gamma env env aenv
env
  | Just a
1      <- Gamma env env aenv -> OpenExp env aenv a -> Maybe a
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv a
y
  = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"x/1" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

evalFDiv' FloatingType a
ty OpenExp env aenv (a, a)
arg Gamma env env aenv
env
  = SingleType a
-> (a -> a -> a)
-> OpenExp env aenv (a, a)
-> Gamma env env aenv
-> Maybe (OpenExp env aenv a)
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a -> a
forall a. Fractional a => a -> a -> a
(/) OpenExp env aenv (a, a)
arg Gamma env env aenv
env


evalRecip :: FloatingType a -> a :-> a
evalRecip :: FloatingType a -> a :-> a
evalRecip FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Fractional a => a -> a
recip

evalSin :: FloatingType a -> a :-> a
evalSin :: FloatingType a -> a :-> a
evalSin FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
sin

evalCos :: FloatingType a -> a :-> a
evalCos :: FloatingType a -> a :-> a
evalCos FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
cos

evalTan :: FloatingType a -> a :-> a
evalTan :: FloatingType a -> a :-> a
evalTan FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
tan

evalAsin :: FloatingType a -> a :-> a
evalAsin :: FloatingType a -> a :-> a
evalAsin FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
asin

evalAcos :: FloatingType a -> a :-> a
evalAcos :: FloatingType a -> a :-> a
evalAcos FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
acos

evalAtan :: FloatingType a -> a :-> a
evalAtan :: FloatingType a -> a :-> a
evalAtan FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
atan

evalSinh :: FloatingType a -> a :-> a
evalSinh :: FloatingType a -> a :-> a
evalSinh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
sinh

evalCosh :: FloatingType a -> a :-> a
evalCosh :: FloatingType a -> a :-> a
evalCosh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
cosh

evalTanh :: FloatingType a -> a :-> a
evalTanh :: FloatingType a -> a :-> a
evalTanh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
tanh

evalAsinh :: FloatingType a -> a :-> a
evalAsinh :: FloatingType a -> a :-> a
evalAsinh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
asinh

evalAcosh :: FloatingType a -> a :-> a
evalAcosh :: FloatingType a -> a :-> a
evalAcosh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
acosh

evalAtanh :: FloatingType a -> a :-> a
evalAtanh :: FloatingType a -> a :-> a
evalAtanh FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
atanh

evalExpFloating :: FloatingType a -> a :-> a
evalExpFloating :: FloatingType a -> a :-> a
evalExpFloating FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
P.exp

evalSqrt :: FloatingType a -> a :-> a
evalSqrt :: FloatingType a -> a :-> a
evalSqrt FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
sqrt

evalLog :: FloatingType a -> a :-> a
evalLog :: FloatingType a -> a :-> a
evalLog FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a) -> a :-> a
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a
forall a. Floating a => a -> a
log

evalFPow :: FloatingType a -> (a,a) :-> a
evalFPow :: FloatingType a -> (a, a) :-> a
evalFPow FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a -> a
forall a. Floating a => a -> a -> a
(**)

evalLogBase :: FloatingType a -> (a,a) :-> a
evalLogBase :: FloatingType a -> (a, a) :-> a
evalLogBase FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a -> a
forall a. Floating a => a -> a -> a
logBase

evalAtan2 :: FloatingType a -> (a,a) :-> a
evalAtan2 :: FloatingType a -> (a, a) :-> a
evalAtan2 FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 (NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType (NumType a -> SingleType a) -> NumType a -> SingleType a
forall a b. (a -> b) -> a -> b
$ FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType a
ty) a -> a -> a
forall a. RealFloat a => a -> a -> a
atan2

evalTruncate :: FloatingType a -> IntegralType b -> a :-> b
evalTruncate :: FloatingType a -> IntegralType b -> a :-> b
evalTruncate FloatingType a
ta IntegralType b
tb
  | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ta
  , IntegralDict b
IntegralDict <- IntegralType b -> IntegralDict b
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType b
tb
  = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ IntegralType b -> NumType b
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType b
tb) a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate

evalRound :: FloatingType a -> IntegralType b -> a :-> b
evalRound :: FloatingType a -> IntegralType b -> a :-> b
evalRound FloatingType a
ta IntegralType b
tb
  | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ta
  , IntegralDict b
IntegralDict <- IntegralType b -> IntegralDict b
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType b
tb
  = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ IntegralType b -> NumType b
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType b
tb) a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round

evalFloor :: FloatingType a -> IntegralType b -> a :-> b
evalFloor :: FloatingType a -> IntegralType b -> a :-> b
evalFloor FloatingType a
ta IntegralType b
tb
  | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ta
  , IntegralDict b
IntegralDict <- IntegralType b -> IntegralDict b
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType b
tb
  = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ IntegralType b -> NumType b
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType b
tb) a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor

evalCeiling :: FloatingType a -> IntegralType b -> a :-> b
evalCeiling :: FloatingType a -> IntegralType b -> a :-> b
evalCeiling FloatingType a
ta IntegralType b
tb
  | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ta
  , IntegralDict b
IntegralDict <- IntegralType b -> IntegralDict b
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType b
tb
  = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ IntegralType b -> NumType b
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType b
tb) a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling

evalIsNaN :: FloatingType a -> a :-> PrimBool
evalIsNaN :: FloatingType a -> a :-> PrimBool
evalIsNaN FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> Bool) -> a :-> PrimBool
forall a. (a -> Bool) -> a :-> PrimBool
bool1 a -> Bool
forall a. RealFloat a => a -> Bool
isNaN

evalIsInfinite :: FloatingType a -> a :-> PrimBool
evalIsInfinite :: FloatingType a -> a :-> PrimBool
evalIsInfinite FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> Bool) -> a :-> PrimBool
forall a. (a -> Bool) -> a :-> PrimBool
bool1 a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite


-- Relational & Equality
-- ---------------------

evalLt :: SingleType a -> (a,a) :-> PrimBool
evalLt :: SingleType a -> (a, a) :-> PrimBool
evalLt (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
evalLt (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

evalGt :: SingleType a -> (a,a) :-> PrimBool
evalGt :: SingleType a -> (a, a) :-> PrimBool
evalGt (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
evalGt (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)

evalLtEq :: SingleType a -> (a,a) :-> PrimBool
evalLtEq :: SingleType a -> (a, a) :-> PrimBool
evalLtEq (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
evalLtEq (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

evalGtEq :: SingleType a -> (a,a) :-> PrimBool
evalGtEq :: SingleType a -> (a, a) :-> PrimBool
evalGtEq (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
evalGtEq (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>=)

evalEq :: SingleType a -> (a,a) :-> PrimBool
evalEq :: SingleType a -> (a, a) :-> PrimBool
evalEq (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
evalEq (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

evalNEq :: SingleType a -> (a,a) :-> PrimBool
evalNEq :: SingleType a -> (a, a) :-> PrimBool
evalNEq (NumSingleType (IntegralNumType IntegralType a
ty)) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
evalNEq (NumSingleType (FloatingNumType FloatingType a
ty)) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = (a -> a -> Bool) -> (a, a) :-> PrimBool
forall a b. (a -> b -> Bool) -> (a, b) :-> PrimBool
bool2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

evalMax :: SingleType a -> (a,a) :-> a
evalMax :: SingleType a -> (a, a) :-> a
evalMax ty :: SingleType a
ty@(NumSingleType (IntegralNumType IntegralType a
ty')) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty' = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 SingleType a
ty a -> a -> a
forall a. Ord a => a -> a -> a
max
evalMax ty :: SingleType a
ty@(NumSingleType (FloatingNumType FloatingType a
ty')) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty' = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 SingleType a
ty a -> a -> a
forall a. Ord a => a -> a -> a
max

evalMin :: SingleType a -> (a,a) :-> a
evalMin :: SingleType a -> (a, a) :-> a
evalMin ty :: SingleType a
ty@(NumSingleType (IntegralNumType IntegralType a
ty')) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty' = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 SingleType a
ty a -> a -> a
forall a. Ord a => a -> a -> a
min
evalMin ty :: SingleType a
ty@(NumSingleType (FloatingNumType FloatingType a
ty')) | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty' = SingleType a -> (a -> a -> a) -> (a, a) :-> a
forall c a b. SingleType c -> (a -> b -> c) -> (a, b) :-> c
eval2 SingleType a
ty a -> a -> a
forall a. Ord a => a -> a -> a
min

-- Logical operators
-- -----------------

evalLAnd :: (PrimBool,PrimBool) :-> PrimBool
evalLAnd :: OpenExp env aenv (PrimBool, PrimBool)
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
evalLAnd (OpenExp env aenv (PrimBool, PrimBool)
-> Maybe (OpenExp env aenv PrimBool, OpenExp env aenv PrimBool)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv PrimBool
x,OpenExp env aenv PrimBool
y)) Gamma env env aenv
env
  | Just PrimBool
a      <- Gamma env env aenv -> OpenExp env aenv PrimBool -> Maybe PrimBool
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv PrimBool
x
  = OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just
  (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ if PrimBool -> Bool
toBool PrimBool
a then Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"True &&" OpenExp env aenv PrimBool
y
                else Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"False &&" (OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool)
-> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 PrimBool
0

  | Just PrimBool
b      <- Gamma env env aenv -> OpenExp env aenv PrimBool -> Maybe PrimBool
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv PrimBool
y
  = OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just
  (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ if PrimBool -> Bool
toBool PrimBool
b then Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"True &&" OpenExp env aenv PrimBool
x
                else Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"False &&" (OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool)
-> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 PrimBool
0

evalLAnd OpenExp env aenv (PrimBool, PrimBool)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv PrimBool)
forall a. Maybe a
Nothing

evalLOr  :: (PrimBool,PrimBool) :-> PrimBool
evalLOr :: OpenExp env aenv (PrimBool, PrimBool)
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
evalLOr (OpenExp env aenv (PrimBool, PrimBool)
-> Maybe (OpenExp env aenv PrimBool, OpenExp env aenv PrimBool)
forall env aenv a b.
OpenExp env aenv (a, b)
-> Maybe (OpenExp env aenv a, OpenExp env aenv b)
untup2 -> Just (OpenExp env aenv PrimBool
x,OpenExp env aenv PrimBool
y)) Gamma env env aenv
env
  | Just PrimBool
a      <- Gamma env env aenv -> OpenExp env aenv PrimBool -> Maybe PrimBool
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv PrimBool
x
  = OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just
  (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ if PrimBool -> Bool
toBool PrimBool
a then Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"True ||" (OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool)
-> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 PrimBool
1
                else Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"False ||" OpenExp env aenv PrimBool
y

  | Just PrimBool
b      <- Gamma env env aenv -> OpenExp env aenv PrimBool -> Maybe PrimBool
forall env aenv exp.
Gamma env env aenv -> OpenExp env aenv exp -> Maybe exp
propagate Gamma env env aenv
env OpenExp env aenv PrimBool
y
  = OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a. a -> Maybe a
Just
  (OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool))
-> OpenExp env aenv PrimBool -> Maybe (OpenExp env aenv PrimBool)
forall a b. (a -> b) -> a -> b
$ if PrimBool -> Bool
toBool PrimBool
b then Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"True ||" (OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool)
-> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a b. (a -> b) -> a -> b
$ ScalarType PrimBool -> PrimBool -> OpenExp env aenv PrimBool
forall t env aenv. ScalarType t -> t -> OpenExp env aenv t
Const ScalarType PrimBool
scalarTypeWord8 PrimBool
1
                else Text -> OpenExp env aenv PrimBool -> OpenExp env aenv PrimBool
forall a. Text -> a -> a
Stats.ruleFired Text
"False ||" OpenExp env aenv PrimBool
x

evalLOr OpenExp env aenv (PrimBool, PrimBool)
_ Gamma env env aenv
_
  = Maybe (OpenExp env aenv PrimBool)
forall a. Maybe a
Nothing

evalLNot :: PrimBool :-> PrimBool
evalLNot :: OpenExp env aenv PrimBool
-> Gamma env env aenv -> Maybe (OpenExp env aenv PrimBool)
evalLNot OpenExp env aenv PrimBool
x Gamma env env aenv
_   | PrimApp PrimFun (a -> PrimBool)
PrimLNot OpenExp env aenv a
x' <- OpenExp env aenv PrimBool
x = Text -> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a. Text -> a -> a
Stats.ruleFired Text
"not/not" (Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a))
-> Maybe (OpenExp env aenv a) -> Maybe (OpenExp env aenv a)
forall a b. (a -> b) -> a -> b
$ OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x'
evalLNot OpenExp env aenv PrimBool
x Gamma env env aenv
env                            = (PrimBool -> Bool)
-> OpenExp env aenv PrimBool
-> Gamma env env aenv
-> Maybe (OpenExp env aenv PrimBool)
forall a. (a -> Bool) -> a :-> PrimBool
bool1 (Bool -> Bool
not (Bool -> Bool) -> (PrimBool -> Bool) -> PrimBool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimBool -> Bool
toBool) OpenExp env aenv PrimBool
x Gamma env env aenv
env

evalFromIntegral :: IntegralType a -> NumType b -> a :-> b
evalFromIntegral :: IntegralType a -> NumType b -> a :-> b
evalFromIntegral IntegralType a
ta (IntegralNumType IntegralType b
tb)
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ta
  , IntegralDict b
IntegralDict <- IntegralType b -> IntegralDict b
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType b
tb = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ IntegralType b -> NumType b
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType b
tb) a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

evalFromIntegral IntegralType a
ta (FloatingNumType FloatingType b
tb)
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ta
  , FloatingDict b
FloatingDict <- FloatingType b -> FloatingDict b
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType b
tb = SingleType b -> (a -> b) -> a :-> b
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ FloatingType b -> NumType b
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType b
tb) a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

evalToFloating :: NumType a -> FloatingType b -> a :-> b
evalToFloating :: NumType a -> FloatingType b -> a :-> b
evalToFloating (IntegralNumType IntegralType a
ta) FloatingType b
tb OpenExp env aenv a
x Gamma env env aenv
env
  | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ta
  , FloatingDict b
FloatingDict <- FloatingType b -> FloatingDict b
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType b
tb = SingleType b
-> (a -> b)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ FloatingType b -> NumType b
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType b
tb) a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac OpenExp env aenv a
x Gamma env env aenv
env

evalToFloating (FloatingNumType FloatingType a
ta) FloatingType b
tb OpenExp env aenv a
x Gamma env env aenv
env
  | FloatingType a
TypeHalf   <- FloatingType a
ta
  , FloatingType b
TypeHalf   <- FloatingType b
tb = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

  | FloatingType a
TypeFloat  <- FloatingType a
ta
  , FloatingType b
TypeFloat  <- FloatingType b
tb = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

  | FloatingType a
TypeDouble <- FloatingType a
ta
  , FloatingType b
TypeDouble <- FloatingType b
tb = OpenExp env aenv a -> Maybe (OpenExp env aenv a)
forall a. a -> Maybe a
Just OpenExp env aenv a
x

  | FloatingType a
TypeFloat  <- FloatingType a
ta
  , FloatingType b
TypeDouble <- FloatingType b
tb = SingleType b
-> (Float -> b)
-> OpenExp env aenv Float
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ FloatingType b -> NumType b
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType b
tb) Float -> b
Float -> Double
float2Double OpenExp env aenv a
OpenExp env aenv Float
x Gamma env env aenv
env

  | FloatingType a
TypeDouble <- FloatingType a
ta
  , FloatingType b
TypeFloat  <- FloatingType b
tb = SingleType b
-> (Double -> b)
-> OpenExp env aenv Double
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ FloatingType b -> NumType b
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType b
tb) Double -> b
Double -> Float
double2Float OpenExp env aenv a
OpenExp env aenv Double
x Gamma env env aenv
env

  | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ta
  , FloatingDict b
FloatingDict <- FloatingType b -> FloatingDict b
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType b
tb = SingleType b
-> (a -> b)
-> OpenExp env aenv a
-> Gamma env env aenv
-> Maybe (OpenExp env aenv b)
forall b a. SingleType b -> (a -> b) -> a :-> b
eval1 (NumType b -> SingleType b
forall a. NumType a -> SingleType a
NumSingleType (NumType b -> SingleType b) -> NumType b -> SingleType b
forall a b. (a -> b) -> a -> b
$ FloatingType b -> NumType b
forall a. FloatingType a -> NumType a
FloatingNumType FloatingType b
tb) a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac OpenExp env aenv a
x Gamma env env aenv
env


-- Scalar primitives
-- -----------------

evalPrimConst :: PrimConst a -> a
evalPrimConst :: PrimConst a -> a
evalPrimConst (PrimMinBound BoundedType a
ty) = BoundedType a -> a
forall a. BoundedType a -> a
evalMinBound BoundedType a
ty
evalPrimConst (PrimMaxBound BoundedType a
ty) = BoundedType a -> a
forall a. BoundedType a -> a
evalMaxBound BoundedType a
ty
evalPrimConst (PrimPi       FloatingType a
ty) = FloatingType a -> a
forall a. FloatingType a -> a
evalPi FloatingType a
ty

evalMinBound :: BoundedType a -> a
evalMinBound :: BoundedType a -> a
evalMinBound (IntegralBoundedType IntegralType a
ty) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = a
forall a. Bounded a => a
minBound

evalMaxBound :: BoundedType a -> a
evalMaxBound :: BoundedType a -> a
evalMaxBound (IntegralBoundedType IntegralType a
ty) | IntegralDict a
IntegralDict <- IntegralType a -> IntegralDict a
forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
ty = a
forall a. Bounded a => a
maxBound

evalPi :: FloatingType a -> a
evalPi :: FloatingType a -> a
evalPi FloatingType a
ty | FloatingDict a
FloatingDict <- FloatingType a -> FloatingDict a
forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
ty = a
forall a. Floating a => a
pi