From 9115534dc73fe18a12b3b2ecf436051b76bdd8a4 Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 23 Jan 2015 18:11:45 -0500 Subject: Ocaml: Add step 4, but not str fns or optionals. --- ocaml/core.ml | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 ocaml/core.ml (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml new file mode 100644 index 0000000..4cec7f1 --- /dev/null +++ b/ocaml/core.ml @@ -0,0 +1,32 @@ +let ns = Env.make None + +let num_fun t f = Types.Fn + (function + | [(Types.Int a); (Types.Int b)] -> t (f a b) + | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) + +let mk_int x = Types.Int x +let mk_bool x = Types.Bool x + +let init env = begin + Env.set env (Types.Symbol "+") (num_fun mk_int ( + )); + Env.set env (Types.Symbol "-") (num_fun mk_int ( - )); + Env.set env (Types.Symbol "*") (num_fun mk_int ( * )); + Env.set env (Types.Symbol "/") (num_fun mk_int ( / )); + Env.set env (Types.Symbol "<") (num_fun mk_bool ( < )); + Env.set env (Types.Symbol "<=") (num_fun mk_bool ( <= )); + Env.set env (Types.Symbol ">") (num_fun mk_bool ( > )); + Env.set env (Types.Symbol ">=") (num_fun mk_bool ( >= )); + + Env.set env (Types.Symbol "list") (Types.Fn (function xs -> Types.MalList xs)); + Env.set env (Types.Symbol "list?") + (Types.Fn (function [Types.MalList _] -> Types.Bool true | _ -> Types.Bool false)); + Env.set env (Types.Symbol "empty?") + (Types.Fn (function [Types.MalList []] -> Types.Bool true | _ -> Types.Bool false)); + Env.set env (Types.Symbol "count") + (Types.Fn (function [Types.MalList xs] -> Types.Int (List.length xs) | _ -> Types.Int 0)); + Env.set env (Types.Symbol "=") + (Types.Fn (function [a; b] -> Types.Bool (a = b) | _ -> Types.Bool false)); + +end + -- cgit v1.2.3 From de04357cd5f2954e2d682abb97ca2b3b90ea75d1 Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 23 Jan 2015 20:05:03 -0500 Subject: Ocaml: Add string functions --- ocaml/core.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 4cec7f1..c11c9f9 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -28,5 +28,19 @@ let init env = begin Env.set env (Types.Symbol "=") (Types.Fn (function [a; b] -> Types.Bool (a = b) | _ -> Types.Bool false)); + Env.set env (Types.Symbol "pr-str") + (Types.Fn (function xs -> + Types.String (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)))); + Env.set env (Types.Symbol "str") + (Types.Fn (function xs -> + Types.String (Printer.join "" (List.map (fun s -> Printer.pr_str s false) xs)))); + Env.set env (Types.Symbol "prn") + (Types.Fn (function xs -> + print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)); + Types.Nil)); + Env.set env (Types.Symbol "println") + (Types.Fn (function xs -> + print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s false) xs)); + Types.Nil)); end -- cgit v1.2.3 From f2f11f6279e1b242ba75136cd037fabdd176118a Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 23 Jan 2015 22:54:15 -0500 Subject: Ocaml: rename Types.MalList to Types.List --- ocaml/core.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index c11c9f9..db3424a 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -18,13 +18,13 @@ let init env = begin Env.set env (Types.Symbol ">") (num_fun mk_bool ( > )); Env.set env (Types.Symbol ">=") (num_fun mk_bool ( >= )); - Env.set env (Types.Symbol "list") (Types.Fn (function xs -> Types.MalList xs)); + Env.set env (Types.Symbol "list") (Types.Fn (function xs -> Types.List xs)); Env.set env (Types.Symbol "list?") - (Types.Fn (function [Types.MalList _] -> Types.Bool true | _ -> Types.Bool false)); + (Types.Fn (function [Types.List _] -> Types.Bool true | _ -> Types.Bool false)); Env.set env (Types.Symbol "empty?") - (Types.Fn (function [Types.MalList []] -> Types.Bool true | _ -> Types.Bool false)); + (Types.Fn (function [Types.List []] -> Types.Bool true | _ -> Types.Bool false)); Env.set env (Types.Symbol "count") - (Types.Fn (function [Types.MalList xs] -> Types.Int (List.length xs) | _ -> Types.Int 0)); + (Types.Fn (function [Types.List xs] -> Types.Int (List.length xs) | _ -> Types.Int 0)); Env.set env (Types.Symbol "=") (Types.Fn (function [a; b] -> Types.Bool (a = b) | _ -> Types.Bool false)); -- cgit v1.2.3 From a878f3bb778513c0cc8bbeb1a8ff61664e43de29 Mon Sep 17 00:00:00 2001 From: Chouser Date: Sun, 25 Jan 2015 23:30:37 -0500 Subject: Ocaml: Use a real map type T.Map is now a real OCaml binary-tree map, and supports arbitrary mal value types for both keys and values. Metadata support is provided in the data objects, but not yet in the printer, reader, or core library. --- ocaml/core.ml | 70 +++++++++++++++++++++++++++++++---------------------------- 1 file changed, 37 insertions(+), 33 deletions(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index db3424a..95e2f4c 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -1,46 +1,50 @@ +module T = Types.Types let ns = Env.make None -let num_fun t f = Types.Fn +let num_fun t f = T.Fn (function - | [(Types.Int a); (Types.Int b)] -> t (f a b) + | [(T.Int a); (T.Int b)] -> t (f a b) | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) -let mk_int x = Types.Int x -let mk_bool x = Types.Bool x +let mk_int x = T.Int x +let mk_bool x = T.Bool x let init env = begin - Env.set env (Types.Symbol "+") (num_fun mk_int ( + )); - Env.set env (Types.Symbol "-") (num_fun mk_int ( - )); - Env.set env (Types.Symbol "*") (num_fun mk_int ( * )); - Env.set env (Types.Symbol "/") (num_fun mk_int ( / )); - Env.set env (Types.Symbol "<") (num_fun mk_bool ( < )); - Env.set env (Types.Symbol "<=") (num_fun mk_bool ( <= )); - Env.set env (Types.Symbol ">") (num_fun mk_bool ( > )); - Env.set env (Types.Symbol ">=") (num_fun mk_bool ( >= )); + Env.set env (Types.symbol "+") (num_fun mk_int ( + )); + Env.set env (Types.symbol "-") (num_fun mk_int ( - )); + Env.set env (Types.symbol "*") (num_fun mk_int ( * )); + Env.set env (Types.symbol "/") (num_fun mk_int ( / )); + Env.set env (Types.symbol "<") (num_fun mk_bool ( < )); + Env.set env (Types.symbol "<=") (num_fun mk_bool ( <= )); + Env.set env (Types.symbol ">") (num_fun mk_bool ( > )); + Env.set env (Types.symbol ">=") (num_fun mk_bool ( >= )); - Env.set env (Types.Symbol "list") (Types.Fn (function xs -> Types.List xs)); - Env.set env (Types.Symbol "list?") - (Types.Fn (function [Types.List _] -> Types.Bool true | _ -> Types.Bool false)); - Env.set env (Types.Symbol "empty?") - (Types.Fn (function [Types.List []] -> Types.Bool true | _ -> Types.Bool false)); - Env.set env (Types.Symbol "count") - (Types.Fn (function [Types.List xs] -> Types.Int (List.length xs) | _ -> Types.Int 0)); - Env.set env (Types.Symbol "=") - (Types.Fn (function [a; b] -> Types.Bool (a = b) | _ -> Types.Bool false)); + Env.set env (Types.symbol "list") (T.Fn (function xs -> Types.list xs)); + Env.set env (Types.symbol "list?") + (T.Fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "empty?") + (T.Fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "count") + (T.Fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); + Env.set env (Types.symbol "=") + (T.Fn (function [a; b] -> T.Bool (a = b) | _ -> T.Bool false)); - Env.set env (Types.Symbol "pr-str") - (Types.Fn (function xs -> - Types.String (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)))); - Env.set env (Types.Symbol "str") - (Types.Fn (function xs -> - Types.String (Printer.join "" (List.map (fun s -> Printer.pr_str s false) xs)))); - Env.set env (Types.Symbol "prn") - (Types.Fn (function xs -> + Env.set env (Types.symbol "pr-str") + (T.Fn (function xs -> + T.String (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)))); + Env.set env (Types.symbol "str") + (T.Fn (function xs -> + T.String (Printer.join "" (List.map (fun s -> Printer.pr_str s false) xs)))); + Env.set env (Types.symbol "prn") + (T.Fn (function xs -> print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)); - Types.Nil)); - Env.set env (Types.Symbol "println") - (Types.Fn (function xs -> + T.Nil)); + Env.set env (Types.symbol "println") + (T.Fn (function xs -> print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s false) xs)); - Types.Nil)); + T.Nil)); + + Env.set env (Types.symbol "compare") + (T.Fn (function [a; b] -> T.Int (compare a b))); end -- cgit v1.2.3 From e64878d0af10d7e391e2070ddd02756042bec7b9 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 26 Jan 2015 19:16:23 -0500 Subject: Ocaml: add meta, with-meta, and ^ reader support --- ocaml/core.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 95e2f4c..f86c3e7 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -45,6 +45,10 @@ let init env = begin T.Nil)); Env.set env (Types.symbol "compare") - (T.Fn (function [a; b] -> T.Int (compare a b))); + (T.Fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); + Env.set env (Types.symbol "with-meta") + (T.Fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); + Env.set env (Types.symbol "meta") + (T.Fn (function [x] -> Printer.meta x | _ -> T.Nil)); end -- cgit v1.2.3 From 04e33074cc516fe4b79a6319c7a211002902a846 Mon Sep 17 00:00:00 2001 From: Chouser Date: Mon, 26 Jan 2015 23:05:13 -0500 Subject: Ocaml: All optional tests passing up thru step 4 --- ocaml/core.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index f86c3e7..5cf06ba 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -27,7 +27,11 @@ let init env = begin Env.set env (Types.symbol "count") (T.Fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); Env.set env (Types.symbol "=") - (T.Fn (function [a; b] -> T.Bool (a = b) | _ -> T.Bool false)); + (T.Fn (function + | [T.List a; T.Vector b] -> T.Bool (a = b) + | [T.Vector a; T.List b] -> T.Bool (a = b) + | [a; b] -> T.Bool (a = b) + | _ -> T.Bool false)); Env.set env (Types.symbol "pr-str") (T.Fn (function xs -> -- cgit v1.2.3 From cc916d9d819d17cc47d34321440bf5a2683eac2e Mon Sep 17 00:00:00 2001 From: Chouser Date: Wed, 28 Jan 2015 08:24:52 -0500 Subject: Ocaml: Use builtin String.concat instead of own join fun --- ocaml/core.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 5cf06ba..f901228 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -35,17 +35,17 @@ let init env = begin Env.set env (Types.symbol "pr-str") (T.Fn (function xs -> - T.String (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)))); + T.String (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)))); Env.set env (Types.symbol "str") (T.Fn (function xs -> - T.String (Printer.join "" (List.map (fun s -> Printer.pr_str s false) xs)))); + T.String (String.concat "" (List.map (fun s -> Printer.pr_str s false) xs)))); Env.set env (Types.symbol "prn") (T.Fn (function xs -> - print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s true) xs)); + print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)); T.Nil)); Env.set env (Types.symbol "println") (T.Fn (function xs -> - print_endline (Printer.join " " (List.map (fun s -> Printer.pr_str s false) xs)); + print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s false) xs)); T.Nil)); Env.set env (Types.symbol "compare") -- cgit v1.2.3 From efb850b5d5f8072c95fd0dc67383ffa308504f7b Mon Sep 17 00:00:00 2001 From: Chouser Date: Wed, 28 Jan 2015 23:43:21 -0500 Subject: Ocaml: Add step 7 --- ocaml/core.ml | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index f901228..a5131ce 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -9,6 +9,13 @@ let num_fun t f = T.Fn let mk_int x = T.Int x let mk_bool x = T.Bool x +let seq = function + | T.List { T.value = xs } -> xs + | T.Vector { T.value = xs } -> xs + | T.Map { T.value = xs } -> + Types.MalMap.fold (fun k v list -> k :: v :: list) xs [] + | _ -> [] + let init env = begin Env.set env (Types.symbol "+") (num_fun mk_int ( + )); Env.set env (Types.symbol "-") (num_fun mk_int ( - )); @@ -54,5 +61,20 @@ let init env = begin (T.Fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); Env.set env (Types.symbol "meta") (T.Fn (function [x] -> Printer.meta x | _ -> T.Nil)); + + Env.set env (Types.symbol "read-string") + (T.Fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); + Env.set env (Types.symbol "slurp") + (T.Fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); + + Env.set env (Types.symbol "cons") + (T.Fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); + Env.set env (Types.symbol "concat") + (T.Fn (let rec concat = + function + | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) + | [x] -> x + | [] -> Types.list [] + in concat)); end -- cgit v1.2.3 From fb21afa71b4f73fa9c05c47e6b1c0f45d2144069 Mon Sep 17 00:00:00 2001 From: Chouser Date: Wed, 29 Jan 2014 20:05:05 -0500 Subject: OCaml: Add Step 8 --- ocaml/core.ml | 63 +++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 26 deletions(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index a5131ce..98f8c8c 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -1,7 +1,7 @@ module T = Types.Types let ns = Env.make None -let num_fun t f = T.Fn +let num_fun t f = Types.fn (function | [(T.Int a); (T.Int b)] -> t (f a b) | _ -> raise (Invalid_argument "Numeric args required for this Mal builtin")) @@ -26,55 +26,66 @@ let init env = begin Env.set env (Types.symbol ">") (num_fun mk_bool ( > )); Env.set env (Types.symbol ">=") (num_fun mk_bool ( >= )); - Env.set env (Types.symbol "list") (T.Fn (function xs -> Types.list xs)); + Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs)); Env.set env (Types.symbol "list?") - (T.Fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); + (Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "empty?") - (T.Fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false)); + (Types.fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "count") - (T.Fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); + (Types.fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); Env.set env (Types.symbol "=") - (T.Fn (function - | [T.List a; T.Vector b] -> T.Bool (a = b) - | [T.Vector a; T.List b] -> T.Bool (a = b) - | [a; b] -> T.Bool (a = b) - | _ -> T.Bool false)); + (Types.fn (function + | [T.List a; T.Vector b] -> T.Bool (a = b) + | [T.Vector a; T.List b] -> T.Bool (a = b) + | [a; b] -> T.Bool (a = b) + | _ -> T.Bool false)); Env.set env (Types.symbol "pr-str") - (T.Fn (function xs -> + (Types.fn (function xs -> T.String (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)))); Env.set env (Types.symbol "str") - (T.Fn (function xs -> + (Types.fn (function xs -> T.String (String.concat "" (List.map (fun s -> Printer.pr_str s false) xs)))); Env.set env (Types.symbol "prn") - (T.Fn (function xs -> + (Types.fn (function xs -> print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s true) xs)); T.Nil)); Env.set env (Types.symbol "println") - (T.Fn (function xs -> + (Types.fn (function xs -> print_endline (String.concat " " (List.map (fun s -> Printer.pr_str s false) xs)); T.Nil)); Env.set env (Types.symbol "compare") - (T.Fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); + (Types.fn (function [a; b] -> T.Int (compare a b) | _ -> T.Nil)); Env.set env (Types.symbol "with-meta") - (T.Fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); + (Types.fn (function [a; b] -> Reader.with_meta a b | _ -> T.Nil)); Env.set env (Types.symbol "meta") - (T.Fn (function [x] -> Printer.meta x | _ -> T.Nil)); + (Types.fn (function [x] -> Printer.meta x | _ -> T.Nil)); Env.set env (Types.symbol "read-string") - (T.Fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); + (Types.fn (function [T.String x] -> Reader.read_str x | _ -> T.Nil)); Env.set env (Types.symbol "slurp") - (T.Fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); + (Types.fn (function [T.String x] -> T.String (Reader.slurp x) | _ -> T.Nil)); Env.set env (Types.symbol "cons") - (T.Fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); + (Types.fn (function [x; xs] -> Types.list (x :: (seq xs)) | _ -> T.Nil)); Env.set env (Types.symbol "concat") - (T.Fn (let rec concat = - function - | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) - | [x] -> x - | [] -> Types.list [] - in concat)); + (Types.fn (let rec concat = + function + | x :: y :: more -> concat ((Types.list ((seq x) @ (seq y))) :: more) + | [x] -> x + | [] -> Types.list [] + in concat)); + + Env.set env (Types.symbol "nth") + (Types.fn (function [xs; T.Int i] -> List.nth (seq xs) i | _ -> T.Nil)); + Env.set env (Types.symbol "first") + (Types.fn (function + | [xs] -> (match seq xs with x :: _ -> x | _ -> T.Nil) + | _ -> T.Nil)); + Env.set env (Types.symbol "rest") + (Types.fn (function + | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) + | _ -> T.Nil)); end -- cgit v1.2.3 From ecd3b6d8e551dd87934142b0323d9b75134bbea9 Mon Sep 17 00:00:00 2001 From: Chouser Date: Thu, 29 Jan 2015 23:29:54 -0500 Subject: OCaml: Add step 9 --- ocaml/core.ml | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 106 insertions(+), 1 deletion(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 98f8c8c..49041d8 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -16,6 +16,38 @@ let seq = function Types.MalMap.fold (fun k v list -> k :: v :: list) xs [] | _ -> [] +let rec assoc = function + | c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs) + | [T.Map { T.value = m; T.meta = meta }; k; v] + -> T.Map { T.value = (Types.MalMap.add k v m); + T.meta = meta; + T.is_macro = false} + | _ -> T.Nil + +let rec dissoc = function + | c :: x :: (_ :: _ as xs) -> dissoc ((dissoc [c; x]) :: xs) + | [T.Map { T.value = m; T.meta = meta }; k] + -> T.Map { T.value = (Types.MalMap.remove k m); + T.meta = meta; + T.is_macro = false} + | _ -> T.Nil + +let rec conj = function + | c :: x :: (_ :: _ as xs) -> conj ((conj [c; x]) :: xs) + | [T.Map { T.value = c; T.meta = meta }; T.Vector { T.value = [k; v] }] + -> T.Map { T.value = (Types.MalMap.add k v c); + T.meta = meta; + T.is_macro = false} + | [T.List { T.value = c; T.meta = meta }; x ] + -> T.List { T.value = x :: c; + T.meta = meta; + T.is_macro = false} + | [T.Vector { T.value = c; T.meta = meta }; x ] + -> T.Vector { T.value = c @ [x]; + T.meta = meta; + T.is_macro = false} + | _ -> T.Nil + let init env = begin Env.set env (Types.symbol "+") (num_fun mk_int ( + )); Env.set env (Types.symbol "-") (num_fun mk_int ( - )); @@ -29,6 +61,9 @@ let init env = begin Env.set env (Types.symbol "list") (Types.fn (function xs -> Types.list xs)); Env.set env (Types.symbol "list?") (Types.fn (function [T.List _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "vector") (Types.fn (function xs -> Types.vector xs)); + Env.set env (Types.symbol "vector?") + (Types.fn (function [T.Vector _] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "empty?") (Types.fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "count") @@ -87,5 +122,75 @@ let init env = begin (Types.fn (function | [xs] -> Types.list (match seq xs with _ :: xs -> xs | _ -> []) | _ -> T.Nil)); -end + Env.set env (Types.symbol "symbol") + (Types.fn (function [T.String x] -> Types.symbol x | _ -> T.Nil)); + Env.set env (Types.symbol "symbol?") + (Types.fn (function [T.Symbol _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "keyword") + (Types.fn (function [T.String x] -> T.Keyword x | _ -> T.Nil)); + Env.set env (Types.symbol "keyword?") + (Types.fn (function [T.Keyword _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "nil?") + (Types.fn (function [T.Nil] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "true?") + (Types.fn (function [T.Bool true] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "false?") + (Types.fn (function [T.Bool false] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "sequential?") + (Types.fn (function [T.List _] | [T.Vector _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "apply") + (Types.fn (function + | (T.Fn { T.value = f } :: apply_args) -> + (match List.rev apply_args with + | last_arg :: rev_args -> + f ((List.rev rev_args) @ (seq last_arg)) + | [] -> f []) + | _ -> raise (Invalid_argument "First arg to apply must be a fn"))); + Env.set env (Types.symbol "map") + (Types.fn (function + | [T.Fn { T.value = f }; xs] -> + Types.list (List.map (fun x -> f [x]) (seq xs)) + | _ -> T.Nil)); + Env.set env (Types.symbol "readline") + (Types.fn (function + | [T.String x] -> print_string x; T.String (read_line ()) + | _ -> T.String (read_line ()))); + + Env.set env (Types.symbol "map?") + (Types.fn (function [T.Map _] -> T.Bool true | _ -> T.Bool false)); + Env.set env (Types.symbol "hash-map") + (Types.fn (function xs -> Types.list_into_map Types.MalMap.empty xs)); + Env.set env (Types.symbol "assoc") (Types.fn assoc); + Env.set env (Types.symbol "dissoc") (Types.fn dissoc); + Env.set env (Types.symbol "get") + (Types.fn (function + | [T.Map { T.value = m }; k] + -> (try Types.MalMap.find k m with _ -> T.Nil) + | _ -> T.Nil)); + Env.set env (Types.symbol "keys") + (Types.fn (function + | [T.Map { T.value = m }] + -> Types.list (Types.MalMap.fold (fun k _ c -> k :: c) m []) + | _ -> T.Nil)); + Env.set env (Types.symbol "vals") + (Types.fn (function + | [T.Map { T.value = m }] + -> Types.list (Types.MalMap.fold (fun _ v c -> v :: c) m []) + | _ -> T.Nil)); + Env.set env (Types.symbol "contains?") + (Types.fn (function + | [T.Map { T.value = m }; k] -> T.Bool (Types.MalMap.mem k m) + | _ -> T.Bool false)); + Env.set env (Types.symbol "conj") (Types.fn conj); + + Env.set env (Types.symbol "atom") + (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil)); + Env.set env (Types.symbol "deref") + (Types.fn (function [T.Atom x] -> !x | _ -> T.Nil)); + Env.set env (Types.symbol "reset!") + (Types.fn (function [T.Atom x; v] -> x := v; v | _ -> T.Nil)); + Env.set env (Types.symbol "swap!") + (Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args + -> let v = f (!x :: args) in x := v; v | _ -> T.Nil)); +end -- cgit v1.2.3 From fd3adc525489857e2db66fd905e829d38364f777 Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 30 Jan 2015 00:17:57 -0500 Subject: OCaml: self-hosting --- ocaml/core.ml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 49041d8..19763fa 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -49,6 +49,9 @@ let rec conj = function | _ -> T.Nil let init env = begin + Env.set env (Types.symbol "throw") + (Types.fn (function [ast] -> raise (Types.MalExn ast) | _ -> T.Nil)); + Env.set env (Types.symbol "+") (num_fun mk_int ( + )); Env.set env (Types.symbol "-") (num_fun mk_int ( - )); Env.set env (Types.symbol "*") (num_fun mk_int ( * )); @@ -67,7 +70,10 @@ let init env = begin Env.set env (Types.symbol "empty?") (Types.fn (function [T.List {T.value = []}] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "count") - (Types.fn (function [T.List {T.value = xs}] -> T.Int (List.length xs) | _ -> T.Int 0)); + (Types.fn (function + | [T.List {T.value = xs}] + | [T.Vector {T.value = xs}] -> T.Int (List.length xs) + | _ -> T.Int 0)); Env.set env (Types.symbol "=") (Types.fn (function | [T.List a; T.Vector b] -> T.Bool (a = b) @@ -184,6 +190,8 @@ let init env = begin | _ -> T.Bool false)); Env.set env (Types.symbol "conj") (Types.fn conj); + Env.set env (Types.symbol "atom?") + (Types.fn (function [T.Atom _] -> T.Bool true | _ -> T.Bool false)); Env.set env (Types.symbol "atom") (Types.fn (function [x] -> T.Atom (ref x) | _ -> T.Nil)); Env.set env (Types.symbol "deref") -- cgit v1.2.3 From 2b8e0ea42046505635e8f4c9d96e594c595948c2 Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 30 Jan 2015 09:10:24 -0500 Subject: OCaml: put macro flag in metadata rather than special type field --- ocaml/core.ml | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 19763fa..6d7b014 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -18,34 +18,30 @@ let seq = function let rec assoc = function | c :: k :: v :: (_ :: _ as xs) -> assoc ((assoc [c; k; v]) :: xs) + | [T.Nil; k; v] -> Types.map (Types.MalMap.add k v Types.MalMap.empty) | [T.Map { T.value = m; T.meta = meta }; k; v] -> T.Map { T.value = (Types.MalMap.add k v m); - T.meta = meta; - T.is_macro = false} + T.meta = meta } | _ -> T.Nil let rec dissoc = function | c :: x :: (_ :: _ as xs) -> dissoc ((dissoc [c; x]) :: xs) | [T.Map { T.value = m; T.meta = meta }; k] -> T.Map { T.value = (Types.MalMap.remove k m); - T.meta = meta; - T.is_macro = false} + T.meta = meta } | _ -> T.Nil let rec conj = function | c :: x :: (_ :: _ as xs) -> conj ((conj [c; x]) :: xs) | [T.Map { T.value = c; T.meta = meta }; T.Vector { T.value = [k; v] }] -> T.Map { T.value = (Types.MalMap.add k v c); - T.meta = meta; - T.is_macro = false} + T.meta = meta } | [T.List { T.value = c; T.meta = meta }; x ] -> T.List { T.value = x :: c; - T.meta = meta; - T.is_macro = false} + T.meta = meta } | [T.Vector { T.value = c; T.meta = meta }; x ] -> T.Vector { T.value = c @ [x]; - T.meta = meta; - T.is_macro = false} + T.meta = meta } | _ -> T.Nil let init env = begin -- cgit v1.2.3 From f5fc0c98ee9c140077469146bbc9d8a77fdb02f3 Mon Sep 17 00:00:00 2001 From: Chouser Date: Fri, 30 Jan 2015 12:38:32 -0500 Subject: OCaml: Add time-ms --- ocaml/core.ml | 3 +++ 1 file changed, 3 insertions(+) (limited to 'ocaml/core.ml') diff --git a/ocaml/core.ml b/ocaml/core.ml index 6d7b014..20f68b6 100644 --- a/ocaml/core.ml +++ b/ocaml/core.ml @@ -197,4 +197,7 @@ let init env = begin Env.set env (Types.symbol "swap!") (Types.fn (function T.Atom x :: T.Fn { T.value = f } :: args -> let v = f (!x :: args) in x := v; v | _ -> T.Nil)); + + Env.set env (Types.symbol "time-ms") + (Types.fn (function _ -> T.Int (truncate (1000.0 *. Unix.gettimeofday ())))); end -- cgit v1.2.3