gluon 0.13.1

A static, type inferred programming language for application embedding
Documentation
//! Implementation of the `st.State` effect

let { Eff, inject_rest, ? } = import! std.effect
let { map } = import! std.functor
let { wrap } = import! std.applicative
let { (<<) } = import! std.function
let { Reference, ref, (<-), load } = import! std.reference

type STRef s a = { __ref : Reference a }

/// The `State` effect enables the use of mutable state. By branding the state with `s` the mutable
/// values are prevented from escaping the monad.
type State s r a =
    | New : forall b . b -> State s r (STRef s b)
    | Read : STRef s a -> State s r a
    | Write : forall b . b -> STRef s b -> State s r ()
    | Call : forall b . (() -> b) -> State s r b
    .. r

#[inline(never)]
let extract_state x : forall s . [| st : State s | r |] a -> State s r a = convert_variant! x

#[inline(never)]
let send_state f : forall s . State s r a -> Eff [| st : State s | r |] a = Impure (convert_effect! st f) Pure

/// Creates a new mutable reference that contains `a`.
let new_ref a : forall s . a -> Eff [| st : State s | r |] (STRef s a) = send_state (New a)

let make_call = Call

/// Reads the values stored in the reference.
let read_ref ref : forall s . STRef s a -> Eff [| st : State s | r |]  a =  send_state (Read ref)

/// Writes a new value into the reference.
let write_ref a ref : forall s . a -> STRef s a -> Eff [| st : State s | r |] () = send_state (Write a ref)

/// Eliminates the `State` effect
let run_state eff : (forall s . Eff [| st : State s | r |] a) -> Eff [| | r |] a =
    let loop ve : forall s . Eff [| st : State s | r |] a -> Eff [| | r |] a =
        match ve with
        | Pure value -> wrap value
        | Impure e f ->
            match extract_state e with 
            | New a ->
                loop (f { __ref = ref a })
            | Read r ->
                let a = load r.__ref
                loop (f a)
            | Write a r ->
                r.__ref <- a
                loop (f ())
            | Call g ->
                loop (f (g ()))
            | rest ->
                Impure (inject_rest rest) (loop << f)
    loop eff


{
    State,
    
    send_state,

    new_ref,
    read_ref,
    write_ref,
    run_state,
    make_call,
}