2017-06-26 12:15:03 +03:00
|
|
|
(defdynamic cond-internal [xs]
|
|
|
|
(if (= (count xs) 0)
|
|
|
|
(list)
|
|
|
|
(if (= (count xs) 2)
|
2017-12-15 19:43:06 +03:00
|
|
|
(macro-error "cond has even number of branches; add an else branch")
|
2017-06-26 12:15:03 +03:00
|
|
|
(if (= (count xs) 1)
|
|
|
|
(car xs)
|
|
|
|
(list
|
2017-10-17 10:02:12 +03:00
|
|
|
'if
|
2017-06-26 12:15:03 +03:00
|
|
|
(car xs)
|
|
|
|
(car (cdr xs))
|
|
|
|
(cond-internal (cdr (cdr xs))))))))
|
|
|
|
|
|
|
|
(defmacro cond [:rest xs]
|
|
|
|
(cond-internal xs))
|
|
|
|
|
|
|
|
(defmacro for [settings body] ;; settings = variable, from, to, <step>
|
|
|
|
(list
|
2017-10-17 10:02:12 +03:00
|
|
|
'let
|
2017-06-26 12:15:03 +03:00
|
|
|
(array (car settings) (car (cdr settings)))
|
|
|
|
(list
|
2017-10-17 10:02:12 +03:00
|
|
|
'while
|
|
|
|
(list 'Int.< (car settings) (car (cdr (cdr settings))))
|
|
|
|
(list 'do
|
2017-06-26 12:15:03 +03:00
|
|
|
body
|
|
|
|
(list
|
2017-10-17 10:02:12 +03:00
|
|
|
'set! (list 'ref (car settings))
|
|
|
|
(list 'Int.+
|
2017-06-26 12:15:03 +03:00
|
|
|
(car settings)
|
|
|
|
(if (= 4 (count settings)) ;; optional arg for step
|
|
|
|
(car (cdr (cdr (cdr 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
|
|
|
|
2017-10-18 13:25:42 +03:00
|
|
|
(defmacro foreach [f xs]
|
|
|
|
(list 'for ['i 0 (list 'count (list 'ref xs))]
|
|
|
|
(list f (list 'nth (list 'ref xs) 'i))))
|
2017-10-18 23:44:15 +03:00
|
|
|
|
|
|
|
(defdynamic thread-first-internal [xs]
|
|
|
|
(if (= (count xs) 2)
|
|
|
|
(if (list? (last xs))
|
|
|
|
(cons (car (car (cdr xs)))
|
|
|
|
(cons (car xs)
|
|
|
|
(cdr (car (cdr xs)))))
|
|
|
|
(list (car (cdr xs)) (car xs)))
|
|
|
|
(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]
|
|
|
|
(if (= (count xs) 2)
|
|
|
|
(if (list? (last xs))
|
|
|
|
(cons-last (car xs) (last xs))
|
|
|
|
(list (car (cdr xs)) (car xs)))
|
|
|
|
(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]
|
|
|
|
(list 'let (array 'tmp y) (list 'do (list 'set! &y x) (list 'set! &x 'tmp))))
|
2017-11-30 15:43:58 +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
|
|
|
|
|
|
|
(defdynamic use-all-fn [names]
|
|
|
|
(if (= (count names) 0)
|
|
|
|
(macro-error "Trying to call use-all without arguments")
|
|
|
|
(if (= (count names) 1)
|
|
|
|
(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
|
|
|
|
|
|
|
(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]
|
|
|
|
(if (= (count xs) 0)
|
|
|
|
(list)
|
|
|
|
(if (= (count xs) 2)
|
2017-12-15 11:24:16 +03:00
|
|
|
(macro-error "case has even number of branches; add an else branch")
|
2017-12-14 18:28:06 +03:00
|
|
|
(if (= (count xs) 1)
|
|
|
|
(car xs)
|
|
|
|
(list 'if
|
|
|
|
(list '= name (car xs))
|
|
|
|
(car (cdr xs))
|
|
|
|
(case-internal name (cdr (cdr xs))))))))
|
|
|
|
|
|
|
|
(defmacro case [name :rest forms]
|
|
|
|
(case-internal name forms))
|