{-|
  Copyright   :  (C) 2013-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017-2022, Google Inc.,
                     2017-2026, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
-}

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedTuples #-}

module Clash.GHC.Evaluator.Primitives.GHC.Float
  ( primitives
  ) where

import           Data.Proxy          (Proxy)
import           Data.Reflection     (reifyNat)
import           Data.Text           (Text)
import           Data.Text.Extra     (showt)
import           GHC.Float
import           GHC.Real            (Ratio (..))
import           GHC.TypeLits        (KnownNat)
import           Data.Bifunctor      (first)

import           Clash.Core.Evaluator.Types
import           Clash.Core.Literal  (Literal (..))
import Clash.Core.Name (Name (..))
import Clash.Core.Term (Term (..), mkApps)
import Clash.Core.Type (Type (..), LitTy (..), TypeView (..), splitFunForallTy, tyView)
import Clash.Core.TyCon (tyConDataCons)
import qualified Clash.Data.UniqMap as UniqMap
import Clash.Util (curLoc, textNameLit)

import Clash.Sized.Internal.Signed   (Signed   (..))

import Clash.GHC.Evaluator.Primitive.Util

primitives :: [(Text, PrimStep)]
primitives :: [(Text, PrimStep)]
primitives =
  -- GHC.Float.asinh  -- XXX: Very fragile
  --  $w$casinh is the Double specialisation of asinh
  --  $w$casinh1 is the Float specialisation of asinh
  [ Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry Text
"GHC.Float.$w$casinh" ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
..} | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
go [Value]
args
        -> Term -> Maybe Machine
reduce Term
r
        where go :: Double# -> Double#
go Double#
f = case Double -> Double
forall a. Floating a => a -> a
asinh (Double# -> Double
D# Double#
f) of
                       D# Double#
f' -> Double#
f'
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry Text
"GHC.Float.$w$casinh1" ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..} | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
go [Value]
args
        -> Term -> Maybe Machine
reduce Term
r
        where go :: Float# -> Float#
go Float#
f = case Float -> Float
forall a. Floating a => a -> a
asinh (Float# -> Float
F# Float#
f) of
                       F# Float#
f' -> Float#
f'
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry $(textNameLit 'GHC.Float.integerToFloat#) ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..}
        | [Value
v] <- [Value]
args
        , Just Integer
i <- Value -> Maybe Integer
integerLiteral Value
v
        -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Float -> Term) -> Float -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Float -> Literal) -> Float -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Literal
FloatLiteral (Word32 -> Literal) -> (Float -> Word32) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
castFloatToWord32 (Float -> Maybe Machine) -> Float -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# (Integer -> Float#
integerToFloat# Integer
i)
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry $(textNameLit 'GHC.Float.integerToDouble#) ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..}
        | [Value
v] <- [Value]
args
        , Just Integer
i <- Value -> Maybe Integer
integerLiteral Value
v
        -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Literal
DoubleLiteral (Word64 -> Literal) -> (Double -> Word64) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
castDoubleToWord64 (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# (Integer -> Double#
integerToDouble# Integer
i)
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry Text
"GHC.Float.$w$sfromRat''" ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..} -- XXX: Very fragile
        | [Lit (IntLiteral Integer
_minEx)
          ,Lit (IntLiteral Integer
matDigs)
          ,Value
nV
          ,Value
dV] <- [Value]
args
        , [Integer
n,Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
        -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
              Int
matDigs'
                | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Int
forall a. RealFloat a => a -> Int
floatDigits (Float
forall a. HasCallStack => a
undefined :: Float)
                -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Word32 -> Literal
FloatLiteral (Float -> Word32
castFloatToWord32 (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
                | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Int
forall a. RealFloat a => a -> Int
floatDigits (Double
forall a. HasCallStack => a
undefined :: Double)
                -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Word64 -> Literal
DoubleLiteral (Double -> Word64
castDoubleToWord64 (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
              Int
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Machine) -> [Char] -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"GHC.Float.$w$sfromRat'': Not a Float or Double"
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry Text
"GHC.Float.$w$sfromRat''1" ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..} -- XXX: Very fragile
        | [Lit (IntLiteral Integer
_minEx)
          ,Lit (IntLiteral Integer
matDigs)
          ,Value
nV
          ,Value
dV] <- [Value]
args
        , [Integer
n,Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
        -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
              Int
matDigs'
                | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Int
forall a. RealFloat a => a -> Int
floatDigits (Float
forall a. HasCallStack => a
undefined :: Float)
                -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Word32 -> Literal
FloatLiteral (Float -> Word32
castFloatToWord32 (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
                | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Int
forall a. RealFloat a => a -> Int
floatDigits (Double
forall a. HasCallStack => a
undefined :: Double)
                -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Word64 -> Literal
DoubleLiteral (Double -> Word64
castDoubleToWord64 (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
              Int
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Machine) -> [Char] -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"GHC.Float.$w$sfromRat'': Not a Float or Double"
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  , Text -> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
primStepEntry Text
"GHC.Float.$wproperFractionDouble" ((PrimStepContext -> Maybe Machine) -> (Text, PrimStep))
-> (PrimStepContext -> Maybe Machine) -> (Text, PrimStep)
forall a b. (a -> b) -> a -> b
$ \case
      PrimStepContext{Bool
[Type]
[Value]
Type
TyConMap
Machine
PrimInfo
Term -> Maybe Machine
Term -> Term
Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
Type -> Integer -> (Natural -> Natural) -> Term
Type -> [Integer] -> ([Natural] -> Term) -> Term
Machine -> Term -> Maybe Machine
tcm :: PrimStepContext -> TyConMap
isSubj :: PrimStepContext -> Bool
pInfo :: PrimStepContext -> PrimInfo
tys :: PrimStepContext -> [Type]
args :: PrimStepContext -> [Value]
mach :: PrimStepContext -> Machine
ty :: PrimStepContext -> Type
checkNaturalRange1 :: PrimStepContext -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: PrimStepContext
-> Type
-> Integer
-> Integer
-> (Natural -> Natural -> Natural)
-> Term
checkNaturalRange :: PrimStepContext -> Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: PrimStepContext -> Term -> Maybe Machine
reduceWith :: PrimStepContext -> Machine -> Term -> Maybe Machine
reduceWHNF :: PrimStepContext -> Term -> Maybe Machine
reduceWHNF' :: PrimStepContext -> Machine -> Term -> Maybe Machine
catchDivByZero :: PrimStepContext -> Term -> Term
catchErrorCall :: PrimStepContext -> Term -> Term
tcm :: TyConMap
isSubj :: Bool
pInfo :: PrimInfo
tys :: [Type]
args :: [Value]
mach :: Machine
ty :: Type
checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
reduce :: Term -> Maybe Machine
reduceWith :: Machine -> Term -> Maybe Machine
reduceWHNF :: Term -> Maybe Machine
reduceWHNF' :: Machine -> Term -> Maybe Machine
catchDivByZero :: Term -> Term
catchErrorCall :: Term -> Term
..}
        | Value
_ : Lit (DoubleLiteral Word64
d) : [Value]
_ <- [Value]
args
        , [sty :: Type
sty@(Type -> TypeView
tyView -> TyConApp TyConName
signedTcNm [nTy :: Type
nTy@(LitTy (NumTy Integer
kn))])] <- [Type]
tys
        , TyConName -> Text
forall a. Name a -> Text
nameOcc TyConName
signedTcNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
forall a. Show a => a -> Text
showt ''Signed
        , ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
        , Just TyCon
tupTc <- TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
        , [DataCon
tupDc] <- TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
        -> let (Integer
sn, Double
d1) = Integer
-> (forall (n :: Natural).
    KnownNat n =>
    Proxy n -> (Integer, Double))
-> (Integer, Double)
forall r.
Integer -> (forall (n :: Natural). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (\Proxy n
p -> (Signed n -> Integer) -> (Signed n, Double) -> (Integer, Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Proxy n -> Double -> (Signed n, Double)
forall (n :: Natural).
KnownNat n =>
Proxy n -> Double -> (Signed n, Double)
op Proxy n
p (Word64 -> Double
castWord64ToDouble Word64
d)))
               ret :: Term
ret = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
sty Type
nTy Integer
kn Integer
sn)
                      , Term -> Either Term Type
forall a b. a -> Either a b
Left (TyConMap -> Word64 -> Type -> Term
mkDoubleCLit TyConMap
tcm (Double -> Word64
castDoubleToWord64 Double
d1) ([Type] -> Type
forall a. HasCallStack => [a] -> a
last [Type]
tyArgs))
                      ])
            in Term -> Maybe Machine
reduce Term
ret
        where
          op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
          op :: forall (n :: Natural).
KnownNat n =>
Proxy n -> Double -> (Signed n, Double)
op Proxy n
_ = Double -> (Signed n, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction
      PrimStepContext
_ -> Maybe Machine
forall a. Maybe a
Nothing

  ]