mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
270 lines
8.5 KiB
Plaintext
270 lines
8.5 KiB
Plaintext
(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 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 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
|
|
(list '= 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, 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\")
|
|
(println* \"else branch\")
|
|
)
|
|
```")
|
|
(defmacro case [form :rest branches]
|
|
(case-internal form 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 <name>), 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))))))))
|
|
)
|