(hidden thread-first-internal) (defndynamic thread-first-internal [xs] (if (= (length xs) 2) (if (list? (last xs)) (cons (caadr xs) (cons (car xs) (cdadr xs))) (list (cadr xs) (car xs))) (if (list? (last xs)) (append (list (car (last xs)) (thread-first-internal (all-but-last xs))) (cdr (last xs))) (list (last xs) (thread-first-internal (all-but-last xs)))))) (hidden thread-last-internal) (defndynamic thread-last-internal [xs] (if (= (length xs) 2) (if (list? (last xs)) (cons-last (car xs) (last xs)) (list (cadr xs) (car xs))) (if (list? (last xs)) (cons-last (thread-last-internal (all-but-last xs)) (last xs)) (list (last xs) (thread-last-internal (all-but-last xs)))))) (deprecated => "deprecated in favor of `->`.") (defmacro => [:rest forms] (thread-first-internal forms)) (deprecated ==> "deprecated in favor of `-->`.") (defmacro ==> [:rest forms] (thread-last-internal forms)) (doc -> "threads the first form through the following ones, making it the first argument. Example: ``` (-> 1 (- 10) (* 5) ) ; => -45 ```") (defmacro -> [:rest forms] (thread-first-internal forms)) (doc --> "threads the first form through the following ones, making it the last argument. Example: ``` (--> 1 (- 10) (/ 45) ) ; => 5 ```") (defmacro --> [:rest forms] (thread-last-internal forms)) (hidden comp-internal) (defndynamic comp-internal [sym fns] (if (= (length fns) 0) sym (list (car fns) (comp-internal sym (cdr fns))))) (doc comp "Composes the functions `fns` into one `fn`.") (defmacro comp [:rest fns] (let [x (gensym)] (list 'fn [x] (comp-internal x fns)))) (doc doto "Evaluates `thing`, then calls all of the functions on it and" "returns it. Useful for chaining mutating, imperative functions, and thus" "similar to `->`. If you need `thing` to be passed as a `ref` into `expressions`" "functions, use [`doto-ref`](#doto-ref) instead." "" "```" "(let [x @\"hi\"]" " @(doto &x" " (string-set! 0 \o)" " (string-set! 1 \y)))" "```") (defmacro doto [thing :rest expressions] (let [s (gensym)] (list 'let [s thing] (cons-last s (cons 'do (map (fn [expr] (cons (car expr) (cons s (cdr expr)))) expressions)))))) (doc doto-ref "Evaluates `thing`, then calls all of the functions on it and" "returns it. Useful for chaining mutating, imperative functions, and thus" "similar to `->`. If you need `thing` not to be passed as a `ref` into" "`expressions` functions, use [`doto`](#doto) instead." "" "```" "(doto-ref @\"hi\"" " (string-set! 0 \o)" " (string-set! 1 \y))" "```") (defmacro doto-ref [thing :rest expressions] (let [s (gensym)] (list 'let [s thing] (cons-last s (cons 'do (map (fn [expr] (cons (car expr) (cons (list 'ref s) (cdr expr)))) expressions)))))) (doc until "Executes `body` until the condition `cnd` is true.") (defmacro until [cnd body] (list 'while (list 'not cnd) body)) (doc let-do "is a `let` with an implicit `do` body.") (defmacro let-do [bindings :rest forms] (list 'let bindings (cons 'do forms))) (doc while-do "is a `while` with an implicit `do` body.") (defmacro while-do [condition :rest forms] (list 'while condition (cons 'do forms))) (doc defn-do "is a `defn` with an implicit `do` body.") (defmacro defn-do [name arguments :rest body] (eval (list 'defn name arguments (cons 'do body)))) (doc forever-do "is a `forever` with an implicit `do` body.") (defmacro forever-do [:rest forms] (list 'while true (cons 'do forms))) (doc ignore-do ("Wraps side-effecting `forms` in a `do`, " false) "ignoring all of their results." "In other words, executes `forms` only for their side effects.") (defmacro ignore-do [:rest forms] (cons 'do (expand (apply ignore* forms)))) (doc when "is an `if` without an else branch.") (defmacro when [condition form] (list 'if condition form (list))) (doc unless "is an `if` without a then branch.") (defmacro unless [condition form] (list 'if condition (list) form)) (hidden treat-case-handler) (defndynamic treat-case-handler [name handler] (if (and (list? handler) (> (length handler) 1) (= ':or (car handler))) (cons 'or (map (fn [val] (list '= name val)) (cdr handler))) (list '= name handler))) (hidden case-internal) (defndynamic case-internal [name xs] (if (= (length xs) 0) (list) (if (= (length xs) 2) (macro-error "case has even number of branches; add an else branch") (if (= (length xs) 1) (car xs) (list 'if (treat-case-handler name (car xs)) (cadr xs) (case-internal name (cddr xs))))))) (doc case "takes a form and a list of branches which are value and operation pairs. If a value matches (or any in a list of values preced by `:or`), the operation is executed. It takes a catch-all else branch that is executed if nothing matches. Example: ``` (case (+ 10 1) 10 (println* \"nope\") 11 (println* \"yup\") (:or 12 13) (println* \"multibranch, but nope\") (println* \"else branch\") ) ```") (defmacro case [form :rest branches] (let [name (gensym)] (list 'let [name form] (case-internal name branches)))) (defmodule Dynamic (doc flip "Flips the arguments of a function `f`." "```" "((flip Symbol.prefix) 'Bar 'Foo)" "=> (Foo.Bar)" "```") (defndynamic flip [f] (fn [x y] (f y x))) ;; Higher-order functions can't currently accept primitives ;; For now, wrapping primitives in a function allows us to pass them ;; to HOFs like map. (doc compose "Returns the composition of two functions `f` and `g` for functions of any" "arity; concretely, returns a function accepting the correct number of" "arguments for `g`, applies `g` to those arguments, then applies `f` to the" "result." "" "If you only need to compose functions that take a single argument (unary arity)" "see `comp`. Comp also generates the form that corresponds to the composition," "compose contrarily evaluates 'eagerly' and returns a computed symbol." "```" ";; a silly composition" "((compose empty take) 3 [1 2 3 4 5])" ";; => []" "" "(String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))" ";; => 'carp'" "" ";; comp for comparison" "((comp (curry + 1) (curry + 2)) 4)" ";; => (+ 1 (+ 2 4))" "```") (defndynamic compose [f g] ;; Recall that **unquoted** function names evaluate to their definitions in ;; dynamic contexts, e.g. f = (dyanmic f [arg] body) ;; ;; Right now, this cannot handle anonymous functions because they cannot be passed to apply. ;; and not anonymous functions. ;; commands expand to (command ), fns expand to a non-list. ;; ;; TODO: Support passing anonymous functions. (if (not (or (list? f) (list? g))) (macro-error "compose can only compose named dynamic functions. To compose anonymous functions, such as curried functions, see comp.") (let [f-name (cadr f) g-name (cadr g) arguments (caddr g)] (list 'fn arguments ;; Since we call an eval to apply g immediately, we wrap the args in an ;; extra quote, otherwise, users would need to double quote any sequence of ;; symbols such as '(p r a c) (list f-name (list 'eval (list 'apply g-name (list 'quote arguments)))))))) (doc curry "Returns a curried function accepting a single argument, that applies `f` to `x`" "and then to the following argument." "" "```" "(map (curry Symbol.prefix 'Foo) '(bar baz))" "=> (Foo.bar Foo.baz)" "```") (defndynamic curry [f x] (fn [y] (f x y))) (doc curry* "Curry functions of any arity." "" "```" "(map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))" "=> (((+ 1 4) (+ 2 5)) ((+ 1 6)))" "" "((curry* Dynamic.zip cons '(1 2 3)) '((4 5) (6)))" "=> ((cons 1 (4 5)) (cons (2 (6))))" "" "(defndynamic add-em-up [x y z] (+ (+ x y) z))" "(map (curry* add-em-up 1 2) '(1 2 3))" "=> (4 5 6)" "```") (defndynamic curry* [f :rest args] (let [f-name (cadr f) all-args (caddr f) unfilled-args (- (length all-args) (length args)) remaining (take unfilled-args all-args) ;; Quote the arguments to retain expected behavior and avoid the need ;; for double quotes in curried higher-orders, e.g. zip. quote-args (map quoted args)] (list 'fn remaining ;; eval to execute the curried function. ;; otherwise, this resolves to the form that will call the function, e.g. (add-three-vals 2 3 1) (list 'eval (list 'apply f-name (list 'quote (append quote-args (collect-into remaining list)))))))) )