forth, skew, tcl: Add number?, fn?, macro?

ragne · Oct 14, 2017 · c91c8de · c91c8de
1 parent 69edbad
commit c91c8de
Show file tree

Hide file tree

Showing 4 changed files with 47 additions and 0 deletions.
diff --git a/forth/core.fs b/forth/core.fs
@@ -218,6 +218,25 @@ defcore atom?    drop @ mal-type @ Atom       = mal-bool ;;
 defcore true?    drop @ mal-true  = mal-bool ;;
 defcore false?   drop @ mal-false = mal-bool ;;
 defcore nil?     drop @ mal-nil   = mal-bool ;;
+defcore number?  drop @ mal-type @ MalInt = mal-bool ;;
+defcore fn?
+    drop @
+    dup mal-type @ MalUserFn = if
+        MalUserFn/is-macro? @ if
+            mal-false
+        else
+            mal-true
+        endif
+    else
+        mal-type @ MalNativeFn = if
+            mal-true
+        else
+            mal-false
+        endif
+    endif ;;
+defcore macro?   drop @ dup mal-type @ MalUserFn =
+                        swap MalUserFn/is-macro? @
+                        and mal-bool ;;
 
 defcore sequential? drop @ sequential? ;;
 

diff --git a/skew/core.sk b/skew/core.sk
@@ -16,6 +16,10 @@ const ns StringMap<fn(List<MalVal>) MalVal> = {
   "symbol?":  (a List<MalVal>) => MalVal.fromBool(a[0] is MalSymbol),
   "keyword":  (a List<MalVal>) => MalKeyword.new((a[0] as MalString).val),
   "keyword?": (a List<MalVal>) => MalVal.fromBool(a[0] is MalKeyword),
+  "number?":  (a List<MalVal>) => MalVal.fromBool(a[0] is MalNumber),
+  "fn?":      (a List<MalVal>) => MalVal.fromBool(a[0] is MalNativeFunc ||
+                                                  (a[0] is MalFunc && !(a[0] as MalFunc).isMacro)),
+  "macro?":   (a List<MalVal>) => MalVal.fromBool(a[0] is MalFunc && (a[0] as MalFunc).isMacro),
 
   "pr-str":  (a List<MalVal>) => MalString.new(" ".join(a.map<string>(e => pr_str(e, true)))),
   "str":     (a List<MalVal>) => MalString.new("".join(a.map<string>(e => pr_str(e, false)))),

diff --git a/tcl/core.tcl b/tcl/core.tcl
@@ -40,6 +40,23 @@ proc mal_keyword_q {a} {
     bool_new [keyword_q [lindex $a 0]]
 }
 
+proc mal_number_q {a} {
+    bool_new [integer_q [lindex $a 0]]
+}
+
+proc mal_fn_q {a} {
+    set f [lindex $a 0]
+    switch [obj_type $f] {
+        function { return [bool_new [expr {![macro_q $f]}]] }
+        nativefunction { return $::mal_true }
+        default { return $::mal_false }
+    }
+}
+
+proc mal_macro_q {a} {
+    bool_new [macro_q [lindex $a 0]]
+}
+
 proc render_array {arr readable delim} {
     set res {}
     foreach e $arr {
@@ -383,6 +400,9 @@ set core_ns [dict create \
     "string?"      [nativefunction_new mal_string_q] \
     "keyword"      [nativefunction_new mal_keyword] \
     "keyword?"     [nativefunction_new mal_keyword_q] \
+    "number?"      [nativefunction_new mal_number_q] \
+    "fn?"          [nativefunction_new mal_fn_q] \
+    "macro?"       [nativefunction_new mal_macro_q] \
     \
     "pr-str"       [nativefunction_new mal_pr_str] \
     "str"          [nativefunction_new mal_str] \

diff --git a/tcl/types.tcl b/tcl/types.tcl
@@ -73,6 +73,10 @@ proc integer_new {num} {
     obj_new "integer" $num
 }
 
+proc integer_q {obj} {
+    expr {[obj_type $obj] == "integer"}
+}
+
 proc symbol_new {name} {
     obj_new "symbol" $name
 }