Looks like I was trying to add scheme callbacks.

Makefile

@@ -13,6 +13,10 @@ bot: irc.cmo dispatch.cmo command.cmo iobuf.cmo cdb.cmo bot.cmo
 bot: $(OCS_DIR)/src/ocs.cma
 	$(OCAMLC) -o $@ $(OCAMLLIBS) $^
 
+callback: callback.cmo
+callback: $(OCS_DIR)/src/ocs.cma
+	$(OCAMLC) -o $@ $(OCAMLLIBS) $^
+
 $(OCS_DIR)/src/ocs.cma $(OCS_DIR)/src/ocs.cmxa: $(OCS_DIR)
 	cd $(OCS_DIR)/src && make
 

arf.ml

@@ -0,0 +1,8 @@
+type goob = Goob of (int ref) * int
+
+let _ =
+  let a = Goob (ref 1, 2) in
+    if (match a with
+          | Goob ({contents = 1}, _) -> true
+          | _ -> false) then
+      print_endline "hi asl"

bindings.ml

@@ -0,0 +1,40 @@
+type callback = Iobuf.t -> Command.t -> unit
+type t = (string * Str.regexp * callback) list
+
+let create () = []
+
+let remove b id =
+  let keep = function
+    | (id', _, _) ->
+        id' <> id
+  in
+    List.filter keep b
+
+let add b id regex cb =
+  (id, regex, cb) :: (remove b id)
+
+let lookup b text =
+  let rec groups str i acc =
+    try
+      groups str (i + 1) ((Str.matched_group i str) :: acc)
+    with
+      | Not_found ->
+          groups str (i + 1) ("" :: acc)
+      | Invalid_argument _ ->
+          List.rev acc
+  in
+  let rec loop b acc =
+    match b with 
+      | [] -> 
+          List.rev acc
+      | (id, regex, cb) :: tl ->
+          try
+            ignore (Str.search_forward regex text 0);
+            loop tl ((id, cb, groups text 0 []) :: acc)
+          with Not_found ->
+            loop tl acc
+  in
+    loop b []
+
+    
+

bot.ml

@@ -5,7 +5,7 @@ let choice l =
   let n = Random.int (List.length l) in
     List.nth l n
 
-let get_one key =
+let choose_one key =
   let matches = Cdb.get_matches info_db key in
   match Stream.npeek 120 matches with
     | [] -> raise Not_found
@@ -16,10 +16,24 @@ let write iobuf command args text =
     print_endline ("--> " ^ (Command.as_string cmd));
     Iobuf.write iobuf cmd
 
+let make_sandbox_env () =
+  let e = Ocs_env.top_env () in
+    Ocs_compile.bind_lang e;
+    Ocs_macro.bind_macro e;
+    Ocs_num.init e;
+    Ocs_numstr.init e;
+    Ocs_prim.init e;
+    Ocs_vector.init e;
+    Ocs_list.init e;
+    Ocs_char.init e;
+    Ocs_string.init e;
+    Ocs_contin.init e;
+    e
+
 let scheme_eval str =
   try
     let thread = Ocs_top.make_thread () in
-    let env = Ocs_top.make_env () in
+    let env = make_sandbox_env () in
     let inport = Ocs_port.open_input_string str in
     let outport = Ocs_port.open_output_string () in
     let lexer = Ocs_lex.make_lexer inport "interactive" in
@@ -35,7 +49,7 @@ let scheme_eval str =
 
 let handle_privmsg iobuf sender target text =
   try
-    let factoid = get_one text in
+    let factoid = choose_one text in
     let response = 
       match factoid.[0] with
         | ':' ->
@@ -43,7 +57,7 @@ let handle_privmsg iobuf sender target text =
         | '\\' ->
             Str.string_after factoid 1
         | _ ->
-            Printf.sprintf "Gosh, %s, I think %s is %s" sender text factoid
+            Printf.sprintf "I've heard that %s is %s" text factoid
     in
       write iobuf "PRIVMSG" [target] (Some response)
   with Not_found ->

bot_ocs.ml

@@ -0,0 +1,44 @@
+open Ocs_types
+
+module Iobuf =
+  Ocs_wrap.Make (struct
+                   type t = Iobuf.t
+                 end)
+
+let rec string_list_of_spair v acc =
+  match v with
+    | Snull ->
+        acc
+    | Spair { car = Sstring s; cdr = cdr } ->
+        string_list_of_spair cdr (acc @ s)
+    | _ ->
+        raise Ocs_error.Error "Not a string list"
+
+let write_vals iobuf vals =
+  let cmd =
+    match vals with
+      | [| Swrapped iobuf; Sstring command; Spair args; Sstring text |] ->
+          Command.create None command (string_list_of_spair args) (Some text)
+      | [| Swrapped iobuf; Sstring command; Spair args |] ->
+          Command.create None command (string_list_of_spair args) None
+      | _ ->
+          raise Ocs_error.Error "Invalid arguments"
+  in
+    Iobuf.write iobuf cmd
+
+let iobuf_write_proc iobuf =
+  let primf = Pfn (write_vals iobuf) in
+  let sprim = { prim_fun = primf; prim_name = "iobuf-write" } in
+    Sproc (sprim, [| [| |] |])
+
+let ocs_bind b regexp cb =
+  match (regexp, cb) with
+    | (Sstring regexp_s, Sproc (p, d)) ->
+        let regexp = Str.regexp regexp_s in
+          b := Bindings.add (regexp_s, regexp, p)
+    | _ ->
+        raise Ocs_error.Error "invalid arguments"
+
+let init b e =
+  set_pf3 e (ocs_bind b) "bind"
+

callback.ml

@@ -0,0 +1,24 @@
+open Ocs_types
+
+let prefix_print prefix =
+  function
+    | [| Sstring txt |] ->
+        print_endline (prefix ^ txt);
+        Sunspec
+    | _ ->
+        raise (Ocs_error.Error "Invalid arguments")
+
+let prefix_print_proc prefix =
+  let primf = Pfn (prefix_print prefix) in
+  let sprim = { prim_fun = primf; prim_name = "iobuf-write" } in
+    Sprim sprim
+
+let code =
+  Capply1 ((Cval (prefix_print_proc "pfx: ")),
+           (Cval (Sstring "hello world")))
+
+let _ =
+  let thread = Ocs_top.make_thread () in
+  let outport = Ocs_port.open_output_string () in
+    Ocs_eval.eval thread (Ocs_print.print outport false) code;
+    Ocs_port.get_output_string outport