Add scheme interpreter, move away from omake

Makefile

@@ -0,0 +1,42 @@
+OCS_VERSION = 1.0.3
+OCS_DIR = ocs-$(OCS_VERSION)
+
+
+INCLUDES = -I $(OCS_DIR)/src
+OCAMLFLAGS = $(INCLUDES)
+OCAMLOPT = ocamlopt
+OCAMLC = ocamlc
+OCAMLDEP = ocamldep $(INCLUDES)
+OCAMLLIBS = unix.cma str.cma nums.cma
+
+bot: irc.cmo dispatch.cmo command.cmo iobuf.cmo cdb.cmo bot.cmo
+bot: $(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
+
+$(OCS_DIR): ocs-$(OCS_VERSION).tar.gz
+	tar xzf $<
+
+ocs-$(OCS_VERSION).tar.gz:
+	wget http://will.iki.fi/software/ocs/files/$@
+
+.PHONY: clean
+clean:
+	rm -f bot *.cm* *.o
+
+%.cmi: %.mli
+	$(OCAMLC) $(OCAMLFLAGS) -c $<
+
+%.cmx: %.ml
+	$(OCAMLOPT) $(OCAMLFLAGS) -c $<
+
+%.cmo: %.ml
+	$(OCAMLC) $(OCAMLFLAGS) -c $<
+
+depend: .depend
+.depend: *.mli *.ml
+	$(OCAMLDEP) $(INCLUDES) $^ > $@
+
+include .depend

OMakefile

@@ -1,33 +0,0 @@
-OCAMLPACKS[] = 
-    unix
-    str
-OCAMLCFLAGS += -g
-
-.DEFAULT: bot
-
-OCamlProgram(bot, bot irc command iobuf dispatch cdb)
-
-section
-	OCAMLPACKS[] +=
-		oUnit
-	NATIVE_ENABLED = false
-
-	tests.cmx:
-	tests.cmi:
-	tests.cmo:
-	tests$(EXT_OBJ):
-
-	dispatch_tests.cmx:
-	dispatch_tests.cmi:
-	dispatch_tests.cmo:
-	dispatch_tests$(EXT_OBJ):
-
-	OCamlProgram(tests, tests dispatch irc command iobuf client channel)
-
-.PHONY: test
-test: tests
-	./tests
-
-.PHONY: clean
-clean:
-	rm $(filter-proper-targets $(ls R, .))

OMakeroot

@@ -1,17 +0,0 @@
-open build/C
-open build/OCaml
-
-USE_OCAMLFIND = true
-NATIVE_ENABLED = true
-BYTE_ENABLED = true
-
-#
-# The command-line variables are defined *after* the
-# standard configuration has been loaded.
-#
-DefineCommandVars()
-
-#
-# Include the OMakefile in this directory.
-#
-.SUBDIRS: .

README

@@ -1,17 +1,19 @@
-Pretty Good IRC Daemon
+bot
-======================
+===
 
-This is a feature-stripped IRC daemon similar to the now-defunct iacd.
+It's a bot with a scheme interpreter in it.
-It provides an additional set of commands to allow clients to intercept
-all channel activity.  This allows a whole new range of possibilites for
-bots: including something as simple as rot13-encoding all channel
-discussions, to something as complex as a full MUD or MOO.
 
 
 Downloading
 -----------
 
-If you can read this, I forgot to update the README!  Please mail
+http://woozle.org/~neale/gitweb.cgi
-neale@woozle.org and I'll publish a URL for a download.
+
+
+Author
+------
+
+Neale Pickett <neale@woozle.org>
+
 
 

TODO

@@ -0,0 +1 @@
+* 

bot.ml

@@ -16,6 +16,68 @@ let write iobuf command args text =
     print_endline ("--> " ^ (Command.as_string cmd));
     Iobuf.write iobuf cmd
 
+let rec string_of_sval = function
+  | Ocs_types.Snull -> "()"
+  | Ocs_types.Seof -> "#<eof>"
+  | Ocs_types.Strue -> "#t"
+  | Ocs_types.Sfalse -> "#f"
+  | Ocs_types.Sstring s -> s
+  | Ocs_types.Ssymbol s -> s
+  | Ocs_types.Sint i -> (string_of_int i)
+  | Ocs_types.Sreal r -> (Ocs_numstr.string_of_real r)
+  | Ocs_types.Scomplex z -> (Ocs_numstr.string_of_complex z)
+  | Ocs_types.Sbigint b -> (Big_int.string_of_big_int b)
+  | Ocs_types.Srational r -> (Ratio.string_of_ratio r)
+  | Ocs_types.Schar c -> String.make 1 c
+  | Ocs_types.Spair l -> "#<it's a pair>"
+  | Ocs_types.Svector v -> "#<it's a vector>"
+  | Ocs_types.Sport _ -> "#<port>"
+  | Ocs_types.Sproc _ -> "#<procedure>"
+  | Ocs_types.Sprim { Ocs_types.prim_fun = _; Ocs_types.prim_name = n } ->
+      "#<primitive:" ^ n ^ ">"
+  | Ocs_types.Spromise _ -> "#<promise>"
+  | Ocs_types.Sesym (_, s) -> string_of_sval s
+  | Ocs_types.Swrapped _ -> "#<wrapped>"
+  | Ocs_types.Sunspec -> "#<unspecified>"
+  | _ -> "#<unknown>"
+
+let scheme_eval str =
+  let thread = Ocs_top.make_thread () in
+  let env = Ocs_top.make_env () in
+  let inport = Ocs_port.string_input_port str in
+  let lexer = Ocs_lex.make_lexer inport "interactive" in
+  let v = Ocs_read.read_expr lexer in
+  let c = Ocs_compile.compile env v in
+  let buf = Buffer.create 20 in
+  let printer v =
+    Buffer.add_string buf (string_of_sval v)
+  in
+    try
+      Ocs_eval.eval thread printer c;
+      Buffer.contents buf
+    with Ocs_error.Error msg ->
+      msg
+
+
+let handle_privmsg iobuf sender target text =
+  try
+    let factoid = get_one text in
+    let response = 
+      match factoid.[0] with
+        | ':' ->
+            "\001ACTION " ^ (Str.string_after factoid 1) ^ "\001"
+        | '\\' ->
+            Str.string_after factoid 1
+        | _ ->
+            Printf.sprintf "Gosh, %s, I think %s is %s" sender text factoid
+    in
+      write iobuf "PRIVMSG" [target] (Some response)
+  with Not_found ->
+    if text.[0] == '(' then
+      let result = scheme_eval text in
+        write iobuf "PRIVMSG" [target] (Some result)
+
+
 let handle_command iobuf cmd =
   print_endline ("<-- " ^ (Command.as_string cmd));
   match Command.as_tuple cmd with
@@ -23,26 +85,11 @@ let handle_command iobuf cmd =
         write iobuf "PONG" [] text
     | (_, "001", _, _) ->
         write iobuf "JOIN" ["#bot"] None
-    | (Some who, "JOIN", [], Some chan) ->
+    | (Some sender, "JOIN", [], Some chan) ->
         write iobuf "PRIVMSG" [chan] (Some "hi asl")
-    | (Some who, "PRIVMSG", [target], Some text) ->
+    | (Some sender, "PRIVMSG", [target], Some text) ->
         if target.[0] = '#' then
-          try
+          handle_privmsg iobuf sender target text
-            let factoid = get_one text in
-            let response = 
-              match factoid.[0] with
-                | ':' ->
-                    "\001ACTION " ^ (Str.string_after factoid 1) ^ "\001"
-                | '\\' ->
-                    Str.string_after factoid 1
-                | _ ->
-                    Printf.sprintf "Gosh, %s, I think %s is %s" who text factoid
-            in
-            write iobuf "PRIVMSG" [target] (Some response)
-          with Not_found ->
-            ()
-        else
-          ()
     | _ ->
         ()