mirror of
https://github.com/carp-lang/Carp.git
synced 2024-11-04 01:25:04 +03:00
bd553fb78e
These macros apply an operation to the current value of a variable and
then set the variable to the result of the application. They are
effectively sugar for writing `(set! <var> (<op> <var> <val>))` and
should be familiar to those who have programmed in imperative languages
like C.
In Carp, all the underlying operations these macros use are interfaces,
so one can flexibly use them for more than just numeric types.
Example usage:
```clojure
(let-do [dial 0]
;; crank it up to 11!
(while-do (dial < 12)
(++ dial))
dial)
;; expanded
(let-do [dial 0]
;; crank it up to 11!
(while-do (dial < 12)
(set! dial (inc dial)))
dial)
```
422 lines
14 KiB
Plaintext
422 lines
14 KiB
Plaintext
;; Defining the meta data macros early so that they can be used by all the other code.
|
|
;; Defined early so that `doc` can accept a rest arg
|
|
(meta-set! map-internal "hidden" true)
|
|
(defndynamic map-internal [f xs acc]
|
|
(if (= 0 (length xs))
|
|
acc
|
|
(map-internal f (cdr xs) (cons-last (f (car xs)) acc))))
|
|
|
|
(meta-set! list-to-array-internal "hidden" true)
|
|
(defndynamic list-to-array-internal [xs acc]
|
|
(if (= 0 (length xs))
|
|
acc
|
|
(list-to-array-internal (cdr xs) (append acc (array (car xs))))))
|
|
|
|
(defmodule Dynamic
|
|
(defndynamic quoted [x]
|
|
(list 'quote x))
|
|
|
|
(defndynamic /= [a b] (not (= a b)))
|
|
|
|
(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)))))
|
|
|
|
(defmodule List
|
|
; this should be defined using cond, but is defined before cond
|
|
(defndynamic in? [elem l]
|
|
(if (empty? l)
|
|
false
|
|
(if (= elem (car l))
|
|
true
|
|
(List.in? elem (cdr l))))))
|
|
|
|
(defndynamic string? [s]
|
|
(= (dynamic-type s) 'string))
|
|
|
|
(defndynamic symbol? [s]
|
|
(= (dynamic-type s) 'symbol))
|
|
|
|
(defndynamic list? [s]
|
|
(= (dynamic-type s) 'list))
|
|
|
|
(defndynamic array? [s]
|
|
(= (dynamic-type s) 'array))
|
|
|
|
(defndynamic number? [s]
|
|
(List.in? (dynamic-type s) '(int long double float byte))))
|
|
|
|
(meta-set! doc "doc" "Set documentation for a binding.")
|
|
(defmacro doc [name :rest strings]
|
|
(let [newline "
|
|
" ;; Looks a bit odd but the newline literal is important here! (str \newline) currently results in unwanted escapes
|
|
separated (map-internal (fn [x] (if (list? x)
|
|
(if (cadr x)
|
|
(Dynamic.String.concat [(car x) newline])
|
|
(car x))
|
|
(Dynamic.String.concat [x newline])))
|
|
strings
|
|
())]
|
|
(eval (list 'meta-set! name "doc" (Dynamic.String.concat (list-to-array-internal separated []))))))
|
|
|
|
(doc print-doc "Print the documentation for a binding.")
|
|
(defmacro print-doc [name]
|
|
(eval (list 'macro-log (list 'meta name "doc"))))
|
|
|
|
(doc sig "Annotate a binding with the desired signature.")
|
|
(defmacro sig [name signature]
|
|
(eval (list 'meta-set! name "sig" signature)))
|
|
|
|
(doc print-sig "Print the annotated signature for a binding.")
|
|
(defmacro print-sig [name]
|
|
(eval (list 'macro-log (list 'meta name "sig"))))
|
|
|
|
(doc hidden "Mark a binding as hidden, this will make it not print with the 'info' command.")
|
|
(defmacro hidden [name]
|
|
(eval (list 'meta-set! name "hidden" true)))
|
|
|
|
(doc private "Mark a binding as private, this will make it inaccessible from other modules.")
|
|
(defmacro private [name]
|
|
(eval (list 'meta-set! name "private" true)))
|
|
|
|
(hidden and-)
|
|
(defndynamic and- [xs]
|
|
; (defndynamic and- [xs] ; shorter but currently not entirely stable
|
|
; (if (= 0 (length xs))
|
|
; true
|
|
; (list 'if (car xs) (and- (cdr xs)) false) ))
|
|
(if (= 0 (length xs))
|
|
true
|
|
(if (= 1 (length xs))
|
|
(car xs)
|
|
(list 'if (car xs) (and- (cdr xs)) false) )))
|
|
(doc and "evaluates the forms `xs` one at a time, from left to right. If a form
|
|
evaluates to `false`, `and` returns that value and doesn't evaluate any of the
|
|
other expressions, otherwise it returns the value of the last form in `xs`.
|
|
`(and)` returns `true`.")
|
|
(defmacro and [:rest xs]
|
|
(and- xs))
|
|
|
|
(hidden or-)
|
|
(defndynamic or- [xs]
|
|
; (if (= 0 (length xs)) ; shorter but currently not entirely stable
|
|
; false
|
|
; (list 'if (car xs) true (or- (cdr xs))) ))
|
|
(if (= 0 (length xs))
|
|
false
|
|
(if (= 1 (length xs))
|
|
(car xs)
|
|
(list 'if (car xs) true (or- (cdr xs))) )))
|
|
(doc or "evaluates the forms `xs` one at a time, from left to right. If a form
|
|
evaluates to `true`, `or` returns that value and doesn't evaluate any of the
|
|
other expressions, otherwise it returns the value of the last form in `xs`.
|
|
`(or)` returns `false`.")
|
|
(defmacro or [:rest xs]
|
|
(or- xs))
|
|
|
|
|
|
(doc todo "sets the todo property for a binding.")
|
|
(defmacro todo [name value]
|
|
(eval (list 'meta-set! name "todo" value)))
|
|
|
|
(doc private? "Is this binding private?")
|
|
(defmacro private? [name]
|
|
(eval (list 'not (list 'list? (list 'meta name "private")))))
|
|
|
|
(doc hidden? "Is this binding hidden?")
|
|
(defmacro hidden? [name]
|
|
(eval (list 'not (list 'list? (list 'meta name "hidden")))))
|
|
|
|
(hidden annotate-helper)
|
|
(defndynamic annotate-helper [name annotation]
|
|
(list 'cons annotation (list 'meta name "annotations")))
|
|
|
|
(doc annotate "Add an annotation to this binding.")
|
|
(defmacro annotate [name annotation]
|
|
(eval (list 'meta-set! name "annotations" (eval (annotate-helper name annotation)))))
|
|
|
|
(doc deprecated "Declares that a binding is deprecated, using an optional explanation.")
|
|
(defmacro deprecated [name :rest explanation]
|
|
(let [v (if (= (length explanation) 0) true (car explanation))]
|
|
(eval (list 'meta-set! name "deprecated" v))))
|
|
|
|
(doc defn- "Declares a function while marking it as private and hidden.")
|
|
(defmacro defn- [name args form]
|
|
(do
|
|
(eval (list 'private name))
|
|
(eval (list 'hidden name))
|
|
(list 'defn name args form)))
|
|
|
|
(doc def- "Declares a variable while marking it as private and hidden.")
|
|
(defmacro def- [name value]
|
|
(do
|
|
(eval (list 'private name))
|
|
(eval (list 'hidden name))
|
|
(list 'def name value)))
|
|
|
|
(hidden cond-internal)
|
|
(defndynamic cond-internal [xs]
|
|
(if (= (length xs) 0)
|
|
(list)
|
|
(if (= (length xs) 2)
|
|
(macro-error "cond has even number of branches; add an else branch")
|
|
(if (= (length xs) 1)
|
|
(car xs)
|
|
(list
|
|
'if
|
|
(car xs)
|
|
(cadr xs)
|
|
(cond-internal (cddr xs)))))))
|
|
|
|
(doc cond
|
|
"Executes a block of code if a specified condition is true. Multiple"
|
|
"such blocks can be chained."
|
|
""
|
|
"```"
|
|
"(cond"
|
|
" (< 10 1) (println \"Condition 1 is true\")"
|
|
" (> 10 1) (println \"Condition 2 is true\")"
|
|
" (println \"Else branch\"))"
|
|
"```")
|
|
(defmacro cond [:rest xs]
|
|
(cond-internal xs))
|
|
|
|
(doc refstr "stringifies `x` and takes the reference of that string.")
|
|
(defmacro refstr [x]
|
|
(list 'ref
|
|
(list 'str x)))
|
|
|
|
(doc swap! "swaps its arguments `x` and `y` in place.
|
|
|
|
*Note*: Unhygienic!")
|
|
(defmacro swap! [x y]
|
|
(list 'let (array 'tmp y) (list 'do (list 'set! y x) (list 'set! x 'tmp))))
|
|
|
|
(doc update! "updates `x` in place using the function `f`.")
|
|
(defmacro update! [x f]
|
|
(list 'set! x (list f x)))
|
|
|
|
(hidden use-all-fn)
|
|
(defndynamic use-all-fn [names]
|
|
(if (= (length names) 0)
|
|
(macro-error "Trying to call use-all without arguments")
|
|
(do
|
|
(eval (list 'use (car names)))
|
|
(if (= (length names) 1)
|
|
()
|
|
(use-all-fn (cdr names))))))
|
|
|
|
(doc use-all "is a variadic version of `use`.")
|
|
(defmacro use-all [:rest names]
|
|
(use-all-fn names))
|
|
|
|
(doc load-and-use "loads a file and uses the module with in it. Assumes that
|
|
the filename and module name are the same.")
|
|
(defmacro load-and-use [name]
|
|
(do
|
|
(eval (list 'load (str name ".carp")))
|
|
(eval (list 'use name))))
|
|
|
|
(doc comment "ignores `forms`.")
|
|
(defmacro comment [:rest forms]
|
|
())
|
|
|
|
(hidden build-vararg)
|
|
(defndynamic build-vararg [func forms]
|
|
(if (= (length forms) 0)
|
|
(macro-error "vararg macro needs at least one argument")
|
|
(if (= (length forms) 1)
|
|
(car forms)
|
|
(list func (car forms) (build-vararg func (cdr forms))))))
|
|
|
|
(doc ignore "ignores the return value of the expression `form`.")
|
|
(defmacro ignore [form]
|
|
(list 'let (array '_ form) (list)))
|
|
|
|
(doc ignore* "Wraps all forms passed as an argument in a call to [`ignore`](#ignore).")
|
|
(defmacro ignore* [:rest forms]
|
|
(map (fn [x] (cons-last x (list 'ignore))) forms))
|
|
|
|
(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)))
|
|
|
|
(doc defdynamic-once "Creates a dynamic variable and sets its value if it's not already defined.")
|
|
(defmacro defdynamic-once [var expr]
|
|
(eval
|
|
(list 'if (list 'defined? var)
|
|
()
|
|
(list 'defdynamic var expr))))
|
|
|
|
(doc inline-c "Inlines some custom C code.")
|
|
(defmacro inline-c [name defcode :rest declcode]
|
|
(eval (list 'deftemplate name (list) defcode (if (empty? declcode) "" (car declcode)))))
|
|
|
|
(doc bottom "aborts the program if reached.")
|
|
(deftemplate bottom (Fn [] a) "$a $NAME()" "$DECL { abort(); }")
|
|
|
|
(doc unreachable
|
|
"Asserts that a block of code will never be reached. If it is"
|
|
"the program will be aborted with an error message.")
|
|
(defmacro unreachable [msg]
|
|
(list 'do
|
|
(list 'IO.println
|
|
(list 'ref
|
|
(list 'fmt "%s:%d:%d: %s"
|
|
(eval (list 'file msg))
|
|
(eval (list 'line msg))
|
|
(eval (list 'column msg))
|
|
msg)))
|
|
(list 'System.abort)
|
|
(list 'bottom)))
|
|
|
|
(hidden implement-declaration)
|
|
(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"
|
|
"of those interfaces.")
|
|
(defmacro implements-all [mod :rest interfaces]
|
|
(cons 'do (map (curry implement-declaration mod) interfaces)))
|
|
|
|
(doc ++
|
|
"Sets the value of a variable to its current value incremented by one.")
|
|
(defmacro ++ [var]
|
|
(list 'set! var (list 'inc var)))
|
|
|
|
(doc --
|
|
"Sets the value of a variable to its current value decremented by one.")
|
|
(defmacro -- [var]
|
|
(list 'set! var (list 'dec var)))
|
|
|
|
(doc +=
|
|
"Sets the value of a variable to its current value plus `val`.")
|
|
(defmacro += [var val]
|
|
(list 'set! var (list '+ var val)))
|
|
|
|
(doc -=
|
|
"Sets the value of a variable to its current value minus `val`.")
|
|
(defmacro -= [var val]
|
|
(list 'set! var (list '- var val)))
|
|
|
|
(doc *=
|
|
"Sets the value of a variable to its current value multiplied by `val`.")
|
|
(defmacro *= [var val]
|
|
(list 'set! var (list '* var val)))
|
|
|
|
(defmodule Unsafe
|
|
(defmodule C
|
|
(defndynamic emit-c-line [append-strings args]
|
|
(let [strs (map (fn [x] (String.concat [x " "])) (map str args))
|
|
arr (collect-into strs array)
|
|
code (String.concat (append append-strings arr))]
|
|
(list 'Unsafe.preproc (list 'Unsafe.emit-c code))))
|
|
|
|
(doc pragma
|
|
"Emits a #pragma compiler directive in Carp's c output.")
|
|
(defmacro pragma [:rest args]
|
|
(eval (Unsafe.C.emit-c-line ["#pragma "] args)))
|
|
|
|
(doc define
|
|
"Emits a #define compiler directive in Carp's c output.")
|
|
(defmacro define [name value]
|
|
(Unsafe.C.emit-c-line ["#define "] [name value]))
|
|
|
|
(doc undef
|
|
"Emits a #undef compiler directive in Carp's c output.")
|
|
(defmacro undef [name]
|
|
(Unsafe.C.emit-c-line ["#undef "] [name]))
|
|
|
|
(defndynamic if- [if-pre name then else]
|
|
(do (eval (Unsafe.C.emit-c-line [if-pre] [name]))
|
|
(eval (Unsafe.C.emit-c-line [" "] [then]))
|
|
(if (not (empty? else))
|
|
(do (eval (Unsafe.C.emit-c-line ["#else"] []))
|
|
(eval (Unsafe.C.emit-c-line [" "] else)))
|
|
())
|
|
(eval (Unsafe.C.emit-c-line ["#endif"] []))))
|
|
|
|
(doc ifpre
|
|
"Emits a #if compiler directive in Carp's c output.")
|
|
(defmacro ifpre [name then :rest else]
|
|
(Unsafe.C.if- "#if " name then else))
|
|
|
|
(doc ifdef
|
|
"Emits a #ifdef compiler directive in Carp's c output.")
|
|
(defmacro ifdef [name then :rest else]
|
|
(Unsafe.C.if- "#ifdef " name then else))
|
|
|
|
(doc ifndef
|
|
"Emits a #ifndef compiler directive in Carp's c output.")
|
|
(defmacro ifndef [name then :rest else]
|
|
(Unsafe.C.if- "#ifndef " name then else))
|
|
|
|
(doc warning
|
|
"Emits a #warning compiler directive in Carp's c output.")
|
|
(defmacro warning [message]
|
|
(eval (Unsafe.C.emit-c-line ["#warning "] [message])))
|
|
|
|
(doc error
|
|
"Emits a #error compiler directive in Carp's c output.")
|
|
(defmacro error [message]
|
|
(eval (Unsafe.C.emit-c-line ["#error "] [message])))
|
|
|
|
(hidden asmify)
|
|
(defndynamic asmify [instruction]
|
|
(if (string? instruction)
|
|
(String.concat ["\"" instruction "\" "])
|
|
(str instruction)))
|
|
|
|
(doc asm
|
|
"Allows to define a named ASM construct. It allows both simple and "
|
|
"extended ASM."
|
|
""
|
|
"Example:"
|
|
"```"
|
|
"; exits with eit code 5, uses macOS syscalls"
|
|
"(Unsafe.C.asm exit5 \"mov $0x2000001, %rax\\n\" \"mov $5, %rdi\\n\" \"syscall\")"
|
|
""
|
|
"; writes from a variable called src into a variable dst and then adds 1 to dst"
|
|
"(Unsafe.C.asm addr \"mov %1, %0\\n\" \"add $1, %0\\n\" : \"=r\" (dst) : \"r\" (src))"
|
|
"```")
|
|
(defmacro asm [name :rest instructions]
|
|
(do
|
|
(eval (list 'Unsafe.C.define (String.concat [(str name) "()"])
|
|
(String.concat [
|
|
"__asm__("
|
|
(String.concat (collect-into (Dynamic.map Unsafe.C.asmify instructions) array))
|
|
");"])))
|
|
(eval (list 'register name '(Fn [] ())))))
|
|
)
|
|
)
|