{-# OPTIONS_GHC -cpp -XMagicHash #-} {- For Hugs, use the option -F"cpp -P -traditional" -} module LinearScan.Lens where import Debug.Trace (trace, traceShow, traceShowId) 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 Hask.Utils import qualified LinearScan.Applicative as Applicative import qualified LinearScan.Const as Const import qualified LinearScan.Contravariant as Contravariant import qualified LinearScan.Functor as Functor import qualified LinearScan.Identity as Identity import qualified LinearScan.Monad as Monad import qualified LinearScan.Prelude0 as Prelude0 import qualified LinearScan.State0 as State0 #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 Lens s t a b = () -> (Functor.Functor Any) -> (a -> Any) -> s -> Any type Lens' s a = Lens s s a a type Getter s a = () -> (Functor.Functor Any) -> (Contravariant.Contravariant Any) -> (a -> Any) -> s -> Any type Getting r s a = (a -> Const.Const r a) -> s -> Const.Const r s set :: (Lens a1 a2 a3 a4) -> a4 -> a1 -> a2 set l x = unsafeCoerce l __ Identity.coq_Identity_Functor (Prelude0.const x) over :: (Lens a1 a2 a3 a4) -> (a3 -> a4) -> a1 -> a2 over l x = unsafeCoerce l __ Identity.coq_Identity_Functor x view :: (Getting a1 a2 a1) -> a2 -> a1 view f = f (\x -> x) stepdownl' :: (Lens' a1 a2) -> Getting a2 a1 a2 stepdownl' l = unsafeCoerce l __ Const.coq_Const_Functor stepdowng :: (Getter a1 a2) -> Getting a2 a1 a2 stepdowng l = unsafeCoerce l __ Const.coq_Const_Functor Const.coq_Const_Contravariant _1 :: (Functor.Functor a3) -> (a1 -> a3) -> ((,) a1 a2) -> a3 _1 h f s = case s of { (,) x y -> Functor.fmap h (\z -> (,) z y) (f x)} _2 :: (Functor.Functor a3) -> (a2 -> a3) -> ((,) a1 a2) -> a3 _2 h f s = case s of { (,) x y -> Functor.fmap h (\z -> (,) x z) (f y)} use :: (Getting a1 a2 a1) -> (Monad.Monad a3) -> State0.StateT a2 a3 a1 use l h = Functor.fmap (State0.coq_StateT_Functor (Applicative.is_functor (Monad.is_applicative h))) (view l) (State0.getT (Monad.is_applicative h)) plusStateT :: (Lens' a1 Prelude.Int) -> Prelude.Int -> (Monad.Monad a2) -> State0.StateT a1 a2 () plusStateT l n h = State0.modifyT (Monad.is_applicative h) (over l ((Prelude.+) n)) modifyStateT :: (Lens' a1 a2) -> a2 -> (Monad.Monad a3) -> State0.StateT a1 a3 () modifyStateT l x h = State0.modifyT (Monad.is_applicative h) (set l x) applyStateT :: (Lens' a1 a2) -> (a2 -> a2) -> (Monad.Monad a3) -> State0.StateT a1 a3 () applyStateT l f h = State0.modifyT (Monad.is_applicative h) (over l f)