Ocaml: Added step 1, missing some optional functionality

7 files changed, 123 insertions, 2 deletions

diff --git a/.gitignore b/.gitignore
index 44ee760..49aa62f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -29,6 +29,7 @@ go/mal
 java/target/
 java/dependency-reduced-pom.xml
 ocaml/*.cmi
+ocaml/*.cmo
 ocaml/*.swp
 rust/target/
 rust/mal
diff --git a/Makefile b/Makefile
index b3d6278..a0b2f7b 100644
--- a/Makefile
+++ b/Makefile
@@ -60,7 +60,7 @@ js_STEP_TO_PROG =      js/$($(1)).js
 lua_STEP_TO_PROG =     lua/$($(1)).lua
 make_STEP_TO_PROG =    make/$($(1)).mk
 mal_STEP_TO_PROG =     mal/$($(1)).mal
-ocaml_STEP_TO_PROG =   ocaml/$($(1)).ml
+ocaml_STEP_TO_PROG =   ocaml/$($(1))
 perl_STEP_TO_PROG =    perl/$($(1)).pl
 php_STEP_TO_PROG =     php/$($(1)).php
 ps_STEP_TO_PROG =      ps/$($(1)).ps
@@ -85,7 +85,7 @@ js_RUNSTEP =      node ../$(2) $(3)
 lua_RUNSTEP =     ../$(2) $(3)
 make_RUNSTEP =    make -f ../$(2) $(3)
 mal_RUNSTEP =     $(call $(MAL_IMPL)_RUNSTEP,$(1),$(call $(MAL_IMPL)_STEP_TO_PROG,stepA),../$(2),")  #"
-ocaml_RUNSTEP =   ocaml ../$(2) $(3)
+ocaml_RUNSTEP =   ../$(2) $(3)
 perl_RUNSTEP =    perl ../$(2) --raw $(3)
 php_RUNSTEP =     php ../$(2) $(3)
 ps_RUNSTEP =      $(4)gs -q -I./ -dNODISPLAY -- ../$(2) $(3)$(4)
diff --git a/ocaml/Makefile b/ocaml/Makefile
new file mode 100644
index 0000000..a46b82a
--- /dev/null
+++ b/ocaml/Makefile
@@ -0,0 +1,16 @@
+STEPS = step0_repl.ml step1_read_print.ml
+MODULES = types.ml reader.ml printer.ml
+LIBS = str.cma 
+
+BINS = $(STEPS:%.ml=%)
+
+all: $(BINS) mal oc
+
+mal: $(word $(words $(BINS)),$(BINS))
+	cp $< $@
+
+$(BINS): %: %.ml $(MODULES)
+	ocamlc $(LIBS) $(MODULES) $< -o $@
+
+clean:
+	rm -f $(BINS) mal *.cmi *.cmo
diff --git a/ocaml/printer.ml b/ocaml/printer.ml
new file mode 100644
index 0000000..30e4415
--- /dev/null
+++ b/ocaml/printer.ml
@@ -0,0 +1,15 @@
+let join sep xs =
+  List.fold_left (fun a x -> if a = "" then x else a ^ sep ^ x) "" xs
+
+let rec pr_str mal_obj =
+  match mal_obj with
+    | Types.Int i -> string_of_int i
+    | Types.Symbol s -> s
+    | Types.Keyword s -> ":" ^ s
+    | Types.Nil -> "nil"
+    | Types.Bool true -> "true"
+    | Types.Bool false -> "false"
+    | Types.String s -> "\""
+                        ^ (Str.global_replace (Str.regexp "\"") "\\\"" s)
+                        ^ "\""
+    | Types.MalList xs -> "(" ^ (join " " (List.map pr_str xs)) ^ ")"
diff --git a/ocaml/reader.ml b/ocaml/reader.ml
new file mode 100644
index 0000000..51ab522
--- /dev/null
+++ b/ocaml/reader.ml
@@ -0,0 +1,66 @@
+let find_re re str =
+  List.map (function | Str.Delim x -> x | Str.Text x -> "impossible!")
+    (List.filter (function | Str.Delim x -> true | Str.Text x -> false)
+      (Str.full_split re str)) ;;
+
+let token_re = (Str.regexp "~@\\|[][{}()'`~^@]\\|\"\\(\\\\.\\|[^\"]\\)*\"\\|;.*\\|[^][ 	\n{}('\"`,;)]*")
+
+type reader = {
+  form : Types.mal_type;
+  tokens : string list;
+}
+
+type list_reader = {
+  list_form : Types.mal_type list;
+  tokens : string list;
+}
+
+let read_atom token =
+  match token with
+    | "nil" -> Types.Nil
+    | "true" -> Types.Bool true
+    | "false" -> Types.Bool false
+    | _ ->
+    match token.[0] with
+      | '0'..'9' -> Types.Int (int_of_string token)
+      | '"' -> Types.String (Str.global_replace (Str.regexp "\\\\\\(.\\)")
+                                                "\\1"
+                                                (String.sub token 1 ((String.length token) - 2)))
+      | ':' -> Types.Keyword (Str.replace_first (Str.regexp "^:") "" token)
+      | _ -> Types.Symbol token
+
+let rec read_list list_reader =
+  match list_reader.tokens with
+    | [] -> output_string stderr "expected ')', got EOF\n";
+            flush stderr;
+            raise End_of_file;
+    | token :: tokens ->
+      if Str.string_match (Str.regexp "[])}]") token 0 then
+	{list_form = list_reader.list_form; tokens = tokens}
+      else
+	let reader = read_form list_reader.tokens in
+          read_list {list_form = list_reader.list_form @ [reader.form];
+	             tokens = reader.tokens}
+and read_quote sym tokens =
+  let reader = read_form tokens in
+    {form = Types.MalList [ Types.Symbol sym; reader.form ];
+     tokens = reader.tokens}
+and read_form all_tokens =
+  match all_tokens with
+    | [] -> raise End_of_file;
+    | token :: tokens ->
+      match token with
+        | "'" -> read_quote "quote" tokens
+        | "`" -> read_quote "quasiquote" tokens
+        | "~" -> read_quote "unquote" tokens
+        | "~@" -> read_quote "splice-unquote" tokens
+        | _ ->
+          match token.[0] with
+           | '[' | '(' | '{' -> let list_reader =
+              read_list {list_form = []; tokens = tokens} in
+	        {form = Types.MalList list_reader.list_form;
+                 tokens = list_reader.tokens}
+           | _ -> {form = read_atom token; tokens = tokens}
+
+let read_str str = (read_form (List.filter ((<>) "") (find_re token_re str))).form
+
diff --git a/ocaml/step1_read_print.ml b/ocaml/step1_read_print.ml
new file mode 100644
index 0000000..6cbbb16
--- /dev/null
+++ b/ocaml/step1_read_print.ml
@@ -0,0 +1,15 @@
+let read str = Reader.read_str str
+let eval ast any = ast
+let print exp = Printer.pr_str exp
+let rep str = print (eval (read str) "")
+
+let rec main =
+  try
+    while true do
+      print_string "user> ";
+      let line = read_line () in
+        try
+          print_endline (rep line);
+        with End_of_file -> ()
+    done
+  with End_of_file -> ()
diff --git a/ocaml/types.ml b/ocaml/types.ml
new file mode 100644
index 0000000..92f3030
--- /dev/null
+++ b/ocaml/types.ml
@@ -0,0 +1,8 @@
+type mal_type =
+  | MalList of mal_type list
+  | Int of int
+  | Symbol of string
+  | Keyword of string
+  | Nil
+  | Bool of bool
+  | String of string