{-# OPTIONS_GHC -cpp -XMagicHash #-} {- For Hugs, use the option -F"cpp -P -traditional" -} module LinearScan.Lens where import Debug.Trace (trace, traceShow) import qualified Prelude import qualified Data.IntMap import qualified Data.IntSet import qualified Data.List import qualified Data.Ord import qualified Data.Functor.Identity import qualified LinearScan.Utils import qualified LinearScan.Monad as Monad #ifdef __GLASGOW_HASKELL__ import qualified GHC.Base as GHC.Base import qualified GHC.Prim as GHC.Prim #else -- HUGS import qualified LinearScan.IOExts as IOExts #endif #ifdef __GLASGOW_HASKELL__ --unsafeCoerce :: a -> b unsafeCoerce = GHC.Base.unsafeCoerce# #else -- HUGS --unsafeCoerce :: a -> b unsafeCoerce = IOExts.unsafeCoerce #endif #ifdef __GLASGOW_HASKELL__ type Any = GHC.Prim.Any #else -- HUGS type Any = () #endif __ :: any __ = Prelude.error "Logical or arity value used" type Identity a = a coq_Identity_Functor :: Monad.Functor (Identity Any) coq_Identity_Functor _ _ x = x type Const c a = c coq_Const_Functor :: Monad.Functor (Const a1 Any) coq_Const_Functor _ _ x x0 = x0 type Lens s t a b = () -> (Monad.Functor Any) -> (a -> Any) -> s -> Any type Lens' s a = Lens s s a a set :: (Lens a1 a2 a3 a4) -> a4 -> a1 -> a2 set l x = unsafeCoerce l __ coq_Identity_Functor (\x0 -> x) view :: (Lens' a1 a2) -> a1 -> a2 view f = unsafeCoerce f __ coq_Const_Functor (\x -> x)