2018-03-26 17:51:43 +03:00
|
|
|
;; Defining the meta data macros early so that they can be used by all the other code.
|
|
|
|
|
2020-05-05 15:04:09 +03:00
|
|
|
(defmacro and [x y]
|
|
|
|
(list 'if x y false))
|
|
|
|
|
|
|
|
(defmacro or [x y]
|
|
|
|
(list 'if x true y))
|
|
|
|
|
2018-03-26 17:51:43 +03:00
|
|
|
(meta-set! doc "doc" "Set documentation for a binding.")
|
|
|
|
(defmacro doc [name string]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'meta-set! name "doc" string)))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
(doc print-doc "Print the documentation for a binding.")
|
|
|
|
(defmacro print-doc [name]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'macro-log (list 'meta name "doc"))))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
(doc sig "Annotate a binding with the desired signature.")
|
|
|
|
(defmacro sig [name signature]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'meta-set! name "sig" signature)))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
(doc print-sig "Print the annotated signature for a binding.")
|
|
|
|
(defmacro print-sig [name]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'macro-log (list 'meta name "sig"))))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
(doc hide "Mark a binding as hidden, this will make it not print with the 'info' command.")
|
2018-03-27 15:21:12 +03:00
|
|
|
(defmacro hidden [name]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'meta-set! name "hidden" true)))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
(doc private "Mark a binding as private, this will make it inaccessible from other modules.")
|
2018-03-27 15:14:30 +03:00
|
|
|
(defmacro private [name]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'meta-set! name "private" true)))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
2019-06-22 21:18:32 +03:00
|
|
|
(doc todo "sets the todo property for a binding.")
|
|
|
|
(defmacro todo [name value]
|
2020-04-17 13:29:21 +03:00
|
|
|
(eval (list 'meta-set! name "todo" value)))
|
2019-06-22 21:18:32 +03:00
|
|
|
|
2018-03-27 15:08:49 +03:00
|
|
|
(doc private? "Is this binding private?")
|
|
|
|
(defmacro private? [name]
|
2020-05-20 11:04:05 +03:00
|
|
|
(eval (list 'not (list 'list? (list 'meta name "private")))))
|
2018-03-27 15:08:49 +03:00
|
|
|
|
|
|
|
(doc hidden? "Is this binding hidden?")
|
|
|
|
(defmacro hidden? [name]
|
2020-05-20 11:04:05 +03:00
|
|
|
(eval (list 'not (list 'list? (list 'meta name "hidden")))))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
2019-06-04 12:30:22 +03:00
|
|
|
(defndynamic annotate-helper [name annotation]
|
2020-05-20 11:04:05 +03:00
|
|
|
(list 'cons annotation (list 'meta name "annotations")))
|
2019-06-04 12:30:22 +03:00
|
|
|
|
|
|
|
(doc annotate "Add an annotation to this binding.")
|
|
|
|
(defmacro annotate [name annotation]
|
2020-05-20 11:04:05 +03:00
|
|
|
(eval (list 'meta-set! name "annotations" (eval (annotate-helper name annotation)))))
|
2018-03-26 17:51:43 +03:00
|
|
|
|
2020-05-19 23:53:15 +03:00
|
|
|
(doc implements? "Does `function` implement `interface`?")
|
|
|
|
(defmacro implements? [interface function]
|
|
|
|
(eval (list 'any? (list 'fn (array 'x) (list '= 'x interface)) (list 'meta function "implements"))))
|
|
|
|
|
2018-02-08 19:39:42 +03:00
|
|
|
(defmodule Dynamic
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic caar [pair] (car (car pair)))
|
|
|
|
(defndynamic cadr [pair] (car (cdr pair)))
|
|
|
|
(defndynamic cdar [pair] (cdr (car pair)))
|
|
|
|
(defndynamic cddr [pair] (cdr (cdr pair)))
|
|
|
|
(defndynamic caaar [pair] (car (car (car pair))))
|
|
|
|
(defndynamic caadr [pair] (car (car (cdr pair))))
|
|
|
|
(defndynamic cadar [pair] (car (cdr (car pair))))
|
|
|
|
(defndynamic cdaar [pair] (cdr (car (car pair))))
|
|
|
|
(defndynamic caddr [pair] (car (cdr (cdr pair))))
|
|
|
|
(defndynamic cdadr [pair] (cdr (car (cdr pair))))
|
|
|
|
(defndynamic cddar [pair] (cdr (cdr (car pair))))
|
|
|
|
(defndynamic cdddr [pair] (cdr (cdr (cdr pair))))
|
|
|
|
(defndynamic caaaar [pair] (car (car (car (car pair)))))
|
|
|
|
(defndynamic caaadr [pair] (car (car (car (cdr pair)))))
|
|
|
|
(defndynamic caadar [pair] (car (car (cdr (car pair)))))
|
|
|
|
(defndynamic caaddr [pair] (car (car (cdr (cdr pair)))))
|
|
|
|
(defndynamic cadaar [pair] (car (cdr (car (car pair)))))
|
|
|
|
(defndynamic cadadr [pair] (car (cdr (car (cdr pair)))))
|
|
|
|
(defndynamic caddar [pair] (car (cdr (cdr (car pair)))))
|
|
|
|
(defndynamic cadddr [pair] (car (cdr (cdr (cdr pair)))))
|
|
|
|
(defndynamic cdaaar [pair] (cdr (car (car (car pair)))))
|
|
|
|
(defndynamic cdaadr [pair] (cdr (car (car (cdr pair)))))
|
|
|
|
(defndynamic cdadar [pair] (cdr (car (cdr (car pair)))))
|
|
|
|
(defndynamic cdaddr [pair] (cdr (car (cdr (cdr pair)))))
|
|
|
|
(defndynamic cddaar [pair] (cdr (cdr (car (car pair)))))
|
|
|
|
(defndynamic cddadr [pair] (cdr (cdr (car (cdr pair)))))
|
|
|
|
(defndynamic cdddar [pair] (cdr (cdr (cdr (car pair)))))
|
|
|
|
(defndynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))
|
|
|
|
|
2019-11-09 14:52:11 +03:00
|
|
|
(defndynamic cxr [x pair]
|
|
|
|
(if (= (length x) 0)
|
|
|
|
(list 'quote pair)
|
|
|
|
(list
|
|
|
|
(if (= 'a (cadr x))
|
|
|
|
'car
|
|
|
|
(if (= 'd (cadr x))
|
|
|
|
'cdr
|
|
|
|
(macro-error "`cxr` expects either `a` or `d` symbols, got " (cadr x))))
|
|
|
|
(if (= 1 (car x))
|
|
|
|
(cxr (cddr x) pair)
|
|
|
|
(cxr (cons (- (car x) 1) (cdr x)) pair)))))
|
|
|
|
|
|
|
|
(defndynamic nthcdr [n pair]
|
2019-11-26 09:13:14 +03:00
|
|
|
(cxr (list (+ n 1) 'd) pair))
|
2019-11-09 14:52:11 +03:00
|
|
|
|
|
|
|
(defndynamic nthcar [n pair]
|
|
|
|
(cxr (list 1 'a n 'd) pair))
|
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic eval-internal [form]
|
2018-03-04 13:41:47 +03:00
|
|
|
(list 'do
|
|
|
|
(list 'defn 'main [] (list 'IO.println* form))
|
|
|
|
(list 'build)
|
|
|
|
(list 'run)))
|
|
|
|
|
2020-03-09 17:50:52 +03:00
|
|
|
(defmacro evaluate [form]
|
2018-03-04 13:41:47 +03:00
|
|
|
(eval-internal form))
|
|
|
|
|
|
|
|
(defmacro e [form]
|
|
|
|
(eval-internal form))
|
2019-09-17 20:34:34 +03:00
|
|
|
|
2019-08-27 06:44:29 +03:00
|
|
|
(defndynamic list-to-array-internal [xs acc]
|
|
|
|
(if (= 0 (length xs))
|
|
|
|
acc
|
|
|
|
(list-to-array-internal (cdr xs) (append acc (array (car xs))))))
|
|
|
|
|
2019-09-08 21:58:30 +03:00
|
|
|
(defndynamic collect-into-internal [xs acc f]
|
|
|
|
(if (= 0 (length xs))
|
|
|
|
acc
|
|
|
|
(collect-into-internal (cdr xs) (append acc (f (car xs))) f)))
|
|
|
|
|
2020-04-10 17:04:44 +03:00
|
|
|
(doc collect-into
|
2019-09-08 21:58:30 +03:00
|
|
|
"Transforms a dynamic data literal into another, preserving order")
|
|
|
|
(defndynamic collect-into [xs f]
|
2020-04-22 02:03:53 +03:00
|
|
|
(collect-into-internal xs (f) f))
|
2019-09-11 04:51:53 +03:00
|
|
|
|
2019-09-15 06:51:16 +03:00
|
|
|
(doc empty?
|
|
|
|
"Returns true if the provided data literal is empty, false otherwise.")
|
|
|
|
(defndynamic empty? [xs]
|
2020-04-19 19:07:06 +03:00
|
|
|
(= 0 (length xs)))
|
2019-09-15 06:51:16 +03:00
|
|
|
|
2020-04-19 18:43:10 +03:00
|
|
|
(doc flip
|
|
|
|
"Flips the arguments of a function `f`.
|
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example,
|
2020-04-19 18:43:10 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
((flip Symbol.prefix) 'Bar 'Foo)
|
|
|
|
=> ;; (Foo.Bar)
|
|
|
|
```")
|
2020-04-19 18:36:33 +03:00
|
|
|
(defndynamic flip [f]
|
|
|
|
(fn [x y]
|
|
|
|
(f y x)))
|
|
|
|
|
2020-04-22 02:03:53 +03:00
|
|
|
(doc compose
|
|
|
|
"Returns the composition of two functions `f` and `g` for functions of any
|
2020-05-24 12:47:57 +03:00
|
|
|
arity; concretely, returns a function accepting the correct number of
|
|
|
|
arguments for `g`, applies `g` to those arguments, then applies `f` to the
|
|
|
|
result.
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
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.
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For exmaple:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
;; a silly composition
|
|
|
|
((compose empty take) 3 [1 2 3 4 5])
|
|
|
|
;; => []
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
(String.join (collect-into ((compose reverse map) Symbol.str '(p r a c)) array))
|
|
|
|
;; => 'carp'
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
;; comp for comparison
|
|
|
|
((comp (curry + 1) (curry + 2)) 4)
|
|
|
|
;; => (+ 1 (+ 2 4))
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(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.
|
2020-05-05 15:04:09 +03:00
|
|
|
(if (not (or (list? f) (list? g)))
|
2020-04-30 14:32:54 +03:00
|
|
|
(macro-error "compose can only compose named dynamic functions. To
|
|
|
|
compose anonymous functions, such as curried functions,
|
2020-04-22 02:03:53 +03:00
|
|
|
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))))))))
|
|
|
|
|
2020-04-19 18:43:10 +03:00
|
|
|
(doc curry
|
|
|
|
"Returns a curried function accepting a single argument, that applies f to x
|
2020-05-24 12:47:57 +03:00
|
|
|
and then to the following argument.
|
2020-04-19 18:43:10 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example,
|
2020-04-19 18:43:10 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(map (curry Symbol.prefix 'Foo) '(bar baz))
|
|
|
|
;; => (Foo.bar Foo.baz)
|
|
|
|
```")
|
2020-04-19 18:36:33 +03:00
|
|
|
(defndynamic curry [f x]
|
|
|
|
(fn [y]
|
2020-04-24 22:38:22 +03:00
|
|
|
(f x y)))
|
2020-04-22 02:03:53 +03:00
|
|
|
|
|
|
|
(doc curry*
|
2020-04-22 06:09:25 +03:00
|
|
|
"Curry functions of any airity.
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(map (curry* Dynamic.zip + '(1 2 3)) '((4 5) (6)))
|
|
|
|
;; => (((+ 1 4) (+ 2 5)) ((+ 1 6)))
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
((curry Dynamic.zip cons '(1 2 3)) '((4 5) (6)))
|
|
|
|
;; => ((cons 1 (4 5)) (cons (2 (6))))
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
(defndynamic add-em-up [x y z] (+ (+ x y) z))
|
|
|
|
(map (curry* add-em-up 1 2) '(1 2 3))
|
|
|
|
;; => (4 5 6)
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic curry* [f :rest args]
|
|
|
|
(let [f-name (cadr f)
|
|
|
|
all-args (caddr f)
|
|
|
|
unfilled-args (- (length all-args) (length args))
|
2020-04-22 06:09:25 +03:00
|
|
|
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))))))))
|
|
|
|
|
|
|
|
;; Higher-order functions can't currently accept primitives
|
|
|
|
;; For now, wrapping primitives in a function allows us to pass them
|
|
|
|
;; to HOFs like map.
|
|
|
|
(defndynamic quoted [x]
|
|
|
|
(list 'quote x))
|
2020-04-19 18:36:33 +03:00
|
|
|
|
2019-09-15 06:51:16 +03:00
|
|
|
(doc reduce
|
|
|
|
"Reduces or 'folds' a data literal, such as a list or array, into a single
|
2020-05-24 12:47:57 +03:00
|
|
|
value through successive applications of `f`.")
|
2019-09-15 06:51:16 +03:00
|
|
|
(defndynamic reduce [f x xs]
|
|
|
|
(if (empty? xs)
|
|
|
|
x
|
|
|
|
(reduce f (f x (car xs)) (cdr xs))))
|
|
|
|
|
2020-04-22 02:03:53 +03:00
|
|
|
(hidden unreduce-internal)
|
|
|
|
(defndynamic unreduce-internal [f x lim acc counter]
|
|
|
|
;; Currently only works with anonymous functions and named functions.
|
|
|
|
;; does not work with commands.
|
2020-05-05 15:04:09 +03:00
|
|
|
(if (not (or (array? acc) (list? acc)))
|
2020-04-22 02:03:53 +03:00
|
|
|
(macro-error
|
2020-04-30 14:32:54 +03:00
|
|
|
"Unreduce requires a dynamic data structure to collect results, such as
|
2020-04-22 02:03:53 +03:00
|
|
|
(list) or (array).")
|
|
|
|
(if (= counter lim)
|
|
|
|
acc
|
|
|
|
(unreduce-internal f (f x) lim (append acc (cons (eval (f x)) (empty acc))) (+ counter 1)))))
|
|
|
|
|
|
|
|
(doc unreduce
|
|
|
|
"Applies `f` to a starting value `x`, then generates a sequence of values
|
2020-05-24 12:47:57 +03:00
|
|
|
by successively applying `f` to the result `lim-1` times.
|
|
|
|
Collects results in the structure given by `acc`.
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(unreduce (curry + 1) 0 10 (list))
|
|
|
|
;; => (1 2 3 4 5 6 7 8 9 10)
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic unreduce [f x lim acc]
|
|
|
|
(unreduce-internal f x lim acc 0))
|
|
|
|
|
|
|
|
(doc filter
|
2020-05-24 12:47:57 +03:00
|
|
|
"Returns a list containing only the elements of `xs` that satisify
|
|
|
|
predicate `p`.
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(filter (fn [x] (= 'a x)) '(a b a b a b a b))
|
|
|
|
;; => (a a a a)
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic filter [p xs]
|
2020-04-22 06:09:25 +03:00
|
|
|
(let [filter-fn (fn [x y] (if (p y) (append x (list y)) x))]
|
2020-04-22 02:03:53 +03:00
|
|
|
(reduce filter-fn (list) xs)))
|
|
|
|
|
|
|
|
(doc reverse
|
|
|
|
"Reverses the order of elements in an array or list.
|
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(reverse [1 2 3 4])
|
|
|
|
;; => [4 3 2 1]
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic reverse [xs]
|
|
|
|
(if (array? xs)
|
|
|
|
(reduce (flip append) (array) (map array xs))
|
|
|
|
(reduce (flip append) (list) (map list xs))))
|
|
|
|
|
|
|
|
(doc empty
|
|
|
|
"Returns the empty form of `xs`.
|
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(empty '(1 2 3 4))
|
|
|
|
;; => ()
|
|
|
|
(empty '[1 2 3 4])
|
|
|
|
;; => []
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic empty [xs]
|
|
|
|
(if (array? xs)
|
|
|
|
(array)
|
|
|
|
(list)))
|
|
|
|
|
|
|
|
(doc take
|
|
|
|
"Returns a list containing the first `n` eleements of a list.
|
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
For example:
|
2020-04-22 02:03:53 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(take 3 '(1 2 3 4 5))
|
|
|
|
;; => (1 2 3)
|
|
|
|
```")
|
2020-04-22 02:03:53 +03:00
|
|
|
(defndynamic take [n xs]
|
|
|
|
;; A more straightforward impl is likely more efficient?
|
|
|
|
(let [indicies (unreduce (curry + 1) 0 n (list))
|
|
|
|
result (map cadr (zip list xs indicies))]
|
|
|
|
(if (array? xs)
|
|
|
|
(collect-into result array)
|
|
|
|
result)))
|
|
|
|
|
2019-09-15 06:51:16 +03:00
|
|
|
(doc apply
|
|
|
|
"Applies the function `f` to the provided argument list, passing each value
|
2020-05-24 12:47:57 +03:00
|
|
|
in the list as an argument to the function.")
|
2019-09-15 06:51:16 +03:00
|
|
|
(defndynamic apply [f argument-list]
|
|
|
|
;; The let clause here is a tad mysterious at first glance. When passed a
|
|
|
|
;; standalone function name (i.e. not an application (f x), carp evaluates
|
|
|
|
;; it into the function's defining form, e.g. foo becomes (defn foo [x] x),
|
|
|
|
;; commands such as + become (command +) etc. ;; The binding here accounts
|
|
|
|
;; for that case, allowing users to pass the function name to apply
|
|
|
|
;; unquoted.
|
|
|
|
;;
|
|
|
|
;; This is necessary for parity across map-internal, zip, and apply.
|
|
|
|
;; Since map calls its function directly, it takes it as is. Apply, on the
|
|
|
|
;; other hand, would have to take the quoted form, since it builds a list
|
|
|
|
;; that serves as the actual application.
|
|
|
|
;;
|
|
|
|
;; This is problematic for the user facing map function, since it makes
|
|
|
|
;; calls to map or zip (which uses apply) as appropriate--unless we support
|
|
|
|
;; the quoted function name argument in map-internal or the unquoted one in
|
|
|
|
;; apply, we can't use zip and map-internal in map.
|
2020-04-22 02:03:53 +03:00
|
|
|
(if (not (list? f))
|
|
|
|
(f argument-list)
|
2019-09-15 06:51:16 +03:00
|
|
|
(let [function-name (list (cadr f))]
|
2020-04-22 02:03:53 +03:00
|
|
|
(if (array? argument-list)
|
|
|
|
(append function-name (collect-into argument-list list))
|
|
|
|
(append function-name argument-list)))))
|
2019-09-15 06:51:16 +03:00
|
|
|
|
2020-04-19 19:00:54 +03:00
|
|
|
(hidden map-internal)
|
2019-09-15 06:51:16 +03:00
|
|
|
(defndynamic map-internal [f xs acc]
|
|
|
|
(if (empty? xs)
|
2019-09-11 04:51:53 +03:00
|
|
|
acc
|
2020-04-19 18:36:33 +03:00
|
|
|
(map-internal f (cdr xs) (cons-last (f (car xs)) acc))))
|
2019-09-11 04:51:53 +03:00
|
|
|
|
2020-05-05 16:19:43 +03:00
|
|
|
(doc any?
|
|
|
|
"checks whether any of the elements in `xs` conforms to the predicate
|
2020-05-24 12:47:57 +03:00
|
|
|
function `f`.
|
2020-05-05 16:19:43 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
Example:
|
2020-05-05 16:19:43 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(any? (fn [x] (= 'a x)) '(a b c)) ; => true
|
|
|
|
(any? (fn [x] (= 'a x)) '(e f g)) ; => false
|
|
|
|
```")
|
2020-05-05 15:04:09 +03:00
|
|
|
(defndynamic any? [f xs]
|
|
|
|
(reduce (fn [acc x] (or acc (f x))) false xs))
|
|
|
|
|
2020-05-05 16:19:43 +03:00
|
|
|
(doc any?
|
|
|
|
"checks whether all of the elements in `xs` conform to the predicate
|
2020-05-24 12:47:57 +03:00
|
|
|
function `f`.
|
2020-05-05 16:19:43 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
Example:
|
2020-05-05 16:19:43 +03:00
|
|
|
|
2020-05-24 12:47:57 +03:00
|
|
|
```
|
|
|
|
(all? (fn [x] (< 1 x)) '(2 3 4)) ; => true
|
|
|
|
(all? (fn [x] (< 1 x)) '(-1 0 1)) ; => false
|
|
|
|
```")
|
2020-05-05 15:04:09 +03:00
|
|
|
(defndynamic all? [f xs]
|
|
|
|
(reduce (fn [acc x] (and acc (f x))) true xs))
|
|
|
|
|
2020-04-19 19:00:54 +03:00
|
|
|
(hidden zip-internal)
|
2019-09-15 06:51:16 +03:00
|
|
|
(defndynamic zip-internal [f forms acc]
|
2020-05-05 15:04:09 +03:00
|
|
|
(if (any? empty? forms)
|
2019-09-15 06:51:16 +03:00
|
|
|
acc
|
|
|
|
(zip-internal
|
|
|
|
f
|
|
|
|
(map-internal cdr forms (list))
|
|
|
|
(let [result (list (apply f (map-internal car forms (list))))]
|
|
|
|
(append acc result)))))
|
|
|
|
|
2020-04-19 18:57:30 +03:00
|
|
|
(doc zip
|
|
|
|
"Returns the *form* that results from applying a function `f` to each of
|
2020-05-24 12:47:57 +03:00
|
|
|
the values supplied in `forms`.
|
|
|
|
|
|
|
|
If the members of a single form are exhuasted, the result of the
|
|
|
|
applications thus far is returned, and any remaining members in the other
|
|
|
|
forms are ignored.
|
|
|
|
|
|
|
|
For example,
|
|
|
|
|
|
|
|
```
|
|
|
|
(zip + '(1 2 3) '(4 5 6))
|
|
|
|
;; => ((+ 1 4) (+ 2 5) (+ 3 6))
|
|
|
|
```
|
|
|
|
|
|
|
|
It's important to note that zip operates on forms, and that the form
|
|
|
|
returned by zip may not be evaluable by itself. For instance, to actually
|
|
|
|
transform the result in the example above into something Carp can
|
|
|
|
evaluate, we need to wrap each member of the list in a `do`:
|
|
|
|
|
|
|
|
```
|
|
|
|
(append (list 'do) (zip + '(1 2 3) '(4 5 6)))
|
|
|
|
;; => (do (+ 1 4) (+ 2 5) (+ 3 6))
|
|
|
|
(eval (append (list 'do) (zip + '(1 2 3) '(4 5 6))))
|
|
|
|
;; => 9 ;; do returns the value of the last form in its body
|
|
|
|
```")
|
2019-09-15 06:51:16 +03:00
|
|
|
(defndynamic zip [f :rest forms]
|
|
|
|
(zip-internal f forms (list)))
|
|
|
|
|
2019-09-11 04:51:53 +03:00
|
|
|
(doc map
|
2020-04-21 16:41:42 +03:00
|
|
|
"Applies a function `f` to each element in the list or array `xs` and
|
2020-05-24 12:47:57 +03:00
|
|
|
returns a list dynamic data literal containing the result of the function
|
|
|
|
applications.
|
|
|
|
|
|
|
|
For example:
|
|
|
|
```clojure
|
|
|
|
'(map symbol? '(a b c))
|
|
|
|
=> (true true true)
|
|
|
|
'(map (curry + 1) '(1 2 3))
|
|
|
|
=> (2 3 4)
|
|
|
|
```")
|
2020-04-21 16:41:42 +03:00
|
|
|
(defndynamic map [f xs]
|
|
|
|
(map-internal f xs (list)))
|
2020-05-24 12:47:57 +03:00
|
|
|
|
|
|
|
(doc flatten "flattens a list recursively.
|
|
|
|
|
|
|
|
For example:
|
|
|
|
```
|
|
|
|
(flatten '(1 2 (3 (4))))
|
|
|
|
; => '(1 2 3 4)
|
|
|
|
```")
|
|
|
|
(defndynamic flatten [l]
|
|
|
|
(reduce (fn [acc x]
|
|
|
|
(if (list? x)
|
|
|
|
(append acc (flatten x))
|
|
|
|
(cons-last x acc)))
|
|
|
|
'()
|
|
|
|
l))
|
2020-03-09 17:50:52 +03:00
|
|
|
)
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2020-05-15 19:46:35 +03:00
|
|
|
(defndynamic implement-declaration [mod interface]
|
|
|
|
(list 'implements interface (Symbol.prefix mod interface)))
|
|
|
|
|
|
|
|
(doc implements-all
|
|
|
|
"Declares functions in mod with names matching `interfaces` as implementations
|
2020-05-24 12:47:57 +03:00
|
|
|
of those interfaces.")
|
2020-05-15 19:46:35 +03:00
|
|
|
(defmacro implements-all [mod :rest interfaces]
|
|
|
|
(cons 'do (map (curry implement-declaration mod) interfaces)))
|
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic cond-internal [xs]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 0)
|
2017-06-26 12:15:03 +03:00
|
|
|
(list)
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 2)
|
2017-12-15 19:43:06 +03:00
|
|
|
(macro-error "cond has even number of branches; add an else branch")
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 1)
|
2017-06-26 12:15:03 +03:00
|
|
|
(car xs)
|
|
|
|
(list
|
2017-10-17 10:02:12 +03:00
|
|
|
'if
|
2017-06-26 12:15:03 +03:00
|
|
|
(car xs)
|
2018-01-02 20:13:52 +03:00
|
|
|
(cadr xs)
|
|
|
|
(cond-internal (cddr xs)))))))
|
2017-06-26 12:15:03 +03:00
|
|
|
|
2020-05-26 22:50:26 +03:00
|
|
|
(doc cond "executes a block of code if a specified condition is true. Multiple
|
|
|
|
such blocks can be chained.
|
|
|
|
|
|
|
|
For example:
|
|
|
|
|
|
|
|
```
|
|
|
|
(cond
|
|
|
|
(< 10 1) (println \"Condition 1 is true\")
|
|
|
|
(> 10 1) (println \"Condition 2 is true\")
|
|
|
|
(println \"Else branch\"))
|
|
|
|
```")
|
2017-06-26 12:15:03 +03:00
|
|
|
(defmacro cond [:rest xs]
|
|
|
|
(cond-internal xs))
|
|
|
|
|
2018-01-17 19:08:02 +03:00
|
|
|
(defmacro for [settings :rest body] ;; settings = variable, from, to, <step>
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (> (length body) 1)
|
2018-01-17 18:09:34 +03:00
|
|
|
(macro-error "Warning: the body of the 'for' loop can only contain one expression")
|
2019-07-09 01:18:38 +03:00
|
|
|
(let [variable (car settings)
|
|
|
|
from (cadr settings)
|
|
|
|
to (caddr settings)
|
2020-02-13 18:02:49 +03:00
|
|
|
step (if (> (length settings) 3) (cadddr settings) 1)
|
|
|
|
comp (if (> (length settings) 4)
|
|
|
|
(cadddr (cdr settings))
|
|
|
|
(if (< step (- step step)) '> '<))
|
2019-07-09 01:18:38 +03:00
|
|
|
]
|
|
|
|
(list
|
|
|
|
'let (array variable from)
|
|
|
|
(list
|
2020-02-13 18:02:49 +03:00
|
|
|
'while (list comp variable to)
|
2019-12-18 14:10:47 +03:00
|
|
|
(list
|
2019-07-09 01:18:38 +03:00
|
|
|
'do
|
|
|
|
(if (= (length body) 0)
|
|
|
|
()
|
|
|
|
(if (list? body)
|
|
|
|
(car body)
|
|
|
|
body))
|
|
|
|
(list
|
|
|
|
'set! variable
|
|
|
|
(list '+ variable step))))))))
|
2017-06-29 18:05:34 +03:00
|
|
|
|
|
|
|
(defmacro refstr [x]
|
2017-10-17 10:02:12 +03:00
|
|
|
(list 'ref
|
|
|
|
(list 'str x)))
|
2017-10-13 14:48:40 +03:00
|
|
|
|
2020-02-14 17:32:05 +03:00
|
|
|
(defmacro doall [f xs]
|
|
|
|
(list 'for ['i 0 (list 'Array.length (list 'ref xs))]
|
|
|
|
(list f (list 'Array.unsafe-nth (list 'ref xs) 'i))))
|
2018-03-24 13:17:56 +03:00
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic foreach-internal [var xs expr]
|
2020-01-29 13:55:56 +03:00
|
|
|
(let [xsym (gensym-with 'xs)
|
2020-01-29 17:48:02 +03:00
|
|
|
len (gensym-with 'len)
|
|
|
|
i (gensym-with 'i)]
|
2020-01-29 13:55:56 +03:00
|
|
|
(list 'let [xsym xs
|
|
|
|
len (list 'Array.length xsym)]
|
2020-01-29 17:48:02 +03:00
|
|
|
(list 'for [i 0 len]
|
|
|
|
(list 'let [var (list 'Array.unsafe-nth xsym i)]
|
2020-01-29 13:55:56 +03:00
|
|
|
expr)))))
|
2018-03-24 13:17:56 +03:00
|
|
|
|
|
|
|
(defmacro foreach [binding expr]
|
|
|
|
(if (array? binding)
|
|
|
|
(foreach-internal (car binding) (cadr binding) expr)
|
|
|
|
(macro-error "Binding has to be an array.")))
|
2017-10-18 23:44:15 +03:00
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic thread-first-internal [xs]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 2)
|
2017-10-18 23:44:15 +03:00
|
|
|
(if (list? (last xs))
|
2018-01-02 20:13:52 +03:00
|
|
|
(cons (caadr xs)
|
2017-10-18 23:44:15 +03:00
|
|
|
(cons (car xs)
|
2018-01-02 20:13:52 +03:00
|
|
|
(cdadr xs)))
|
|
|
|
(list (cadr xs) (car xs)))
|
2017-10-18 23:44:15 +03:00
|
|
|
(if (list? (last xs))
|
|
|
|
(append
|
|
|
|
(list
|
|
|
|
(car (last xs))
|
2017-12-01 12:36:14 +03:00
|
|
|
(thread-first-internal (all-but-last xs)))
|
2017-10-18 23:44:15 +03:00
|
|
|
(cdr (last xs)))
|
2017-12-01 12:36:14 +03:00
|
|
|
(list (last xs) (thread-first-internal (all-but-last xs))))))
|
2017-10-18 23:44:15 +03:00
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic thread-last-internal [xs]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 2)
|
2017-10-18 23:44:15 +03:00
|
|
|
(if (list? (last xs))
|
|
|
|
(cons-last (car xs) (last xs))
|
2018-01-02 20:13:52 +03:00
|
|
|
(list (cadr xs) (car xs)))
|
2017-10-18 23:44:15 +03:00
|
|
|
(if (list? (last xs))
|
2017-12-01 12:36:14 +03:00
|
|
|
(cons-last (thread-last-internal (all-but-last xs)) (last xs))
|
|
|
|
(list (last xs) (thread-last-internal (all-but-last xs))))))
|
2017-10-18 23:44:15 +03:00
|
|
|
|
|
|
|
(defmacro => [:rest forms]
|
|
|
|
(thread-first-internal forms))
|
|
|
|
|
|
|
|
(defmacro ==> [:rest forms]
|
|
|
|
(thread-last-internal forms))
|
2017-11-29 17:28:21 +03:00
|
|
|
|
|
|
|
(defmacro swap! [x y]
|
2018-02-02 09:19:10 +03:00
|
|
|
(list 'let (array 'tmp y) (list 'do (list 'set! y x) (list 'set! x 'tmp))))
|
2017-11-30 15:43:58 +03:00
|
|
|
|
2018-01-02 20:13:52 +03:00
|
|
|
(defmacro update! [x f]
|
2018-02-02 09:19:10 +03:00
|
|
|
(list 'set! x (list f x)))
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2020-05-13 17:10:00 +03:00
|
|
|
(defmacro freebsd-only [:rest forms]
|
|
|
|
(if (= "freebsd" (os))
|
|
|
|
(eval (cons (quote do) forms))
|
|
|
|
()))
|
|
|
|
|
2017-12-07 16:59:55 +03:00
|
|
|
(defmacro mac-only [:rest forms]
|
2017-11-30 15:43:58 +03:00
|
|
|
(if (= "darwin" (os))
|
2020-04-10 18:31:51 +03:00
|
|
|
(eval (cons (quote do) forms))
|
2017-11-30 15:43:58 +03:00
|
|
|
()))
|
2017-12-04 11:29:15 +03:00
|
|
|
|
2017-12-07 16:59:55 +03:00
|
|
|
(defmacro linux-only [:rest forms]
|
2017-12-04 11:29:15 +03:00
|
|
|
(if (= "linux" (os))
|
2020-04-10 18:31:51 +03:00
|
|
|
(eval (cons (quote do) forms))
|
2017-12-04 11:29:15 +03:00
|
|
|
()))
|
|
|
|
|
2017-12-07 16:59:55 +03:00
|
|
|
(defmacro windows-only [:rest forms]
|
2020-05-05 15:04:09 +03:00
|
|
|
(if (or (= "windows" (os)) (= "mingw32" (os)))
|
2020-04-10 18:31:51 +03:00
|
|
|
(eval (cons (quote do) forms))
|
2017-12-04 11:29:15 +03:00
|
|
|
()))
|
2017-12-12 17:08:33 +03:00
|
|
|
|
2018-02-12 16:34:17 +03:00
|
|
|
(defmacro not-on-windows [:rest forms]
|
2020-05-05 15:04:09 +03:00
|
|
|
(if (not (or (= "windows" (os)) (= "mingw32" (os))))
|
2020-04-10 18:31:51 +03:00
|
|
|
(eval (cons (quote do) forms))
|
2018-02-12 16:34:17 +03:00
|
|
|
()))
|
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic use-all-fn [names]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length names) 0)
|
2017-12-12 17:08:33 +03:00
|
|
|
(macro-error "Trying to call use-all without arguments")
|
2020-04-10 18:31:51 +03:00
|
|
|
(do
|
|
|
|
(eval (list 'use (car names)))
|
|
|
|
(if (= (length names) 1)
|
|
|
|
()
|
|
|
|
(use-all-fn (cdr names))))))
|
2017-12-12 17:08:33 +03:00
|
|
|
|
|
|
|
(defmacro use-all [:rest names]
|
2020-04-10 18:31:51 +03:00
|
|
|
(use-all-fn names))
|
2017-12-12 19:39:15 +03:00
|
|
|
|
2018-03-24 12:28:19 +03:00
|
|
|
(defmacro load-and-use [name]
|
2020-04-10 18:31:51 +03:00
|
|
|
(do
|
|
|
|
(eval (list 'load (str name ".carp")))
|
|
|
|
(eval (list 'use name))))
|
2018-03-24 12:28:19 +03:00
|
|
|
|
2017-12-12 19:39:15 +03:00
|
|
|
(defmacro when [condition form]
|
|
|
|
(list 'if condition form (list)))
|
2017-12-12 20:45:29 +03:00
|
|
|
|
|
|
|
(defmacro unless [condition form]
|
|
|
|
(list 'if condition (list) form))
|
2017-12-14 18:28:06 +03:00
|
|
|
|
2017-12-15 11:28:14 +03:00
|
|
|
(defmacro let-do [bindings :rest forms]
|
2017-12-14 18:28:06 +03:00
|
|
|
(list 'let bindings
|
|
|
|
(cons 'do forms)))
|
|
|
|
|
2019-04-30 22:42:34 +03:00
|
|
|
(defmacro while-do [condition :rest forms]
|
|
|
|
(list 'while condition
|
|
|
|
(cons 'do forms)))
|
|
|
|
|
2017-12-15 11:24:16 +03:00
|
|
|
(defmacro defn-do [name arguments :rest body]
|
2020-04-10 17:04:44 +03:00
|
|
|
(eval (list 'defn name arguments (cons 'do body))))
|
2017-12-14 18:28:06 +03:00
|
|
|
|
|
|
|
(defmacro comment [:rest forms]
|
|
|
|
())
|
|
|
|
|
2017-12-15 11:24:16 +03:00
|
|
|
(defmacro forever-do [:rest forms]
|
2017-12-14 18:28:06 +03:00
|
|
|
(list 'while true (cons 'do forms)))
|
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic case-internal [name xs]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 0)
|
2017-12-14 18:28:06 +03:00
|
|
|
(list)
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 2)
|
2017-12-15 11:24:16 +03:00
|
|
|
(macro-error "case has even number of branches; add an else branch")
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length xs) 1)
|
2017-12-14 18:28:06 +03:00
|
|
|
(car xs)
|
|
|
|
(list 'if
|
|
|
|
(list '= name (car xs))
|
2018-01-02 20:13:52 +03:00
|
|
|
(cadr xs)
|
|
|
|
(case-internal name (cddr xs)))))))
|
2017-12-14 18:28:06 +03:00
|
|
|
|
|
|
|
(defmacro case [name :rest forms]
|
|
|
|
(case-internal name forms))
|
2017-12-29 13:49:51 +03:00
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic build-vararg [func forms]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length forms) 0)
|
2017-12-29 13:49:51 +03:00
|
|
|
(macro-error "vararg macro needs at least one argument")
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length forms) 1)
|
2017-12-29 13:49:51 +03:00
|
|
|
(car forms)
|
2018-06-15 13:07:32 +03:00
|
|
|
(list func (car forms) (build-vararg func (cdr forms))))))
|
2017-12-29 13:49:51 +03:00
|
|
|
|
|
|
|
(defmacro and* [:rest forms]
|
|
|
|
(build-vararg 'and forms))
|
|
|
|
|
|
|
|
(defmacro or* [:rest forms]
|
|
|
|
(build-vararg 'or forms))
|
|
|
|
|
2019-03-13 20:49:48 +03:00
|
|
|
(defndynamic build-str* [forms]
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length forms) 0)
|
2017-12-29 13:49:51 +03:00
|
|
|
(list "")
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length forms) 1)
|
2019-05-27 19:05:44 +03:00
|
|
|
(list 'ref (list 'str (car forms)))
|
|
|
|
(list 'ref (list 'String.append (list 'ref (list 'str (car forms))) (build-str* (cdr forms)))))))
|
2017-12-29 13:49:51 +03:00
|
|
|
|
|
|
|
(defmacro str* [:rest forms]
|
2019-05-27 19:05:44 +03:00
|
|
|
(list 'copy (build-str* forms)))
|
2017-12-29 13:49:51 +03:00
|
|
|
|
|
|
|
(defmacro println* [:rest forms]
|
2019-05-27 19:05:44 +03:00
|
|
|
(list 'IO.println (build-str* forms)))
|
2018-01-25 19:26:20 +03:00
|
|
|
|
2018-03-11 16:53:50 +03:00
|
|
|
(defmacro print* [:rest forms]
|
2019-05-27 19:05:44 +03:00
|
|
|
(list 'IO.print (build-str* forms)))
|
2018-03-11 16:53:50 +03:00
|
|
|
|
2018-01-25 19:26:20 +03:00
|
|
|
(defmacro ignore [form]
|
2018-02-01 20:01:45 +03:00
|
|
|
(list 'let (array '_ form) (list)))
|
2018-03-12 18:30:36 +03:00
|
|
|
|
2018-03-27 11:51:16 +03:00
|
|
|
(defmacro save-docs [:rest modules]
|
2018-03-27 10:05:58 +03:00
|
|
|
;; A trick to be able to send unquoted symbols to 'save-docs'
|
2020-04-17 13:59:22 +03:00
|
|
|
(eval (list 'save-docs-internal (list 'quote modules))))
|
2019-05-20 07:08:09 +03:00
|
|
|
|
2019-07-09 01:18:38 +03:00
|
|
|
(defndynamic project-config [bindings]
|
2019-05-20 07:08:09 +03:00
|
|
|
(if (< (length bindings) 2)
|
|
|
|
(list)
|
|
|
|
(cons-last (project-config (cdr (cdr bindings))) (list 'do (list 'Project.config
|
|
|
|
(car bindings) (car (cdr bindings)))))))
|
|
|
|
|
|
|
|
(doc defproject "Define a project configuration.")
|
2019-07-09 01:18:38 +03:00
|
|
|
(defmacro defproject [:rest bindings]
|
2019-05-20 07:08:09 +03:00
|
|
|
(project-config bindings))
|
2019-05-22 21:01:03 +03:00
|
|
|
|
|
|
|
(doc const-assert "asserts that the expression `expr` is true at compile time.
|
|
|
|
Otherwise it will fail with the message `msg`.
|
|
|
|
|
|
|
|
The expression must be evaluable at compile time.")
|
|
|
|
(defndynamic const-assert [expr msg]
|
|
|
|
(if expr () (macro-error msg)))
|
2019-09-09 10:59:22 +03:00
|
|
|
|
|
|
|
(doc *gensym-counter* "is a helper counter for `gensym`.")
|
|
|
|
(defdynamic *gensym-counter* 1000)
|
|
|
|
|
2019-09-09 23:33:56 +03:00
|
|
|
(doc gensym-with "generates symbols dynamically, based on a symbol name.")
|
|
|
|
(defndynamic gensym-with [x]
|
2019-09-09 10:59:22 +03:00
|
|
|
(do
|
2020-03-18 00:51:00 +03:00
|
|
|
(set! *gensym-counter* (inc *gensym-counter*))
|
2020-04-30 14:32:54 +03:00
|
|
|
(Symbol.concat [x (Symbol.from *gensym-counter*)])))
|
2019-09-09 23:33:56 +03:00
|
|
|
|
|
|
|
(doc gensym "generates symbols dynamically as needed.")
|
|
|
|
(defndynamic gensym []
|
|
|
|
(gensym-with 'gensym-generated))
|
2019-11-22 15:10:36 +03:00
|
|
|
|
|
|
|
(doc until "executes `body` until the condition `cnd` is true.")
|
|
|
|
(defmacro until [cnd body]
|
|
|
|
(list 'while (list 'not cnd)
|
|
|
|
body))
|
2019-12-18 14:10:47 +03:00
|
|
|
|
|
|
|
(doc defdynamic-once "creates a dynamic variable and sets its value if it's not already defined.")
|
|
|
|
(defmacro defdynamic-once [var expr]
|
|
|
|
(list 'if (list 'defined? var)
|
|
|
|
()
|
|
|
|
(list 'defdynamic var expr)))
|
2019-11-29 17:25:27 +03:00
|
|
|
|
|
|
|
(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))))
|
2020-05-08 16:17:34 +03:00
|
|
|
|
|
|
|
(doc inline-c "inlines some custom C code.")
|
2020-05-11 11:58:24 +03:00
|
|
|
(defmacro inline-c [name defcode declcode]
|
|
|
|
(list 'deftemplate name (list) (eval defcode) (eval declcode)))
|