diff --git a/src/boot/boot.janet b/src/boot/boot.janet index bc214db4..e822adb1 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -103,23 +103,13 @@ (defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol)) (defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword)) (defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer)) -(defn function? "Check if x is a function (not a cfunction)." [x] - (= (type x) :function)) +(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function)) (defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction)) (defn table? "Check if x a table." [x] (= (type x) :table)) (defn struct? "Check if x a struct." [x] (= (type x) :struct)) (defn array? "Check if x is an array." [x] (= (type x) :array)) (defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple)) (defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean)) -(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x] - (def t (type x)) - (if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer))))) -(defn dictionary? "Check if x is a table or struct." [x] - (def t (type x)) - (if (= t :table) true (= t :struct))) -(defn indexed? "Check if x is an array or tuple." [x] - (def t (type x)) - (if (= t :array) true (= t :tuple))) (defn truthy? "Check if x is truthy." [x] (if x true false)) (defn true? "Check if x is true." [x] (= x true)) (defn false? "Check if x is false." [x] (= x false)) @@ -749,6 +739,14 @@ ## Polymorphic comparisons +(defmacro- do-compare + [x y] + ~(if (def f (get ,x :compare)) + (f ,x ,y) + (if (def f (get ,y :compare)) + (- (f ,y ,x)) + (cmp ,x ,y)))) + (defn compare ``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively. Differs from the primitive comparators in that it first checks to @@ -756,20 +754,18 @@ compare x and y. If so, it uses that method. If not, it delegates to the primitive comparators.`` [x y] - (or - (when-let [f (get x :compare)] (f x y)) - (when-let [f (get y :compare)] (- (f y x))) - (cmp x y))) + (do-compare x y)) -(defn- compare-reduce [op xs] - (var r true) - (loop [i :range [0 (- (length xs) 1)] - :let [c (compare (xs i) (xs (+ i 1))) - ok (op c 0)] - :when (not ok)] - (set r false) - (break)) - r) +(defmacro- compare-reduce [op xs] + ~(do + (var res true) + (var x (get ,xs 0)) + (forv i 1 (length ,xs) + (let [y (in ,xs i)] + (if (,op (do-compare x y) 0) + (set x y) + (do (set res false) (break))))) + res)) (defn compare= ``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.`` diff --git a/src/core/corelib.c b/src/core/corelib.c index 0241f7d1..30f417bc 100644 --- a/src/core/corelib.c +++ b/src/core/corelib.c @@ -659,6 +659,27 @@ ret_false: return janet_wrap_false(); } +JANET_CORE_FN(janet_core_is_bytes, + "(bytes? x)", + "Check if x is a string, symbol, keyword, or buffer.") { + janet_fixarity(argc, 1); + return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES)); +} + +JANET_CORE_FN(janet_core_is_indexed, + "(indexed? x)", + "Check if x is an array or tuple.") { + janet_fixarity(argc, 1); + return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED)); +} + +JANET_CORE_FN(janet_core_is_dictionary, + "(dictionary? x)", + "Check if x is a table or struct.") { + janet_fixarity(argc, 1); + return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY)); +} + JANET_CORE_FN(janet_core_signal, "(signal what x)", "Raise a signal with payload x. ") { @@ -1053,6 +1074,9 @@ static void janet_load_libs(JanetTable *env) { JANET_CORE_REG("module/expand-path", janet_core_expand_path), JANET_CORE_REG("int?", janet_core_check_int), JANET_CORE_REG("nat?", janet_core_check_nat), + JANET_CORE_REG("bytes?", janet_core_is_bytes), + JANET_CORE_REG("indexed?", janet_core_is_indexed), + JANET_CORE_REG("dictionary?", janet_core_is_dictionary), JANET_CORE_REG("slice", janet_core_slice), JANET_CORE_REG("range", janet_core_range), JANET_CORE_REG("signal", janet_core_signal),