{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Synthesizer.LLVM.Value (
   T, decons,
   tau, square, sqrt,
   max, min, limit, fraction,

   (%==), (%/=), (%<), (%<=), (%>), (%>=), not,
   (%&&), (%||),
   (?), (??),

   lift0, lift1, lift2, lift3,
   unlift0, unlift1, unlift2, unlift3, unlift4, unlift5,
   constantValue, constant,
   fromInteger', fromRational',

   Flatten(flattenCode, unfoldCode), Registers,
   flatten, unfold,
   flattenCodeTraversable, unfoldCodeTraversable,
   flattenFunction,
   ) where

import LLVM.DSL.Value

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo ()
import qualified Synthesizer.Basic.Phase as Phase

import qualified Algebra.RealRing as RealRing

import qualified Prelude as P ()
import NumericPrelude.Base hiding (min, max, unzip, unzip3, not)


instance (RealRing.C a, Flatten a) => Flatten (Phase.T a) where
   type Registers (Phase.T a) = Registers a
   flattenCode :: forall r. T a -> Compute r (Registers (T a))
flattenCode T a
s = a -> Compute r (Registers a)
forall r. a -> Compute r (Registers a)
forall value r.
Flatten value =>
value -> Compute r (Registers value)
flattenCode (a -> Compute r (Registers a)) -> a -> Compute r (Registers a)
forall a b. (a -> b) -> a -> b
$ T a -> a
forall a. T a -> a
Phase.toRepresentative T a
s
   unfoldCode :: T (Registers (T a)) -> T a
unfoldCode T (Registers (T a))
s =
      -- could also be unsafeFromRepresentative
      a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative (a -> T a) -> a -> T a
forall a b. (a -> b) -> a -> b
$ T (Registers a) -> a
forall value. Flatten value => T (Registers value) -> value
unfoldCode T (Registers a)
T (Registers (T a))
s