Carp/core/Macros.carp

(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)))))
(defdynamic cddddr [pair] (cdr (cdr (cdr (cdr pair)))))

(defdynamic cond-internal [xs]
  (if (= (count xs) 0)
    (list)
    (if (= (count xs) 2)
      (macro-error "cond has even number of branches; add an else branch")
      (if (= (count xs) 1)
        (car xs)
        (list
         'if
         (car xs)
         (cadr xs)
         (cond-internal (cddr xs)))))))

(defmacro cond [:rest xs]
  (cond-internal xs))

(defmacro for [settings :rest body] ;; settings = variable, from, to, <step>
  (if (> (count body) 1) 
    (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
            (if (= (count body) 0)
              ()
              (if (list? body)
                (car body)
                body))
            (list
             'set! (list 'ref (car settings))
             (list 'Int.+
                   (car settings)
                   (if (= 4 (count settings)) ;; optional arg for step
                     (cadddr settings)
                     1))))))))

(defmacro refstr [x]
  (list 'ref
        (list 'str x)))

(defmacro foreach [f xs]
  (list 'for ['i 0 (list 'count (list 'ref xs))]
        (list f (list 'nth (list 'ref xs) 'i))))

(defdynamic thread-first-internal [xs]
  (if (= (count 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))))))

(defdynamic thread-last-internal [xs]
  (if (= (count 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))))))

(defmacro => [:rest forms]
  (thread-first-internal forms))

(defmacro ==> [:rest forms]
  (thread-last-internal forms))

(defmacro swap! [x y]
  (list 'let (array 'tmp y) (list 'do (list 'set! &y x) (list 'set! &x 'tmp))))

(defmacro update! [x f]
  (list 'set! &x (list f x)))

(defmacro mac-only [:rest forms]
  (if (= "darwin" (os))
    (cons (quote do) forms)
    ()))

(defmacro linux-only [:rest forms]
  (if (= "linux" (os))
    (cons (quote do) forms)
    ()))

(defmacro windows-only [:rest forms]
  (if (= "windows" (os))
    (cons (quote do) forms)
    ()))

(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)))

(defmacro when [condition form]
  (list 'if condition form (list)))

(defmacro unless [condition form]
  (list 'if condition (list) form))

(defmacro let-do [bindings :rest forms]
  (list 'let bindings
    (cons 'do forms)))

(defmacro defn-do [name arguments :rest body]
  (list 'defn name arguments (cons 'do body)))

(defmacro comment [:rest forms]
  ())

(defmacro forever-do [:rest forms]
  (list 'while true (cons 'do forms)))

(defdynamic case-internal [name xs]
  (if (= (count xs) 0)
    (list)
    (if (= (count xs) 2)
      (macro-error "case has even number of branches; add an else branch")
      (if (= (count xs) 1)
        (car xs)
        (list 'if
         (list '= name (car xs))
          (cadr xs)
          (case-internal name (cddr xs)))))))

(defmacro case [name :rest forms]
  (case-internal name forms))

(defdynamic build-vararg [fn forms]
  (if (= (count forms) 0)
    (macro-error "vararg macro needs at least one argument")
    (if (= (count forms) 1)
      (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]
  (if (= (count forms) 0)
    (list "")
    (if (= (count forms) 1)
      (list 'str (car forms))
      (list 'String.append (list 'str (car forms)) (build-str* (cdr forms))))))

(defmacro str* [:rest forms]
  (build-str* forms))

(defmacro println* [:rest forms]
  (list 'IO.println (list 'ref (build-str* forms))))

(defmacro ignore [form]
  (list 'let (array '_ form) (list)))