(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)))))) (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)) (defmacro -> [:rest forms] (thread-first-internal forms)) (defmacro --> [:rest forms] (thread-last-internal forms)) (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)) (defmacro let-do [bindings :rest forms] (list 'let bindings (cons 'do forms))) (defmacro while-do [condition :rest forms] (list 'while condition (cons 'do forms))) (defmacro defn-do [name arguments :rest body] (eval (list 'defn name arguments (cons 'do body)))) (defmacro forever-do [:rest forms] (list 'while true (cons 'do forms))) (defmacro when [condition form] (list 'if condition form (list))) (defmacro unless [condition form] (list 'if condition (list) form)) (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 (list '= name (car xs)) (cadr xs) (case-internal name (cddr xs))))))) (defmacro case [name :rest forms] (case-internal name forms)) (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)))))))) )