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.
|
|
|
|
|
|
|
|
(meta-set! doc "doc" "Set documentation for a binding.")
|
|
|
|
(defmacro doc [name string]
|
|
|
|
(list 'meta-set! name "doc" string))
|
|
|
|
|
|
|
|
(doc print-doc "Print the documentation for a binding.")
|
|
|
|
(defmacro print-doc [name]
|
|
|
|
(list 'macro-log (list 'meta name "doc")))
|
|
|
|
|
|
|
|
(doc sig "Annotate a binding with the desired signature.")
|
|
|
|
(defmacro sig [name signature]
|
|
|
|
(list 'meta-set! name "sig" signature))
|
|
|
|
|
|
|
|
(doc print-sig "Print the annotated signature for a binding.")
|
|
|
|
(defmacro print-sig [name]
|
|
|
|
(list 'macro-log (list 'meta name "sig")))
|
|
|
|
|
|
|
|
(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]
|
|
|
|
(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]
|
2018-03-26 17:51:43 +03:00
|
|
|
(list 'meta-set! name "private" true))
|
|
|
|
|
2018-03-27 15:08:49 +03:00
|
|
|
(doc private? "Is this binding private?")
|
|
|
|
(defmacro private? [name]
|
|
|
|
(list 'not (list '= () (list 'meta name "private")))) ;; TODO: This is buggy, will report true when meta is set to 'false'!
|
|
|
|
|
|
|
|
(doc hidden? "Is this binding hidden?")
|
|
|
|
(defmacro hidden? [name]
|
|
|
|
(list 'not (list '= () (list 'meta name "hidden")))) ;; TODO: This is buggy, will report true when meta is set to 'false'!
|
2018-03-26 17:51:43 +03:00
|
|
|
|
|
|
|
|
2018-02-08 19:39:42 +03:00
|
|
|
(defmodule Dynamic
|
|
|
|
(defdynamic caar [pair] (car (car pair)))
|
|
|
|
(defdynamic cadr [pair] (car (cdr pair)))
|
|
|
|
(defdynamic cdar [pair] (cdr (car pair)))
|
|
|
|
(defdynamic cddr [pair] (cdr (cdr pair)))
|
|
|
|
(defdynamic caaar [pair] (car (car (car pair))))
|
|
|
|
(defdynamic caadr [pair] (car (car (cdr pair))))
|
|
|
|
(defdynamic cadar [pair] (car (cdr (car pair))))
|
|
|
|
(defdynamic cdaar [pair] (cdr (car (car pair))))
|
|
|
|
(defdynamic caddr [pair] (car (cdr (cdr pair))))
|
|
|
|
(defdynamic cdadr [pair] (cdr (car (cdr pair))))
|
|
|
|
(defdynamic cddar [pair] (cdr (cdr (car pair))))
|
|
|
|
(defdynamic cdddr [pair] (cdr (cdr (cdr pair))))
|
|
|
|
(defdynamic caaaar [pair] (car (car (car (car pair)))))
|
|
|
|
(defdynamic caaadr [pair] (car (car (car (cdr pair)))))
|
|
|
|
(defdynamic caadar [pair] (car (car (cdr (car pair)))))
|
|
|
|
(defdynamic caaddr [pair] (car (car (cdr (cdr pair)))))
|
|
|
|
(defdynamic cadaar [pair] (car (cdr (car (car pair)))))
|
|
|
|
(defdynamic cadadr [pair] (car (cdr (car (cdr pair)))))
|
|
|
|
(defdynamic caddar [pair] (car (cdr (cdr (car pair)))))
|
|
|
|
(defdynamic cadddr [pair] (car (cdr (cdr (cdr pair)))))
|
|
|
|
(defdynamic cdaaar [pair] (cdr (car (car (car pair)))))
|
|
|
|
(defdynamic cdaadr [pair] (cdr (car (car (cdr pair)))))
|
|
|
|
(defdynamic cdadar [pair] (cdr (car (cdr (car pair)))))
|
|
|
|
(defdynamic cdaddr [pair] (cdr (car (cdr (cdr pair)))))
|
|
|
|
(defdynamic cddaar [pair] (cdr (cdr (car (car pair)))))
|
|
|
|
(defdynamic cddadr [pair] (cdr (cdr (car (cdr pair)))))
|
|
|
|
(defdynamic cdddar [pair] (cdr (cdr (cdr (car pair)))))
|
2018-03-04 13:41:47 +03:00
|
|
|
(defdynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))
|
|
|
|
|
|
|
|
(defdynamic eval-internal [form]
|
|
|
|
(list 'do
|
|
|
|
(list 'defn 'main [] (list 'IO.println* form))
|
|
|
|
(list 'build)
|
|
|
|
(list 'run)))
|
|
|
|
|
|
|
|
(defmacro eval [form]
|
|
|
|
(eval-internal form))
|
|
|
|
|
|
|
|
(defmacro e [form]
|
|
|
|
(eval-internal form))
|
|
|
|
|
|
|
|
)
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2017-06-26 12:15:03 +03:00
|
|
|
(defdynamic 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
|
|
|
|
|
|
|
(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")
|
|
|
|
(list
|
|
|
|
'let
|
|
|
|
(array (car settings) (cadr settings))
|
|
|
|
(list
|
|
|
|
'while
|
|
|
|
(list 'Int.< (car settings) (caddr settings))
|
|
|
|
(list 'do
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length body) 0)
|
2018-01-17 19:08:02 +03:00
|
|
|
()
|
|
|
|
(if (list? body)
|
|
|
|
(car body)
|
|
|
|
body))
|
2018-01-17 18:09:34 +03:00
|
|
|
(list
|
2018-02-02 09:19:10 +03:00
|
|
|
'set! (car settings)
|
2018-01-17 18:09:34 +03:00
|
|
|
(list 'Int.+
|
|
|
|
(car settings)
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= 4 (length settings)) ;; optional arg for step
|
2018-01-17 18:09:34 +03:00
|
|
|
(cadddr settings)
|
|
|
|
1))))))))
|
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
|
|
|
|
2018-03-24 13:17:56 +03:00
|
|
|
;; Old foreach, what's a better name for this? (it's just 'map' with side effects)
|
|
|
|
;; (defmacro foreach [f xs]
|
2018-05-20 10:57:51 +03:00
|
|
|
;; (list 'for ['i 0 (list 'Array.length (list 'ref xs))]
|
2018-03-24 13:17:56 +03:00
|
|
|
;; (list f (list 'Array.nth (list 'ref xs) 'i))))
|
|
|
|
|
|
|
|
(defdynamic foreach-internal [var xs expr]
|
|
|
|
(list 'let ['xs xs
|
2018-05-20 10:57:51 +03:00
|
|
|
'len (list 'Array.length 'xs)]
|
2018-03-24 13:17:56 +03:00
|
|
|
(list 'for ['i 0 'len]
|
2018-03-24 18:28:35 +03:00
|
|
|
(list 'let [var (list 'Array.nth 'xs 'i)]
|
2018-03-24 13:17:56 +03:00
|
|
|
expr))))
|
|
|
|
|
|
|
|
(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
|
|
|
|
|
|
|
(defdynamic 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
|
|
|
|
|
|
|
(defdynamic 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
|
|
|
|
2017-12-07 16:59:55 +03:00
|
|
|
(defmacro mac-only [:rest forms]
|
2017-11-30 15:43:58 +03:00
|
|
|
(if (= "darwin" (os))
|
2017-12-07 16:59:55 +03:00
|
|
|
(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))
|
2017-12-07 16:59:55 +03:00
|
|
|
(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]
|
2017-12-04 11:29:15 +03:00
|
|
|
(if (= "windows" (os))
|
2017-12-07 16:59:55 +03:00
|
|
|
(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]
|
|
|
|
(if (not (= "windows" (os)))
|
|
|
|
(cons (quote do) forms)
|
|
|
|
()))
|
|
|
|
|
2017-12-12 17:08:33 +03:00
|
|
|
(defdynamic 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")
|
2018-05-20 10:57:51 +03:00
|
|
|
(if (= (length names) 1)
|
2017-12-12 17:08:33 +03:00
|
|
|
(list (list 'use (car names)))
|
|
|
|
(cons (list 'use (car names)) (use-all-fn (cdr names))))));(use-all (cdr names))))))
|
|
|
|
|
|
|
|
(defmacro use-all [:rest names]
|
|
|
|
(cons 'do (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]
|
|
|
|
(list 'do
|
|
|
|
(list 'load (str name ".carp"))
|
|
|
|
(list 'use name)))
|
|
|
|
|
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)))
|
|
|
|
|
2017-12-15 11:24:16 +03:00
|
|
|
(defmacro defn-do [name arguments :rest body]
|
2017-12-14 18:28:06 +03:00
|
|
|
(list 'defn name arguments (cons 'do body)))
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
(defdynamic 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
|
|
|
|
|
|
|
(defdynamic build-vararg [fn 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)
|
|
|
|
(list fn (car forms) (build-vararg fn (cdr forms))))))
|
|
|
|
|
|
|
|
(defmacro and* [:rest forms]
|
|
|
|
(build-vararg 'and forms))
|
|
|
|
|
|
|
|
(defmacro or* [:rest forms]
|
|
|
|
(build-vararg 'or forms))
|
|
|
|
|
|
|
|
(defdynamic 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)
|
2017-12-29 13:49:51 +03:00
|
|
|
(list 'str (car forms))
|
2018-05-20 07:04:47 +03:00
|
|
|
(list 'StringCopy.append (list 'str (car forms)) (build-str* (cdr forms))))))
|
2017-12-29 13:49:51 +03:00
|
|
|
|
|
|
|
(defmacro str* [:rest forms]
|
|
|
|
(build-str* forms))
|
|
|
|
|
|
|
|
(defmacro println* [:rest forms]
|
|
|
|
(list 'IO.println (list 'ref (build-str* forms))))
|
2018-01-25 19:26:20 +03:00
|
|
|
|
2018-03-11 16:53:50 +03:00
|
|
|
(defmacro print* [:rest forms]
|
|
|
|
(list 'IO.print (list 'ref (build-str* forms))))
|
|
|
|
|
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
|
|
|
|
|
|
|
;; Allows inclusion of C headers relative to the Carp file in which this macro is called.
|
|
|
|
(defmacro relative-include [file]
|
2018-03-13 11:36:18 +03:00
|
|
|
(list 'local-include
|
2018-03-13 12:16:48 +03:00
|
|
|
(list 'Dynamic.String.join [(list 'Dynamic.String.directory (list 'source-path))
|
2018-03-13 11:36:18 +03:00
|
|
|
"/"
|
|
|
|
file])))
|
2018-03-27 10:05:58 +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'
|
2018-03-27 11:51:16 +03:00
|
|
|
(list 'save-docs-internal (list 'quote modules)))
|