Skip to content

Commit

Permalink
Merge branch 'main' of github.com:jank-lang/jank
Browse files Browse the repository at this point in the history
  • Loading branch information
@jeaye
jeaye committed May 6, 2024
2 parents ff71918 + 15ed005 commit b803861
Show file tree
Hide file tree
Showing 2 changed files with 230 additions and 6 deletions.
10 changes: 4 additions & 6 deletions src/cpp/jank/codegen/processor.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -905,11 +905,10 @@ namespace jank::codegen
}
else if(ref->qualified_name->equal(runtime::obj::symbol{ "clojure.core", ">" }))
{
/* TODO: Use lt and reverse args. */
format_elided_var("jank::runtime::gt(",
format_elided_var("jank::runtime::lt(",
")",
ret_tmp.str(false),
expr.arg_exprs,
{ expr.arg_exprs.rbegin(), expr.arg_exprs.rend() },
fn_arity,
false,
box_needed);
Expand All @@ -918,11 +917,10 @@ namespace jank::codegen
}
else if(ref->qualified_name->equal(runtime::obj::symbol{ "clojure.core", ">=" }))
{
/* TODO: Use lte and reverse args. */
format_elided_var("jank::runtime::gte(",
format_elided_var("jank::runtime::lte(",
")",
ret_tmp.str(false),
expr.arg_exprs,
{ expr.arg_exprs.rbegin(), expr.arg_exprs.rend() },
fn_arity,
false,
box_needed);
Expand Down
226 changes: 226 additions & 0 deletions src/jank/clojure/core.jank
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1608,6 +1608,29 @@
([f arg1 arg2 arg3 & more]
(fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))

(defn fnil
"Takes a function f, and returns a function that calls f, replacing
a nil first argument to f with the supplied value x. Higher arity
versions can replace arguments in the second and third
positions (y, z). Note that the function f can take any number of
arguments, not just the one(s) being nil-patched."
([f x]
(fn
([a] (f (if (nil? a) x a)))
([a b] (f (if (nil? a) x a) b))
([a b c] (f (if (nil? a) x a) b c))
([a b c & ds] (apply f (if (nil? a) x a) b c ds))))
([f x y]
(fn
([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
([a b c] (f (if (nil? a) x a) (if (nil? b) y b) c))
([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) c ds))))
([f x y z]
(fn
([a b] (f (if (nil? a) x a) (if (nil? b) y b)))
([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))
([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))

; Returns the first logical true value of (pred x) for any x in coll,
; else nil. One common idiom is to use a set as pred, for example
; this will return :fred if :fred is in the sequence, otherwise nil:
Expand All @@ -1617,6 +1640,86 @@
(when s
(or (pred (first s)) (recur pred (next s))))))


(defn every-pred
"Takes a set of predicates and returns a function f that returns true if all of its
composing predicates return a logical true value against all of its arguments, else it returns
false. Note that f is short-circuiting in that it will stop execution on the first
argument that triggers a logical false result against the original predicates."
([p]
(fn ep1
([] true)
([x] (boolean (p x)))
([x y] (boolean (and (p x) (p y))))
([x y z] (boolean (and (p x) (p y) (p z))))
([x y z & args] (boolean (and (ep1 x y z)
(every? p args))))))
([p1 p2]
(fn ep2
([] true)
([x] (boolean (and (p1 x) (p2 x))))
([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y))))
([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))))
([x y z & args] (boolean (and (ep2 x y z)
(every? #(and (p1 %) (p2 %)) args))))))
([p1 p2 p3]
(fn ep3
([] true)
([x] (boolean (and (p1 x) (p2 x) (p3 x))))
([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y))))
([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z))))
([x y z & args] (boolean (and (ep3 x y z)
(every? #(and (p1 %) (p2 %) (p3 %)) args))))))
([p1 p2 p3 & ps]
(let [ps (list* p1 p2 p3 ps)]
(fn epn
([] true)
([x] (every? #(% x) ps))
([x y] (every? #(and (% x) (% y)) ps))
([x y z] (every? #(and (% x) (% y) (% z)) ps))
([x y z & args] (boolean (and (epn x y z)
(every? #(every? % args) ps))))))))

(defn some-fn
"Takes a set of predicates and returns a function f that returns the first logical true value
returned by one of its composing predicates against any of its arguments, else it returns
logical false. Note that f is short-circuiting in that it will stop execution on the first
argument that triggers a logical true result against the original predicates."
([p]
(fn sp1
([] nil)
([x] (p x))
([x y] (or (p x) (p y)))
([x y z] (or (p x) (p y) (p z)))
([x y z & args] (or (sp1 x y z)
(some p args)))))
([p1 p2]
(fn sp2
([] nil)
([x] (or (p1 x) (p2 x)))
([x y] (or (p1 x) (p1 y) (p2 x) (p2 y)))
([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))
([x y z & args] (or (sp2 x y z)
(some #(or (p1 %) (p2 %)) args)))))
([p1 p2 p3]
(fn sp3
([] nil)
([x] (or (p1 x) (p2 x) (p3 x)))
([x y] (or (p1 x) (p1 y) (p2 x) (p2 y) (p3 x) (p3 y)))
([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z) (p3 x) (p3 y) (p3 z)))
([x y z & args] (or (sp3 x y z)
(some #(or (p1 %) (p2 %) (p3 %)) args)))))
([p1 p2 p3 & ps]
(let [ps (list* p1 p2 p3 ps)]
(fn spn
([] nil)
([x] (some #(% x) ps))
([x y] (some #(or (% x) (% y)) ps))
([x y z] (some #(or (% x) (% y) (% z)) ps))
([x y z & args] (or (spn x y z)
(some #(some % args) ps)))))))


(defn not-any? [pred coll]
(not (some pred coll)))

Expand Down Expand Up @@ -2585,6 +2688,18 @@
(assoc counts x (inc (get counts x 0))))
{} coll))

(defn group-by
"Returns a map of the elements of coll keyed by the result of
f on each element. The value at each key will be a vector of the
corresponding elements, in the order they appeared in coll."
[f coll]
;; OPTIMIZE: transient
(reduce
(fn [ret x]
(let [k (f x)]
(assoc ret k (conj (get ret k []) x))))
{} coll))

(defn reductions
"Returns a lazy seq of the intermediate values of the reduction (as
per reduce) of coll by f, starting with init."
Expand Down Expand Up @@ -2924,6 +3039,64 @@
`(let [iter# ~(emit-bind (to-groups seq-exprs))]
(iter# ~(second seq-exprs)))))

(defn not-empty
[coll] (when (seq coll) coll))

(defn get-in
"Returns the value in a nested associative structure,
where ks is a sequence of keys. Returns nil if the key
is not present, or the not-found value if supplied."
([m ks]
(reduce get m ks))
([m ks not-found]
(loop [m m
ks (seq ks)]
(if ks
(let [m (get m (first ks) ::none)]
(if (identical? ::none m)
not-found
(recur m (next ks))))
m))))

(defn assoc-in
"Associates a value in a nested associative structure, where ks is a
sequence of keys and v is the new value and returns a new nested structure.
If any levels do not exist, hash-maps will be created."
[m [k & ks] v]
(if ks
(assoc m k (assoc-in (get m k) ks v))
(assoc m k v)))

(defn update-in
"'Updates' a value in a nested associative structure, where ks is a
sequence of keys and f is a function that will take the old value
and any supplied args and return the new value, and returns a new
nested structure. If any levels do not exist, hash-maps will be
created."
[m ks f & args]
(let [up (fn up [m ks f args]
(let [[k & ks] ks]
(if ks
(assoc m k (up (get m k) ks f args))
(assoc m k (apply f (get m k) args)))))]
(up m ks f args)))

(defn update
"'Updates' a value in an associative structure, where k is a
key and f is a function that will take the old value
and any supplied args and return the new value, and returns a new
structure. If the key does not exist, nil is passed as the old value."
([m k f]
(assoc m k (f (get m k))))
([m k f x]
(assoc m k (f (get m k) x)))
([m k f x y]
(assoc m k (f (get m k) x y)))
([m k f x y z]
(assoc m k (f (get m k) x y z)))
([m k f x y z & more]
(assoc m k (apply f (get m k) x y z more))))

(defmacro when-first
"bindings => x xs
Expand Down Expand Up @@ -3130,6 +3303,59 @@
g
(last steps)))))

(defmacro cond->>
"Takes an expression and a set of test/form pairs. Threads expr (via ->>)
through each form for which the corresponding test expression
is true. Note that, unlike cond branching, cond->> threading does not short circuit
after the first true test expression."
[expr & clauses]
(assert (even? (count clauses)))
(let [g (gensym)
steps (map (fn [[test step]] `(if ~test (->> ~g ~step) ~g))
(partition 2 clauses))]
`(let [~g ~expr
~@(interleave (repeat g) (butlast steps))]
~(if (empty? steps)
g
(last steps)))))

(defmacro as->
"Binds name to expr, evaluates the first form in the lexical context
of that binding, then binds name to that result, repeating for each
successive form, returning the result of the last form."
[expr name & forms]
`(let [~name ~expr
~@(interleave (repeat name) (butlast forms))]
~(if (empty? forms)
name
(last forms))))

(defmacro some->
"When expr is not nil, threads it into the first form (via ->),
and when that result is not nil, through the next etc"
[expr & forms]
(let [g (gensym)
steps (map (fn [step] `(if (nil? ~g) nil (-> ~g ~step)))
forms)]
`(let [~g ~expr
~@(interleave (repeat g) (butlast steps))]
~(if (empty? steps)
g
(last steps)))))

(defmacro some->>
"When expr is not nil, threads it into the first form (via ->>),
and when that result is not nil, through the next etc"
[expr & forms]
(let [g (gensym)
steps (map (fn [step] `(if (nil? ~g) nil (->> ~g ~step)))
forms)]
`(let [~g ~expr
~@(interleave (repeat g) (butlast steps))]
~(if (empty? steps)
g
(last steps)))))

;; Functions.
(defn ifn? [o]
(native/raw "__value = make_box
Expand Down

0 comments on commit b803861

Please sign in to comment.