awk, ocaml: Add number?, fn?, macro?

ragne · Oct 15, 2017 · d90be1a · d90be1a
1 parent c91c8de
commit d90be1a
Show file tree

Hide file tree

Showing 5 changed files with 50 additions and 12 deletions.
diff --git a/awk/core.awk b/awk/core.awk
@@ -127,6 +127,32 @@ function core_keywordp(idx)
 	return types_heap[idx][1] ~ /^:/ ? "#true" : "#false"
 }
 
+function core_numberp(idx)
+{
+	if (types_heap[idx]["len"] != 2) {
+		return "!\"Invalid argument length for builtin function 'number?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
+	}
+	return types_heap[idx][1] ~ /^\+/ ? "#true" : "#false"
+}
+
+function core_fnp(idx)
+{
+	if (types_heap[idx]["len"] != 2) {
+		return "!\"Invalid argument length for builtin function 'fn?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
+	}
+	f = types_heap[idx][1]
+	return f ~ /^[$&%]/ && !types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false"
+}
+
+function core_macrop(idx)
+{
+	if (types_heap[idx]["len"] != 2) {
+		return "!\"Invalid argument length for builtin function 'macro?'. Expects exactly 1 argument, supplied " (types_heap[idx]["len"] - 1) "."
+	}
+	f = types_heap[idx][1]
+	return f ~ /^\$/ && types_heap[substr(f, 2)]["is_macro"] ? "#true" : "#false"
+}
+
 
 
 function core_pr_str(idx,    i, len, result)
@@ -1028,6 +1054,9 @@ function core_init()
 	core_ns["'symbol?"] = "&core_symbolp"
 	core_ns["'keyword"] = "&core_keyword"
 	core_ns["'keyword?"] = "&core_keywordp"
+	core_ns["'number?"] = "&core_numberp"
+	core_ns["'fn?"] = "&core_fnp"
+	core_ns["'macro?"] = "&core_macrop"
 
 	core_ns["'pr-str"] = "&core_pr_str"
 	core_ns["'str"] = "&core_str"

diff --git a/ocaml/core.ml b/ocaml/core.ml
@@ -1,6 +1,8 @@
 module T = Types.Types
 let ns = Env.make None
 
+let kw_macro = T.Keyword "macro"
+
 let num_fun t f = Types.fn
   (function
     | [(T.Int a); (T.Int b)] -> t (f a b)
@@ -146,6 +148,19 @@ let init env = begin
     (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 "number?")
+    (Types.fn (function [T.Int _] -> T.Bool true | _ -> T.Bool false));
+  Env.set env (Types.symbol "fn?")
+    (Types.fn (function
+                | [T.Fn { T.meta = T.Map { T.value = meta } }]
+                  -> mk_bool (not (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)))
+                | [T.Fn _] -> T.Bool true
+                | _ -> T.Bool false));
+  Env.set env (Types.symbol "macro?")
+    (Types.fn (function
+                | [T.Fn { T.meta = T.Map { T.value = meta } }]
+                  -> mk_bool (Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta))
+                | _ -> 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?")

diff --git a/ocaml/step8_macros.ml b/ocaml/step8_macros.ml
@@ -14,14 +14,12 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let kw_macro = T.Keyword "macro"
-
 let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
       | T.Fn { T.meta = T.Map { T.value = meta } }
-        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+        -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta)
       | _ -> false)
   | _ -> false
 
@@ -61,7 +59,7 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]}
              in Env.set env key fn; fn
           | _ -> raise (Invalid_argument "defmacro! value must be a fn"))
     | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }

diff --git a/ocaml/step9_try.ml b/ocaml/step9_try.ml
@@ -14,14 +14,12 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let kw_macro = T.Keyword "macro"
-
 let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
       | T.Fn { T.meta = T.Map { T.value = meta } }
-        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+        -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta)
       | _ -> false)
   | _ -> false
 
@@ -61,7 +59,7 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]}
              in Env.set env key fn; fn
           | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
     | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }

diff --git a/ocaml/stepA_mal.ml b/ocaml/stepA_mal.ml
@@ -14,14 +14,12 @@ let rec quasiquote ast =
        Types.list [Types.symbol "cons"; quasiquote head; quasiquote (Types.list tail) ]
     | ast -> Types.list [Types.symbol "quote"; ast]
 
-let kw_macro = T.Keyword "macro"
-
 let is_macro_call ast env =
   match ast with
   | T.List { T.value = s :: args } ->
      (match (try Env.get env s with _ -> T.Nil) with
       | T.Fn { T.meta = T.Map { T.value = meta } }
-        -> Types.MalMap.mem kw_macro meta && Types.to_bool (Types.MalMap.find kw_macro meta)
+        -> Types.MalMap.mem Core.kw_macro meta && Types.to_bool (Types.MalMap.find Core.kw_macro meta)
       | _ -> false)
   | _ -> false
 
@@ -61,7 +59,7 @@ and eval ast env =
     | T.List { T.value = [(T.Symbol { T.value = "defmacro!" }); key; expr] } ->
        (match (eval expr env) with
           | T.Fn { T.value = f; T.meta = meta } ->
-             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; kw_macro; (T.Bool true)]}
+             let fn = T.Fn { T.value = f; meta = Core.assoc [meta; Core.kw_macro; (T.Bool true)]}
              in Env.set env key fn; fn
           | _ -> raise (Invalid_argument "devmacro! value must be a fn"))
     | T.List { T.value = [(T.Symbol { T.value = "let*" }); (T.Vector { T.value = bindings }); body] }