feat: Add a mutable string type to the ST monad

This can be used to efficiently construct strings

codegen/src/trace.rs

@@ -95,7 +95,7 @@ fn derive_enum(
 
         cons = quote! {
 
-            match self {
+            match *self {
                 #(#variants,)*
             }
         };
@@ -174,8 +174,8 @@ fn gen_variant_match(ident: &Ident, variant: &Variant) -> TokenStream {
     let variant_ident = &variant.ident;
 
     let pattern = match &variant.fields {
-        Fields::Named(_) => quote! { #ident::#variant_ident{ #(#field_idents2),* } },
-        Fields::Unnamed(_) => quote! { #ident::#variant_ident( #(#field_idents2),* ) },
+        Fields::Named(_) => quote! { #ident::#variant_ident{ #(ref #field_idents2),* } },
+        Fields::Unnamed(_) => quote! { #ident::#variant_ident( #(ref #field_idents2),* ) },
         Fields::Unit => quote! { #ident::#variant_ident },
     };
 

codegen/src/userdata.rs

@@ -26,7 +26,7 @@ pub fn derive(input: TokenStream) -> TokenStream {
 
 fn gen_impl(container: &Container, ident: Ident, generics: Generics) -> TokenStream {
     let trait_bounds = &map_type_params(&generics, |ty| {
-        quote! { #ty: 'static + ::std::fmt::Debug + Sync + Send }
+        quote! { #ty: 'static + ::std::fmt::Debug + _gluon_gc::Trace + Sync + Send }
     });
 
     let lifetime_bounds = &map_lifetimes(&generics, |lifetime| quote! { #lifetime: 'static });

src/lib.rs

@@ -882,6 +882,12 @@ impl VmBuilder {
         add_extern_module(&vm, "std.process.prim", crate::std_lib::process::load);
         add_extern_module(&vm, "std.env.prim", crate::std_lib::env::load);
 
+        add_extern_module(
+            &vm,
+            "std.effect.st.string.prim",
+            crate::vm::primitives::load_string_buf,
+        );
+
         add_extern_module_if!(
             #[cfg(feature = "serialization")],
             available_if = "gluon is compiled with the 'serialization' feature",

std/effect/st.glu

@@ -14,6 +14,7 @@ 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)]
@@ -25,6 +26,8 @@ let send_state f : forall s . State s r a -> Eff [| st : State s | r |] a = Impu
 /// 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)
 
@@ -46,16 +49,21 @@ let run_state eff : (forall s . Eff [| st : State s | r |] a) -> Eff [| | r |] 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,
 }

std/effect/st/string.glu

@@ -0,0 +1,44 @@
+let { Eff, ? } = import! std.effect
+let { State, send_state, make_call } = import! std.effect.st
+let prim @ { StringBuf } = import! std.effect.st.string.prim
+
+let new : forall s . Eff [| st : State s | r | ] (StringBuf s) =
+    send_state (make_call prim.new)
+
+let len buf : StringBuf s -> Eff [| st : State s | r | ] Int =
+    send_state (make_call (\_ -> prim.len buf))
+
+let push_str buf str : StringBuf s -> String -> Eff [| st : State s | r | ] () =
+    send_state (make_call (\_ -> prim.push_str buf str))
+
+let slice buf start end : StringBuf s -> Int -> Int -> Eff [| st : State s | r | ] String =
+    send_state (make_call (\_ -> prim.slice buf start end))
+
+/// ```
+/// let { assert_eq, ? } = import! std.test
+/// let st = import! std.effect.st
+/// let string_buf = import! std.effect.st.string
+/// let { (*>) } = import! std.applicative
+/// let { Eff, run_pure, ? } = import! std.effect
+///
+/// let action =
+///     do buf = string_buf.new
+///     seq string_buf.push_str buf "field:"
+///     seq string_buf.push_str buf " "
+///     seq string_buf.push_str buf "123"
+///     string_buf.read buf
+/// assert_eq (run_pure (st.run_state action)) "field: 123"
+/// ```
+let read buf : StringBuf s -> Eff [| st : State s | r | ] String =
+    do l = len buf
+    slice buf 0 l
+
+{
+    StringBuf,
+
+    new,
+    len,
+    push_str,
+    slice,
+    read,
+}

vm/src/api/mod.rs

@@ -340,7 +340,8 @@ pub mod generic {
     macro_rules! make_generics {
         ($($i: ident)+) => {
             $(
-            #[derive(Clone, Copy, PartialEq, Debug)]
+            #[derive(Clone, Copy, PartialEq, Debug, Trace)]
+            #[gluon(gluon_vm)]
             pub enum $i { }
             impl VmType for $i {
                 type Type = $i;
@@ -351,10 +352,11 @@ pub mod generic {
                     vm.global_env().get_generic(lower_str)
                 }
             }
+
             )+
         }
     }
-    make_generics! {A B C D E F G H I J K L M N O P Q R X Y Z}
+    make_generics! {A B C D E F G H I J K L M N O P Q R S T U V X Y Z}
 }
 
 fn insert_forall(
@@ -1498,6 +1500,15 @@ impl<'vm, T: Pushable<'vm>, E: fmt::Display> Pushable<'vm> for RuntimeResult<T,
     }
 }
 
+impl<T, E> RuntimeResult<T, E> {
+    pub fn map<U>(self, f: impl FnOnce(T) -> U) -> RuntimeResult<U, E> {
+        match self {
+            RuntimeResult::Return(ok) => RuntimeResult::Return(f(ok)),
+            RuntimeResult::Panic(err) => RuntimeResult::Panic(err),
+        }
+    }
+}
+
 impl<T> VmType for IO<T>
 where
     T: VmType,

vm/src/gc.rs

@@ -11,7 +11,7 @@ use std::{
     ptr::{self, NonNull},
     rc::Rc,
     result::Result as StdResult,
-    sync::Arc,
+    sync::{self, Arc},
 };
 
 use crate::{
@@ -914,6 +914,30 @@ where
     }
 }
 
+unsafe impl<T> Trace for sync::Mutex<T>
+where
+    T: Trace,
+{
+    // Don't root/unroot the contents as an unrooted value could be moved out of the Mutex
+    unsafe fn root(&self) {}
+    unsafe fn unroot(&self) {}
+    fn trace(&self, gc: &mut Gc) {
+        self.lock().unwrap_or_else(|err| err.into_inner()).trace(gc)
+    }
+}
+
+unsafe impl<T> Trace for sync::RwLock<T>
+where
+    T: Trace,
+{
+    // Don't root/unroot the contents as an unrooted value could be moved out of the RwLock
+    unsafe fn root(&self) {}
+    unsafe fn unroot(&self) {}
+    fn trace(&self, gc: &mut Gc) {
+        self.read().unwrap_or_else(|err| err.into_inner()).trace(gc)
+    }
+}
+
 unsafe impl<U> Trace for [U]
 where
     U: Trace,

vm/src/primitives.rs

@@ -2,17 +2,19 @@
 use crate::real_std::{
     ffi::OsStr,
     fs, io,
+    marker::PhantomData,
     path::{self, Path},
     result::Result as StdResult,
     str::FromStr,
     string::String as StdString,
+    sync::Mutex,
 };
 
 use crate::base::types::ArcType;
 
 use crate::{
     api::{
-        generic::{self, A},
+        generic::{self, A, S},
         primitive, Array, Getable, Opaque, OpaqueRef, Pushable, Pushed, RuntimeResult, ValueRef,
         VmType, WithVM, IO,
     },
@@ -348,6 +350,14 @@ mod std {
     pub mod path {
         pub type prim = ::std::path::Path;
     }
+    pub mod effect {
+        pub mod st {
+            pub mod string {
+                pub use crate::primitives::st_string as prim;
+            }
+        }
+    }
+
 }
 
 #[allow(non_camel_case_types)]
@@ -690,6 +700,51 @@ pub fn load_char(vm: &Thread) -> Result<ExternModule> {
     )
 }
 
+pub mod st_string {
+    use super::*;
+
+    pub(crate) fn len(buf: &StringBuf<S>) -> usize {
+        buf.0.lock().unwrap().len()
+    }
+
+    pub(crate) fn slice(
+        buf: &StringBuf<S>,
+        start: usize,
+        end: usize,
+    ) -> RuntimeResult<String, String> {
+        string::slice(&buf.0.lock().unwrap(), start, end).map(|s| s.to_string())
+    }
+
+    pub(crate) fn pop(buf: &StringBuf<S>) -> Option<char> {
+        buf.0.lock().unwrap().pop()
+    }
+
+    pub(crate) fn push_str(buf: &StringBuf<S>, s: &str) {
+        buf.0.lock().unwrap().push_str(s)
+    }
+}
+
+#[derive(Debug, Default, VmType, Userdata, Trace)]
+#[gluon(vm_type = "std.effect.st.string.StringBuf")]
+#[gluon(gluon_vm)]
+pub(crate) struct StringBuf<S>(Mutex<String>, PhantomData<S>);
+
+pub fn load_string_buf(vm: &Thread) -> Result<ExternModule> {
+    vm.register_type::<StringBuf<S>>("std.effect.st.string.StringBuf", &["s"])?;
+
+    ExternModule::new(
+        vm,
+        record! {
+            type StringBuf s => StringBuf<S>,
+            len => primitive!(1, std::effect::st::string::prim::len),
+            new => primitive!(1, "std.effect.st.string.new", |()| StringBuf(Default::default(), PhantomData::<S>)),
+            slice => primitive!(3, std::effect::st::string::prim::slice),
+            pop => primitive!(1, std::effect::st::string::prim::pop),
+            push_str => primitive!(2, std::effect::st::string::prim::push_str)
+        },
+    )
+}
+
 #[allow(non_camel_case_types, deprecated)]
 pub fn load<'vm>(vm: &'vm Thread) -> Result<ExternModule> {
     vm.define_global(