apricot 0.0.1

data/kernel/core.apr

@@ -0,0 +1,928 @@
+; The core apricot library
+
+(ns Apricot::Core)
+
+; Basics
+
+(def raise Kernel/raise)
+
+; Needed in defn, will redefine with documentation later.
+(def list
+  (fn list [& items]
+    (.to_list items)))
+
+; Needed in defn, will redefine with documentation later.
+(def concat
+  (fn concat [& colls]
+    (.to_list (.reduce (.map colls | :to_a) [] :+))))
+
+(def defn
+  (fn defn [name & body]
+    (let [doc-string (if (.is_a? (.first body) String)
+                       (.shift body))
+          metadata (if (.is_a? (.first body) Hash)
+                     (.shift body)
+                     {})
+          arglists (if (.is_a? (.first body) Array)
+                     (list (.first body))
+                     (.to_list
+                       (.map body | #(if (.is_a? % Apricot::List)
+                                       (.first %)))))
+          f (.intern Apricot::Identifier (.gensym Apricot))]
+      (list 'let [f (concat (list 'fn name) body)]
+            (list 'def name f)
+            (list '.apricot_meta=
+                  f
+                  (.merge! {:name (list 'quote name)
+                            :doc doc-string
+                            :arglists (list 'quote arglists)}
+                           metadata))
+            f))))
+(.apricot_meta=
+  defn
+  {:name 'defn
+   :doc "Define a new function."
+   :arglists '([name doc-string? metadata? [params ...] body]
+               [name doc-string? metadata? ([params ...] body) ...+])
+   :macro true})
+
+(defn defmacro
+  "Like defn, but the resulting function name is declared as a macro and will
+  be used as a macro by the compiler when it is called."
+  {:arglists '([name doc-string? metadata? [params ...] body]
+               [name doc-string? metadata? ([params ...] body) ...+])
+   :macro true}
+  [name & body]
+  (let [f (.intern Apricot::Identifier (.gensym Apricot))]
+    (list 'let [f (concat (list 'defn name) body)]
+          (list '.store (list '.apricot_meta f) :macro true)
+          f)))
+
+(defn list
+  "Create a new list containing the items."
+  [& items] (.to_list items))
+
+(defn concat
+  "Concatenate the items in the supplied colls into a single list."
+  [& colls] (.to_list (.reduce (.map colls | :to_a) [] :+)))
+
+(defn array
+  "Create a new array containing the items."
+  [& items] items)
+
+(defn set
+  "Create a new set containing the items."
+  [& items] (Set. items))
+
+(defn hash
+  "Create a new hash map from the items. The items are interpreted as a list of
+  key/value pairs so there must be an even number of them."
+  [& items]
+  (if (.even? (.length items))
+    (let [h {}]
+      (.each_slice items 2 | #(.store h %1 %2))
+      h)
+    (raise ArgumentError "hash requires an even number of arguments")))
+
+(defn cons
+  "Return a new list where head is the first element and tail is the rest."
+  [head tail] (Apricot::Cons. head tail))
+
+(defn apply
+  "Applies fn f to the argument list formed by prepending intervening
+  arguments to args."
+  ([f args]
+   (.apricot_call f & args))
+  ([f x & args]
+   (.apricot_call f & (cons x (.concat args (.pop args))))))
+
+;; At this point everything is defined that syntax quote requires
+
+(defn identifier
+  "Return an identifier with the given name."
+  [name] (.intern Apricot::Identifier name))
+
+(defn symbol
+  "Return a symbol with the given name."
+  [name] (.to_sym name))
+
+(defn gensym
+  "Return a new identifier with a unique name. If a prefix string is supplied,
+  the name is prefix__# where # is some unique number. If prefix is not
+  supplied, the prefix is 'g'."
+  [[prefix "g"]]
+  (identifier (.gensym Apricot prefix)))
+
+(defn require
+  "Require the given Ruby files. Works just like using Ruby's 'require' on
+  each of the arguments."
+  [& files]
+  ; (. Kernel require %) does not call the Rubygems custom require for some
+  ; reason, so we use this method. (MAIN is the special toplevel object).
+  (.each files | #(. MAIN send :require %)))
+
+(defn str
+  "With no args, return the empty string. With one arg x, return x converted
+  to a string. With more than one arg, return the concatenation of the str
+  values of the args."
+  ([] "")
+  ([x] (.apricot_str x))
+  ([x & args]
+   (.reduce args (.apricot_str x) | #(.concat %1 (.apricot_str %2)))))
+
+(defn print
+  "Print the object(s) to standard output."
+  [& args] (Kernel/print (apply str args)))
+
+(defn println
+  "Print the object(s) followed by a newline at the end to standard output."
+  [& args] (Kernel/puts (apply str args)))
+
+(def macroexpand Apricot/macroexpand)
+(def macroexpand-1 Apricot/macroexpand_1)
+
+; Type predicates
+
+(defn instance?
+  "Test if x is an instance of class c. Return true or false."
+  [c x] (.is_a? x c))
+
+(defn module?
+  "Return true if x is an instance of Module."
+  [x] (instance? Module x))
+
+(defn class?
+  "Return true if x is an instance of Class."
+  [x] (instance? Class x))
+
+(defn seq?
+  "Return true if x is an instance of an Apricot::Seq class."
+  [x] (instance? Apricot::Seq x))
+
+(defn array?
+  "Return true if x is an instance of Array."
+  [x] (instance? Array x))
+
+(defn list?
+  "Return true if x is an instance of Apricot::List."
+  [x] (instance? Apricot::List x))
+
+(defn hash?
+  "Return true if x is an instance of Hash."
+  [x] (instance? Hash x))
+
+(defn set?
+  "Return true if x is an instance of Set."
+  [x] (instance? Set x))
+
+(defn string?
+  "Return true if x is an instance of String."
+  [x] (instance? String x))
+
+(defn regexp?
+  "Return true if x is an instance of Regexp."
+  [x] (instance? Regexp x))
+
+(defn identifier?
+  "Return true if x is an instance of Apricot::Identifier."
+  [x] (instance? Apricot::Identifier x))
+
+(defn symbol?
+  "Return true if x is an instance of Symbol."
+  [x] (instance? Symbol x))
+
+(defn number?
+  "Return true if x is an instance of Numeric."
+  [x] (instance? Numeric x))
+
+(defn ratio?
+  "Return true if x is an instance of Rational."
+  [x] (instance? Rational x))
+
+(defn integer?
+  "Return true if x is an instance of Integer."
+  [x] (instance? Integer x))
+
+(defn fixnum?
+  "Return true if x is an instance of Fixnum."
+  [x] (instance? Fixnum x))
+
+(defn bignum?
+  "Return true if x is an instance of Bignum."
+  [x] (instance? Bignum x))
+
+(defn float?
+  "Return true if x is an instance of Float."
+  [x] (instance? Float x))
+
+(defn complex?
+  "Return true if x is an instance of Complex."
+  [x] (instance? Complex x))
+
+(defn range?
+  "Return true if x is an instance of Range."
+  [x] (instance? Range x))
+
+(defn comparable?
+  "Return true if x is an instance of a Comparable class."
+  [x] (instance? Comparable x))
+
+(defn enumerable?
+  "Return true if x is an instance of an Enumerable class."
+  [x] (instance? Enumerable x))
+
+; Basic logic predicates, functions, and macros
+
+(defn nil?
+  "Return true if x is nil, false otherwise."
+  [x] (.nil? x))
+
+(defn true?
+  "Return true if x is the value true, false otherwise."
+  [x] (.equal? x true))
+
+(defn false?
+  "Return true if x is the value false, false otherwise."
+  [x] (.equal? x false))
+
+(defn not
+  "Return true if x is logical false, false otherwise."
+  [x] (if x false true))
+
+(defmacro and
+  "Evaluate exprs one at a time, from left to right. If a form returns logical
+  false (nil or false), return that value and don't evaluate any of the other
+  expressions, otherwise return the value of the last expr. (and) returns
+  true."
+  ([] true)
+  ([x] x)
+  ([x & more]
+   `(let [and# ~x]
+      (if and# (and ~@more) and#))))
+
+(defmacro or
+  "Evaluate exprs one at a time, from left to right. If a form returns a
+  logical true value, return that value and don't evaluate any of the other
+  expressions, otherwise return the value of the last expression. (or) returns
+  nil."
+  ([] nil)
+  ([x] x)
+  ([x & more]
+   `(let [or# ~x]
+      (if or# or# (or ~@more)))))
+
+; Collection functions
+
+(defn seq
+  "Returns a seq on the collection. If the collection is empty, returns nil.
+  (seq nil) returns nil."
+  [coll] (.to_seq coll))
+
+(defn first
+  "Return the first item in the collection. Call seq on the argument. If coll
+  is nil, return nil."
+  [coll] (.first (seq coll)))
+
+(defn rest
+  "Return a possibly empty seq of the items after the first. Call seq on the
+  argument."
+  [coll] (.rest (seq coll)))
+
+(defn next
+  "Return a seq of the items after the first. Call seq on the argument. If
+  there are no more items, return nil."
+  [coll] (.next (seq coll)))
+
+(defn empty?
+  "Return true if coll has no items - same as (not (seq coll)). Please use the
+  idiom (seq x) rather than (not (empty? x))"
+  [coll] (not (seq coll)))
+
+(defn second
+  "Same as (first (next coll))."
+  [coll] (first (next coll)))
+
+(defn ffirst
+  "Same as (first (first coll))."
+  [coll] (first (first coll)))
+
+(defn nfirst
+  "Same as (next (first coll))."
+  [coll] (next (first coll)))
+
+(defn fnext
+  "Same as (first (next coll))."
+  [coll] (first (next coll)))
+
+(defn last
+  "Return the last item in coll."
+  [coll] (.last coll))
+
+(defn butlast [coll]
+  "Return all but the last item in coll."
+  (if (empty? coll)
+    []
+    (.take coll (. (.count coll) - 1))))
+
+(defn nth
+  "Return the value at the given index in coll. If the index is out of bounds,
+  return not-found if it is supplied. Otherwise raise an exception."
+  ([coll index]
+   (.fetch coll index))
+  ([coll index not-found]
+   (.fetch coll index not-found)))
+
+(defn count
+  "Return the number of items in coll."
+  [coll] (.count coll))
+
+(defn take
+  "Return the first n items in coll."
+  [n coll] (.take coll n))
+
+(defn drop
+  "Return all but the first n items in coll."
+  [n coll] (.drop coll n))
+
+(defn reverse
+  "Return the items in coll in reverse order."
+  [coll] (.reverse coll))
+
+(defn map
+  "Return an array consisting of the result of applying f to the set of first
+  items of each coll, followed by applying f to the set of second items in
+  each coll, until any one of the colls is exhausted. Any remaining items in
+  other colls are exhausted. Function f should accept number-of-colls
+  arguments."
+  ([f coll]
+   (.map coll | f))
+  ([f coll & colls]
+   (.map (.zip coll & colls) | #(apply f %))))
+
+(defn reduce
+  "f should be a function of 2 arguments. If val is not supplied, return the
+  result of applying f to the first 2 items in coll, then applying f to that
+  result and the 3rd item, etc. If coll contains no items, f must accept no
+  arguments as well, and reduce returns the result of calling f with no
+  arguments. If coll has only 1 item, it is returned and f is not called. If
+  val is supplied, return the result of applying f to val and the first item
+  in coll, then applying f to that result and the 2nd item, etc. If coll
+  contains no items, return val and f is not called."
+  ([f coll]
+   (if (empty? coll)
+     (f)
+     (.reduce coll | f)))
+  ([f val coll]
+   (.reduce coll val | f)))
+
+(defn contains?
+  "Return true if val is present in the given collection, otherwise return
+  false. Note that for hashes this checks for a key."
+  [coll val]
+  (.include? coll val))
+
+; Hash map functions
+(defn get
+  "Return the value mapped to key, not-found or nil if key not present."
+  ([map key]
+   (.fetch map key nil))
+  ([map key not-found]
+   (.fetch map key not-found)))
+
+(defn keys
+  "Return an array of the map's keys."
+  [map] (.keys map))
+
+(defn vals
+  "Return an array of the map's values."
+  [map] (.values map))
+
+; Number predicates and functions
+
+(defn zero?
+  "Return true if num is zero, false otherwise."
+  {:inline (fn [x] `(.zero? ~x))}
+  [x] (.zero? x))
+
+(defn pos?
+  "Return true if num is greater than zero, false otherwise."
+  {:inline (fn [x] `(. ~x > 0))}
+  [x] (. x > 0))
+
+(defn neg?
+  "Return true if num is less than zero, false otherwise."
+  {:inline (fn [x] `(. ~x < 0))}
+  [x] (. x < 0))
+
+(defn even?
+  "Return true if num is even, false otherwise."
+  {:inline (fn [x] `(.even? ~x))}
+  [x] (.even? x))
+
+(defn odd?
+  "Return true if num is odd, false otherwise."
+  {:inline (fn [x] `(.odd? ~x))}
+  [x] (.odd? x))
+
+(defn nary-inline
+  {:private true}
+  [op]
+  (fn
+    ([x y] `(. ~x ~op ~y))
+    ([x y & more]
+     (.reduce more
+              `(. ~x ~op ~y)
+              | (fn [a b] `(. ~a ~op ~b))))))
+
+(defn +
+  "Return the sum of nums. (+) returns 0."
+  {:inline (fn
+             ([] 0)
+             ([x] x)
+             ([x & more] (apply (nary-inline '+) x more)))}
+  ([] 0)
+  ([x] x)
+  ([x y] (.+ x y))
+  ([x y & more]
+   (.reduce more (.+ x y) :+)))
+
+(defn *
+  "Return the product of nums. (*) returns 1."
+  {:inline (fn
+             ([] 1)
+             ([x] x)
+             ([x & more] (apply (nary-inline '*) x more)))}
+  ([] 1)
+  ([x] x)
+  ([x y] (.* x y))
+  ([x y & more]
+   (.reduce more (.* x y) :*)))
+
+(defn -
+  "If no ys are supplied, return the negation of x, otherwise subtract the ys
+  from x and return the result."
+  {:inline (fn
+             ([x] `(. ~x -@))
+             ([x & more] (apply (nary-inline '-) x more)))
+   :inline-arities #(. % > 0)}
+  ([x] (. x -@)) ; Ruby's horribly named -@ method is the negation operator
+  ([x y] (.- x y))
+  ([x y & more]
+   (.reduce more (.- x y) :-)))
+
+(defn /
+  "If no denominators are supplied, return 1/numerator, otherwise return
+  numerator divided by all of the denominators."
+  {:inline (fn
+             ([x] `(. 1 quo ~x))
+             ([x & more] (apply (nary-inline 'quo) x more)))
+   :inline-arities #(. % > 0)}
+  ([x] (.quo 1 x))
+  ([x y] (.quo x y))
+  ([x y & more]
+   (.reduce more (.quo x y) :quo)))
+
+(defn quot
+  "Return quotient of dividing numerator by denominator."
+  [num div] (.truncate (.fdiv num div)))
+
+(defn rem
+  "Return remainder of dividing numerator by denominator."
+  [num div] (.remainder num div))
+
+(defn mod
+  "Return the modulus of num and div. Truncates toward negative infinity."
+  [num div] (.modulo num div))
+
+(defn pow
+  "Return num raised to the exponent exp."
+  [num exp] (.** num exp))
+
+(defn int
+  "Coerce to integer."
+  [x] (.to_i x))
+
+(defn float
+  "Coerce to floating point."
+  [x] (.to_f x))
+
+(def ratio Kernel/Rational)
+
+(defn inc
+  "Return a number one greater than x."
+  {:inline (fn [x] `(. ~x + 1))}
+  [x] (. x + 1))
+
+(defn dec
+  "Return a number one less than x."
+  {:inline (fn [x] `(. ~x - 1))}
+  [x] (. x - 1))
+
+; Equality and inequality
+
+(defn identical?
+  "Test if the two arguments are the same object."
+  [x y] (.equal? x y))
+
+(defn =
+  "Return true if all of the arguments are equal, otherwise false. (=) returns
+  true."
+  ([x] true)
+  ([x y] (. x == y))
+  ([x y & more]
+   (and
+     (. x == y)
+     (.all? more | #(. x == %)))))
+
+(defn not=
+  "Return true if any of the arguments are not equal, otherwise false. (not=
+  returns false. Same as (not (= x y ...))."
+  ([x] false)
+  ([x y] (. x != y))
+  ([x y & more]
+   (not (apply = x y more))))
+
+(defn compare
+  "Return a negative number, zero, or a positive number when x is logically
+  'less than', 'equal to', or 'greater than' y, respectively."
+  [x y] (. x <=> y))
+
+(defn >
+  "Return true if nums are in monotonically decreasing order, otherwise false."
+  ([x] true)
+  ([x y] (. x > y))
+  ([x y & more]
+   (and
+     (. x > y)
+     (.all? (.each_cons (cons y more) 2) | #(. %1 > %2)))))
+
+(defn <
+  "Return true if nums are in monotonically increasing order, otherwise false."
+  ([x] true)
+  ([x y] (. x < y))
+  ([x y & more]
+   (and
+     (. x < y)
+     (.all? (.each_cons (cons y more) 2) | #(. %1 < %2)))))
+
+(defn >=
+  "Return true if nums are in monotonically non-increasing order, otherwise
+  false."
+  ([x] true)
+  ([x y] (. x >= y))
+  ([x y & more]
+   (and
+     (. x >= y)
+     (.all? (.each_cons (cons y more) 2) | #(. %1 >= %2)))))
+
+(defn <=
+  "Return true if nums are in monotonically non-decreasing order, otherwise
+  false."
+  ([x] true)
+  ([x y] (. x <= y))
+  ([x y & more]
+   (and
+     (. x <= y)
+     (.all? (.each_cons (cons y more) 2) | #(. %1 <= %2)))))
+
+(defn max
+  "Return the greatest of the arguments."
+  ([x] x)
+  ([x & more]
+   (.max (cons x more))))
+
+(defn min
+  "Return the least of the arguments."
+  ([x] x)
+  ([x & more]
+   (.min (cons x more))))
+
+; Bitwise operations
+
+(defn bit-not
+  "Return the bitwise complement of x (ie. flip all the bits)."
+  [x] (. x #|~|)) ; Use arbitrary identifier syntax since ~ is a special char
+
+(defn bit-and
+  "Return the bitwise and of the arguments."
+  ([x y] (. x & y))
+  ([x y & more]
+   (.reduce more (. x & y) | #(. %1 & %2))))
+
+(defn bit-or
+  "Return the bitwise or of the arguments."
+  ([x y] (. x | y))
+  ([x y & more]
+   (.reduce more (. x | y) | #(. %1 | %2))))
+
+(defn bit-xor
+  "Return the bitwise exclusive or of the arguments."
+  ([x y] (. x ^ y))
+  ([x y & more]
+   (.reduce more (. x ^ y) | #(. %1 ^ %2))))
+
+(defn bit-and-not
+  "Return the bitwise and of the first argument and the bitwise complement of
+  all arguments after the first."
+  ([x y] (bit-and x (bit-not y)))
+  ([x y & more]
+   (.reduce more (bit-and x (bit-not y)) | #(bit-and %1 (bit-not %2)))))
+
+(defn bit-shift-left
+  "Return the bitwise shift left of x by n bits."
+  [x n] (. x << n))
+
+(defn bit-shift-right
+  "Return the bitwise shift right of x by n bits."
+  [x n] (. x >> n))
+
+(defn bit-clear
+  "Return x with the bit at index n set to 0."
+  [x n] (bit-and-not x (bit-shift-left 1 n)))
+
+(defn bit-set
+  "Return x with the bit at index n set to 1."
+  [x n] (bit-or x (bit-shift-left 1 n)))
+
+(defn bit-flip
+  "Return x with the bit at index n flipped from its previous value."
+  [x n] (bit-xor x (bit-shift-left 1 n)))
+
+(defn bit-test
+  "Return true if the bit at index n is 1, otherwise false."
+  [x n] (not= 0 (bit-and x (bit-shift-left 1 n))))
+
+; Functional programming functions
+(defn complement
+  "Take a fn f and return a fn that takes the same arguments as f, has the
+  same effects, if any, and returns the opposite truth value."
+  [f]
+  (fn
+    ([] (not (f)))
+    ([x] (not (f x)))
+    ([x y] (not (f x y)))
+    ([x y & zs] (not (apply f x y zs)))))
+
+(defn constantly
+  "Return a function that takes any number of arguments and returns x."
+  [x] (fn [& args] x))
+
+(defn identity
+  "Return the argument."
+  [x] x)
+
+; TODO: Stole this from Clojure. It probably isn't as efficient as it could be
+; in Apricot.
+(defn comp
+  "Take a set of functions and return a fn that is the composition of those
+  fns. The returned fn takes a variable number of args, applies the rightmost
+  of fns to the args, the next fn (right-to-left) to the result, etc."
+  ([] identity)
+  ([f] f)
+  ([f g]
+     (fn
+       ([] (f (g)))
+       ([x] (f (g x)))
+       ([x y] (f (g x y)))
+       ([x y z] (f (g x y z)))
+       ([x y z & args] (f (apply g x y z args)))))
+  ([f g h]
+     (fn
+       ([] (f (g (h))))
+       ([x] (f (g (h x))))
+       ([x y] (f (g (h x y))))
+       ([x y z] (f (g (h x y z))))
+       ([x y z & args] (f (g (apply h x y z args))))))
+  ([f1 f2 f3 & fs]
+    (let [fs (reverse (apply list f1 f2 f3 fs))]
+      (fn [& args]
+        (loop [ret (apply (first fs) args) fs (next fs)]
+          (if fs
+            (recur ((first fs) ret) (next fs))
+            ret))))))
+
+(defn partial
+  "Take a function f and fewer than the normal arguments to f, and return a fn
+  that takes a variable number of additional args. When called, the returned
+  function calls f with args + additional args."
+  ([f] f)
+  ([f arg1]
+   (fn [& args] (apply f arg1 args)))
+  ([f arg1 arg2]
+   (fn [& args] (apply f arg1 arg2 args)))
+  ([f arg1 arg2 arg3]
+   (fn [& args] (apply f arg1 arg2 arg3 args)))
+  ([f arg1 arg2 arg3 & more]
+   (fn [& args] (apply f arg1 arg2 arg3 (concat more args)))))
+
+; Useful macros
+
+(defmacro when
+  "Evaluate test. If logical true, evaluate body in an implicit do."
+  [test & body]
+  `(if ~test (do ~@body)))
+
+(defmacro when-not
+  "Evaluate test. If logical false, evaluate body in an implicit do."
+  [test & body]
+  `(if ~test nil (do ~@body)))
+
+(defmacro ..
+  "form => method-name or (method-name args*)
+
+  Expands into a method send (.) of the first method on the first argument,
+  followed by the next method on the result, etc. For instance:
+
+  (.. \"one two three\" split reverse (join \" \"))
+
+  expands to:
+
+  (. (. (. \"one two three\" split) reverse) (join \" \"))
+
+  but is easier to write, read, and understand."
+  ([x form]
+   `(. ~x ~form))
+  ([x form & more]
+   `(.. (. ~x ~form) ~@more)))
+
+(defmacro ->
+  "Thread the expr through the forms. Insert x as the second item in the first
+  form, making a list of it if it is not a list already. If there are more
+  forms, insert the first form as the second item in second form, etc."
+  ([x] x)
+  ([x form]
+   (if (seq? form)
+     `(~(first form) ~x ~@(next form))
+     (list form x)))
+  ([x form & more]
+   `(-> (-> ~x ~form) ~@more)))
+
+(defmacro ->>
+  "Thread the expr through the forms. Insert x as the last item in the first
+  form, making a list of it if it is not a list already. If there are more
+  forms, insert the first form as the last item in second form, etc."
+  ([x] x)
+  ([x form]
+   (if (seq? form)
+     `(~(first form) ~@(next form) ~x)
+     (list form x)))
+  ([x form & more]
+   `(->> (->> ~x ~form) ~@more)))
+
+(defmacro if-let
+  "bindings => var test
+
+  If test is true, evaluate then with var bound to the value of test,
+  otherwise yield else."
+  [bindings then [else nil]]
+  `(let [temp# ~(bindings 1)]
+     (if temp#
+       (let [~(bindings 0) temp#]
+         ~then)
+       ~else)))
+
+(defmacro cond
+  "Take a set of test/expr pairs. Evaluate each test one at a time. If a test
+  returns logical true, evaluate and return the value of the corresponding
+  expr and don't evaluate any of the other tests or exprs. (cond) returns
+  nil."
+  [& clauses]
+  (when-not (even? (count clauses))
+    (raise ArgumentError "cond requires an even number of forms"))
+  (when-not (empty? clauses)
+    `(if ~(first clauses)
+       ~(second clauses)
+       (cond ~@(drop 2 clauses)))))
+
+(defmacro case
+  "when => [expr ...+] expr
+  else => expr
+
+  Works like Ruby's case/when syntax (uses the === method).
+
+  Example:
+  (case x
+    [Array] \"x is an array\"
+    [String Symbol] \"x is a string or symbol\"
+    [1 2] \"x is equal to 1 or 2\"
+    \"x is unknown\")"
+  {:arglists '([x when ... else?])}
+  [x & forms]
+  (let [else (if (odd? (count forms))
+               (.pop forms))
+        val (gensym "case")
+        expand (fn expand [& forms]
+                 (if (seq forms)
+                   `(if (or ~@(map (fn [test] `(. ~test === ~val))
+                                   (first forms)))
+                      ~(second forms)
+                      ~(apply expand (drop 2 forms)))
+                   else))]
+    `(let [~val ~x]
+       ~(apply expand forms))))
+
+(defmacro doto
+  "Evaluate x then call all of the methods and functions with the value of x
+  supplied at the front of the given arguments. The forms are evaluated in
+  order. Return x.
+
+  (doto (Hash.) (.store :a 1) (.store :b 2)) ;=> {:a 1, :b 2}"
+  [x & forms]
+  (let [gx (gensym "doto")]
+    `(let [~gx ~x]
+       ~@(map (fn [f]
+                (if (seq? f)
+                  `(~(first f) ~gx ~@(rest f))
+                  `(~f ~gx)))
+              forms)
+       ~gx)))
+
+; Miscellaneous (to be sorted)
+
+(defn eval
+  "Evaluate the form data structure (not text!) and return the result."
+  [form] (Apricot::Compiler/eval_form form))
+
+(defmacro each [binding & body]
+  `(.each ~(last binding)
+          | (fn [~(first binding)] ~@body)))
+
+(defmacro while-let [binding & body]
+  `(loop []
+     (let ~binding
+       (when ~(first binding)
+         ~@body
+         (recur)))))
+
+; Structs
+
+(defmacro defstruct [name & fields]
+  `(def ~name (Struct. ~@(map symbol fields))))
+
+; Macros for defining Ruby classes and methods
+
+(defmacro defmethod [target name & body]
+  `(.send ~target :define_method ~(symbol name) | (fn ~name ~@body)))
+
+(defmacro defclass
+  ([name]
+   `(def ~name (Class.)))
+  ([name superclass]
+   `(def ~name (Class. ~superclass))))
+
+; Metadata
+
+(defn meta
+  "Return the metadata of obj."
+  [obj] (.apricot_meta obj))
+
+; Documentation
+
+(defn doc
+  "Print the documentation for the given function or macro."
+  [f]
+  (let [m (meta f)]
+    (println "-------------------------")
+    (println (m :name))
+    (println (m :arglists))
+    (if (m :macro)
+      (println "Macro"))
+    (println "  " (m :doc))))
+
+; REPL Utilities
+
+(defn decode
+  "Print the Rubinius bytecode for the given Proc or Method."
+  [f]
+  (case f
+    [Proc]   (Kernel/puts (.. f block compiled_code decode))
+    [Method] (Kernel/puts (.. f executable decode))
+    (raise (str "Don't know how to decode " (.inspect f)))))
+
+(defmacro time
+  "Evaluate the forms in body and return the time it took."
+  [& body]
+  `(do
+     (require "benchmark")
+     (.realtime Benchmark | (fn [] ~@body))))
+
+(defmacro benchmark-ips
+  "clause => [label form ...]
+
+  Measure how many times per second each of the clause's bodies can be
+  executed. Output is organized using the given label strings.
+
+  This requires the benchmark-ips gem:
+    gem install benchmark-ips"
+  [& clauses]
+  (let [bm (gensym)
+        make-report (fn [clause]
+                      `(.report ~bm ~(first clause) | (fn [] ~@(rest clause))))
+        reports (map make-report clauses)]
+    `(do
+       (try
+         (require "benchmark/ips")
+         (.ips Benchmark | (fn [~bm] ~@reports))
+         (rescue [_ LoadError]
+           (raise "benchmark-ips requires the benchmark-ips gem")))
+       nil)))