{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Synthesizer.LLVM.Frame.Binary (
   toCanonical,
   ) where

import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Core as LLVM

import qualified Algebra.ToInteger as ToInteger
import NumericPrelude.Numeric
import NumericPrelude.Base

import Prelude ()



toCanonical ::
   (LLVM.ShapeOf real ~ LLVM.ShapeOf int,
    LLVM.IsFloating real, SoV.IntegerConstant real,
    LLVM.IsInteger int, Bounded int, ToInteger.C int) =>
   LLVM.Value int -> LLVM.CodeGenFunction r (LLVM.Value real)
toCanonical :: forall real int r.
(ShapeOf real ~ ShapeOf int, IsFloating real, IntegerConstant real,
 IsInteger int, Bounded int, C int) =>
Value int -> CodeGenFunction r (Value real)
toCanonical Value int
i = do
   Value real
numer <- Value int -> CodeGenFunction r (Value real)
forall (value :: * -> *) a b r.
(ValueCons value, IsInteger a, IsFloating b,
 ShapeOf a ~ ShapeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.inttofp Value int
i
   Value real -> Value real -> CodeGenFunction r (Value real)
forall a r. Field a => a -> a -> CodeGenFunction r a
forall r.
Value real -> Value real -> CodeGenFunction r (Value real)
A.fdiv Value real
numer (Integer -> Value real
forall a. IntegerConstant a => Integer -> a
A.fromInteger' (int -> Integer
forall a. C a => a -> Integer
toInteger (Value int -> int
forall i. Bounded i => Value i -> i
maxBoundOf Value int
i)))

maxBoundOf :: (Bounded i) => LLVM.Value i -> i
maxBoundOf :: forall i. Bounded i => Value i -> i
maxBoundOf Value i
_ = i
forall a. Bounded a => a
maxBound