🦀 Functional Rust

186: Free Monad Interpreter — Separate DSL from Execution

Difficulty: Expert Level: 4 Define a key-value store as a pure description of operations, then run that same description against multiple backends — in-memory HashMap, pure list, or anything else.

The Problem This Solves

You have code that reads and writes a key-value store. In production you use a HashMap (or Redis, or a database). In tests you want a clean slate every time, easy to inspect, no teardown needed. In some contexts you might want an immutable "pure" store for determinism or replay. The naive approach: parameterize everything with a `&mut HashMap`. Tests write to a real HashMap (fine), production writes to the same HashMap (fine) — but what if you later want a different backend? What if you want to run the same sequence of operations twice, once against each backend, and compare results? What if you want to serialize a sequence of operations and replay it later? You end up with one of these bad outcomes: 1. Concrete coupling: functions take `&mut HashMap` directly — swapping backends means changing every function signature 2. Trait injection: functions take `&mut dyn Store` — better, but now side effects are baked into function calls, not separable from logic 3. Test doubles: separate mock implementations — diverge from real code over time The Free Monad approach separates _what operations to perform_ (the program, as data) from _how to perform them_ (the interpreter, as a function). The program is built once. You run it with any interpreter. The same description of "put name=Alice, put age=30, get name" gets executed by the HashMap interpreter in production and by the pure list interpreter in tests. No coupling. This is exactly that pain solved.

The Intuition

Think of a cooking recipe again — but this time it's a shopping + cooking script:
1. Put "flour" in pantry
2. Put "eggs" in fridge
3. Get "flour" from pantry
That script is just data. You could "run" it in your actual kitchen (HashMap interpreter: physical storage). Or you could "run" it as a paper simulation (pure list interpreter: just track what's in a list). The script doesn't care. It says _what_, not _where_ or _how_. In code, the "script" is a `Free<A>` value — a tree of `StoreF` instructions linked by continuations. Here's what the instructions look like:
enum StoreF<A> {
 Get(String, Box<dyn FnOnce(Option<String>) -> A>),  // "fetch key, pass result to A"
 Put(String, String, A),                              // "store key=value, continue with A"
 Delete(String, A),                                   // "remove key, continue with A"
}
And the free monad wraps them:
enum Free<A> {
 Pure(A),                    // "I'm done, here's the value"
 Free(Box<StoreF<Free<A>>>), // "do this instruction, then continue"
}
`bind` threads the result of one instruction into the next. Smart constructors (`get`, `put`, `delete`) build individual instruction nodes. You chain them with `bind` to build the full program tree.

How It Works in Rust

Step 1: Smart constructors
fn get(key: impl Into<String>) -> Free<Option<String>> {
 Free::Free(Box::new(StoreF::Get(
     key.into(),
     Box::new(|v| Free::Pure(v)),  // continuation: wrap result in Pure
 )))
}

fn put(key: impl Into<String>, val: impl Into<String>, next: Free<()>) -> Free<()> {
 Free::Free(Box::new(StoreF::Put(key.into(), val.into(), next)))
}
Step 2: Build a program (no execution yet)
fn build_program() -> Free<Option<String>> {
 // put "name" = "Alice", put "age" = "30", then get "name"
 bind(put("name", "Alice", pure_val(())), |_| {
     bind(put("age", "30", pure_val(())), |_| {
         get("name")  // result: Some("Alice")
     })
 })
}
Nothing happens here. You get back a `Free<Option<String>>` — a data structure. Step 3: Interpreter 1 — real HashMap
fn run_memory<A>(tbl: &mut HashMap<String, String>, program: Free<A>) -> A {
 match program {
     Free::Pure(x) => x,  // done
     Free::Free(instr) => match *instr {
         StoreF::Get(k, cont) => {
             let val = tbl.get(&k).cloned();  // real HashMap lookup
             run_memory(tbl, cont(val))
         }
         StoreF::Put(k, v, next) => {
             tbl.insert(k, v);  // real HashMap insert
             run_memory(tbl, next)
         }
         StoreF::Delete(k, next) => {
             tbl.remove(&k);    // real HashMap remove
             run_memory(tbl, next)
         }
     },
 }
}
Step 4: Interpreter 2 — pure association list
fn run_pure<A>(store: Vec<(String, String)>, program: Free<A>) -> (A, Vec<(String, String)>) {
 match program {
     Free::Pure(x) => (x, store),  // done — return value AND final state
     Free::Free(instr) => match *instr {
         StoreF::Get(k, cont) => {
             // Look up in the Vec — no mutation of external state
             let val = store.iter().find(|(ck, _)| ck == &k).map(|(_, v)| v.clone());
             run_pure(store, cont(val))
         }
         StoreF::Put(k, v, next) => {
             // Build a new Vec with the value added — immutable style
             let mut new_store: Vec<_> = store.into_iter().filter(|(ck,_)| ck != &k).collect();
             new_store.push((k, v));
             run_pure(new_store, next)
         }
         StoreF::Delete(k, next) => {
             let new_store: Vec<_> = store.into_iter().filter(|(ck,_)| ck != &k).collect();
             run_pure(new_store, next)
         }
     },
 }
}
Step 5: Same program, both interpreters
// Both produce Some("Alice") — same program, different execution
let mut tbl = HashMap::new();
let r1 = run_memory(&mut tbl, build_program());

let (r2, _store) = run_pure(vec![], build_program());

assert_eq!(r1, r2);  // same logical result

What This Unlocks

Key Differences

ConceptOCamlRust
Generic free monad`type 'a free` works over any functorMust specialize: `Free<A>` with `StoreF` baked in
Higher-kinded abstraction`Free(F(Free t))` for any `F`Encode `F` as a concrete enum
Continuations in instructionsClosures, garbage collected`Box<dyn FnOnce>` — heap, explicit lifetime
InterpreterRecursive `match`Recursive `match` — same structure
Pure interpreter return`(A, store)` tupleSame: returns `(A, Vec<...>)`
// Free Monad Interpreter — Separate DSL from Execution
//
// Build a key-value store DSL as a pure data structure (the free monad),
// then interpret it with different interpreters — one in-memory, one pure.
// The program is constructed once and run with any interpreter.

use std::collections::HashMap;

// ── DSL instructions (the "functor" F in Free F) ────────────────────────────

enum StoreF<A> {
    Get(String, Box<dyn FnOnce(Option<String>) -> A>),
    Put(String, String, A),
    Delete(String, A),
}

// ── Free monad over StoreF ───────────────────────────────────────────────────

enum Free<A> {
    Pure(A),
    Free(Box<StoreF<Free<A>>>),
}

// ── Smart constructors ───────────────────────────────────────────────────────

fn pure_val<A>(x: A) -> Free<A> {
    Free::Pure(x)
}

fn get(key: impl Into<String>) -> Free<Option<String>> {
    let key = key.into();
    Free::Free(Box::new(StoreF::Get(key, Box::new(|v| Free::Pure(v)))))
}

fn put(key: impl Into<String>, val: impl Into<String>, next: Free<()>) -> Free<()> {
    Free::Free(Box::new(StoreF::Put(key.into(), val.into(), next)))
}

fn delete(key: impl Into<String>, next: Free<()>) -> Free<()> {
    Free::Free(Box::new(StoreF::Delete(key.into(), next)))
}

// ── Monadic bind ─────────────────────────────────────────────────────────────

fn bind<A, B, F>(m: Free<A>, f: F) -> Free<B>
where
    A: 'static,
    B: 'static,
    F: FnOnce(A) -> Free<B> + 'static,
{
    match m {
        Free::Pure(x) => f(x),
        Free::Free(instr) => match *instr {
            StoreF::Get(k, cont) => {
                Free::Free(Box::new(StoreF::Get(
                    k,
                    Box::new(move |v| bind(cont(v), f)),
                )))
            }
            StoreF::Put(k, v, next) => {
                Free::Free(Box::new(StoreF::Put(k, v, bind(next, f))))
            }
            StoreF::Delete(k, next) => {
                Free::Free(Box::new(StoreF::Delete(k, bind(next, f))))
            }
        },
    }
}

// ── Interpreter 1: in-memory HashMap ────────────────────────────────────────

fn run_memory<A>(tbl: &mut HashMap<String, String>, program: Free<A>) -> A {
    match program {
        Free::Pure(x) => x,
        Free::Free(instr) => match *instr {
            StoreF::Get(k, cont) => {
                let val = tbl.get(&k).cloned();
                run_memory(tbl, cont(val))
            }
            StoreF::Put(k, v, next) => {
                tbl.insert(k, v);
                run_memory(tbl, next)
            }
            StoreF::Delete(k, next) => {
                tbl.remove(&k);
                run_memory(tbl, next)
            }
        },
    }
}

// ── Interpreter 2: pure association list (Vec<(String,String)>) ──────────────

fn run_pure<A>(store: Vec<(String, String)>, program: Free<A>) -> (A, Vec<(String, String)>) {
    match program {
        Free::Pure(x) => (x, store),
        Free::Free(instr) => match *instr {
            StoreF::Get(k, cont) => {
                let val = store.iter().find(|(ck, _)| ck == &k).map(|(_, v)| v.clone());
                run_pure(store, cont(val))
            }
            StoreF::Put(k, v, next) => {
                let mut new_store: Vec<(String, String)> =
                    store.into_iter().filter(|(ck, _)| ck != &k).collect();
                new_store.push((k, v));
                run_pure(new_store, next)
            }
            StoreF::Delete(k, next) => {
                let new_store: Vec<(String, String)> =
                    store.into_iter().filter(|(ck, _)| ck != &k).collect();
                run_pure(new_store, next)
            }
        },
    }
}

// ── Build the example program ─────────────────────────────────────────────────

fn build_program() -> Free<Option<String>> {
    // put "name" "Alice"
    // put "age"  "30"
    // get "name"
    bind(put("name", "Alice", pure_val(())), |_| {
        bind(put("age", "30", pure_val(())), |_| get("name"))
    })
}

fn build_delete_program() -> Free<Option<String>> {
    // put "x" "hello", delete "x", get "x" => None
    bind(put("x", "hello", pure_val(())), |_| {
        bind(delete("x", pure_val(())), |_| get("x"))
    })
}

fn main() {
    // ── Run with in-memory interpreter ────────────────────────────────────
    let program = build_program();
    let mut tbl = HashMap::new();
    let result1 = run_memory(&mut tbl, program);
    println!("memory interp: {}", result1.as_deref().unwrap_or("none"));

    // ── Run with pure interpreter ─────────────────────────────────────────
    let program2 = build_program();
    let (result2, final_store) = run_pure(vec![], program2);
    println!("pure interp:   {}", result2.as_deref().unwrap_or("none"));
    println!("final store:   {:?}", final_store);

    // ── Delete program ────────────────────────────────────────────────────
    let del_prog = build_delete_program();
    let (del_result, _) = run_pure(vec![], del_prog);
    println!("after delete:  {}", del_result.as_deref().unwrap_or("none"));
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_memory_interpreter_put_and_get() {
        let program = build_program();
        let mut tbl = HashMap::new();
        let result = run_memory(&mut tbl, program);
        assert_eq!(result, Some("Alice".to_string()));
        assert_eq!(tbl.get("age"), Some(&"30".to_string()));
    }

    #[test]
    fn test_pure_interpreter_put_and_get() {
        let program = build_program();
        let (result, store) = run_pure(vec![], program);
        assert_eq!(result, Some("Alice".to_string()));
        assert!(store.iter().any(|(k, v)| k == "age" && v == "30"));
    }

    #[test]
    fn test_delete_removes_key() {
        let program = build_delete_program();
        let (result, store) = run_pure(vec![], program);
        assert_eq!(result, None);
        assert!(!store.iter().any(|(k, _)| k == "x"));
    }

    #[test]
    fn test_same_program_two_interpreters_agree() {
        // Both interpreters should produce the same logical result
        let p1 = build_program();
        let p2 = build_program();
        let mut tbl = HashMap::new();
        let r1 = run_memory(&mut tbl, p1);
        let (r2, _) = run_pure(vec![], p2);
        assert_eq!(r1, r2);
    }
}
(* Free monad: build a DSL as a data structure, then interpret it.
   The program is pure; side effects only happen at interpretation. *)

(* DSL: a simple key-value store language *)
type 'a store_f =
  | Get : string * (string option -> 'a) -> 'a store_f
  | Put : string * string * 'a -> 'a store_f
  | Delete : string * 'a -> 'a store_f

(* Free monad *)
type 'a free =
  | Pure : 'a -> 'a free
  | Free : 'a free store_f -> 'a free

let pure x = Pure x

let get k f    = Free (Get (k, (fun v -> Pure (f v))))
let put k v a  = Free (Put (k, v, Pure a))
let delete k a = Free (Delete (k, Pure a))

let rec bind m f = match m with
  | Pure x -> f x
  | Free (Get (k, cont))    -> Free (Get (k, fun v -> bind (cont v) f))
  | Free (Put (k, v, next)) -> Free (Put (k, v, bind next f))
  | Free (Delete (k, next)) -> Free (Delete (k, bind next f))

(* Interpreter 1: in-memory hashtable *)
let run_memory tbl program =
  let rec go = function
    | Pure x -> x
    | Free (Get (k, cont))    -> go (cont (Hashtbl.find_opt tbl k))
    | Free (Put (k, v, next)) -> Hashtbl.replace tbl k v; go next
    | Free (Delete (k, next)) -> Hashtbl.remove tbl k; go next
  in go program

(* Interpreter 2: pure association list *)
let run_pure store program =
  let rec go store = function
    | Pure x -> (x, store)
    | Free (Get (k, cont))    -> go store (cont (List.assoc_opt k store))
    | Free (Put (k, v, next)) -> go ((k,v) :: List.filter (fun (k',_) -> k' <> k) store) next
    | Free (Delete (k, next)) -> go (List.filter (fun (k',_) -> k' <> k) store) next
  in go store program

let () =
  (* Build the program once *)
  let program =
    bind (put "name" "Alice" ()) (fun () ->
    bind (put "age"  "30"    ()) (fun () ->
    bind (get "name" (fun v -> v)) (fun name ->
    pure name)))
  in

  (* Run with two different interpreters *)
  let tbl = Hashtbl.create 4 in
  let result1 = run_memory tbl program in
  Printf.printf "memory interp: %s\n" (Option.value result1 ~default:"none");

  let (result2, _) = run_pure [] program in
  Printf.printf "pure interp:   %s\n" (Option.value result2 ~default:"none")