ClojureCLR: major update, part2

5 files changed, 1085 insertions, 0 deletions

diff --git a/ClojureCLR/Clojure/Clojure/Bootstrap/core_print.clj b/ClojureCLR/Clojure/Clojure/Bootstrap/core_print.clj
new file mode 100644
index 00000000..dbecfe1e
--- /dev/null
+++ b/ClojureCLR/Clojure/Clojure/Bootstrap/core_print.clj
@@ -0,0 +1,317 @@
+;   Copyright (c) Rich Hickey. All rights reserved.

+;   The use and distribution terms for this software are covered by the

+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

+;   which can be found in the file epl-v10.html at the root of this distribution.

+;   By using this software in any fashion, you are agreeing to be bound by

+;   the terms of this license.

+;   You must not remove this notice, or any other, from this software.

+

+(in-ns 'clojure.core)

+

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+

+(import '(System.IO.System.IO.TextWriter))   ;;; was (import '(java.io Writer))    (I have replaced #^Writer with #^System.IO.TextWriter throughout

+;; Other global replaces:  .write => .Write, .append => .Write, #^Class => #^Type, #^Character => #^Char

+(def

+ #^{:doc "*print-length* controls how many items of each collection the

+  printer will print. If it is bound to logical false, there is no

+  limit. Otherwise, it must be bound to an integer indicating the maximum

+  number of items of each collection to print. If a collection contains

+  more items, the printer will print items up to the limit followed by

+  '...' to represent the remaining items. The root binding is nil

+  indicating no limit."}

+ *print-length* nil)

+

+(def

+ #^{:doc "*print-level* controls how many levels deep the printer will

+  print nested objects. If it is bound to logical false, there is no

+  limit. Otherwise, it must be bound to an integer indicating the maximum

+  level to print. Each argument to print is at level 0; if an argument is a

+  collection, its items are at level 1; and so on. If an object is a

+  collection and is at a level greater than or equal to the value bound to

+  *print-level*, the printer prints '#' to represent it. The root binding

+  is nil indicating no limit."}

+*print-level* nil)

+

+(defn- print-sequential [#^String begin, print-one, #^String sep, #^String end, sequence, #^System.IO.TextWriter w]

+  (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]

+    (if (and *print-level* (neg? *print-level*))

+      (.Write w "#")

+      (do

+        (.Write w begin)

+        (when-let [xs (seq sequence)]

+          (if (and (not *print-dup*) *print-length*)

+            (loop [[x & xs] xs

+                   print-length *print-length*]

+              (if (zero? print-length)

+                (.Write w "...")

+                (do

+                  (print-one x w)

+                  (when xs

+                    (.Write w sep)

+                    (recur xs (dec print-length))))))

+            (loop [[x & xs] xs]

+              (print-one x w)

+              (when xs

+                (.Write w sep)

+                (recur xs)))))

+        (.Write w end)))))

+

+(defn- print-meta [o, #^System.IO.TextWriter w]

+  (when-let [m (meta o)]

+    (when (and (pos? (count m))

+               (or *print-dup*

+                   (and *print-meta* *print-readably*)))

+      (.Write w "#^")

+      (if (and (= (count m) 1) (:tag m))

+          (pr-on (:tag m) w)

+          (pr-on m w))

+      (.Write w " "))))

+

+(defmethod print-method :default [o, #^System.IO.TextWriter w]

+  (print-method (vary-meta o #(dissoc % :type)) w))

+

+(defmethod print-method nil [o, #^System.IO.TextWriter w]

+  (.Write w "nil"))

+

+(defmethod print-dup nil [o w] (print-method o w))

+

+(defn print-ctor [o print-args #^System.IO.TextWriter w]

+  (.Write w "#=(")

+  (.Write w (.FullName #^Type (class o)))   ;;; .getName  => .FullName

+  (.Write w ". ")

+  (print-args o w)

+  (.Write w ")"))

+

+(defmethod print-method Object [o, #^System.IO.TextWriter w]

+  (.Write w "#<")

+  (.Write w (.Name (class o)))     ;;; .getSimpleName => .Name

+  (.Write w " ")

+  (.Write w (str o))

+  (.Write w ">"))

+

+(defmethod print-method clojure.lang.Keyword [o, #^System.IO.TextWriter w]

+  (.Write w (str o)))

+

+(defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))

+;;; MAJOR PROBLEM: no Number type in CLR.  We will just ask every ValueType to print itself.  Need to deal with BigDecimal and BigInteger later.

+(defmethod print-method ValueType [o, #^System.IO.TextWriter w]   ;; Number => ValueType

+  (.Write w (str o)))

+

+(defmethod print-dup ValueType [o, #^System.IO.TextWriter w]      ;;; Number => ValueType

+  (print-ctor o

+              (fn [o w]

+                  (print-dup (str o) w))

+              w))

+

+(defmethod print-dup clojure.lang.Fn [o, #^System.IO.TextWriter w]

+  (print-ctor o (fn [o w]) w))

+

+(prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)

+(prefer-method print-dup java.util.Map clojure.lang.Fn)

+(prefer-method print-dup java.util.Collection clojure.lang.Fn)

+

+(defmethod print-method Boolean [o, #^System.IO.TextWriter w]

+  (.Write w (str o)))

+

+(defmethod print-dup Boolean [o w] (print-method o w))

+

+(defn print-simple [o, #^System.IO.TextWriter w]

+  (print-meta o w)

+  (.Write w (str o)))

+

+(defmethod print-method clojure.lang.Symbol [o, #^System.IO.TextWriter w]

+  (print-simple o w))

+

+(defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))

+

+(defmethod print-method clojure.lang.Var [o, #^System.IO.TextWriter w]

+  (print-simple o w))

+

+(defmethod print-dup clojure.lang.Var [#^clojure.lang.Var o, #^System.IO.TextWriter w]

+  (.Write w (str "#=(var " (.Name (.ns o)) "/" (.Symbol o) ")")))   ;;; .name => .Name, .sym => .Symbol

+

+(defmethod print-method clojure.lang.ISeq [o, #^System.IO.TextWriter w]

+  (print-meta o w)

+  (print-sequential "(" pr-on " " ")" o w))

+

+(defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))

+(defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))

+(prefer-method print-method clojure.lang.IPersistentList clojure.lang.ISeq)

+(prefer-method print-dup clojure.lang.IPersistentList clojure.lang.ISeq)

+(prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)

+(prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)

+(prefer-method print-method clojure.lang.ISeq System.Collections.ICollection)  ;;  java: java.util.Collection

+(prefer-method print-dup clojure.lang.ISeq System.Collections.ICollection)  ;;  java: java.util.Collection

+

+(defmethod print-method clojure.lang.IPersistentList [o, #^System.IO.TextWriter w]

+  (print-meta o w)

+  (print-sequential "(" print-method " " ")" o w))

+

+

+(defmethod print-dup System.Collections.ICollection [o, #^System.IO.TextWriter w]                     ;; java.util.Collection => System.Collections.ICollection

+ (print-ctor o #(print-sequential "[" print-method " " "]" %1 %2) w))

+

+(defmethod print-dup clojure.lang.IPersistentCollection [o, #^System.IO.TextWriter w]

+  (print-meta o w)

+  (.Write w "#=(")

+  (.Write w (.FullName #^Type (class o)))   ;; .getName => .FullName

+  (.Write w "/create ")

+  (print-sequential "[" print-dup " " "]" o w)

+  (.Write w ")"))

+

+(prefer-method print-dup clojure.lang.IPersistentCollection System.Collections.ICollection)                ;; java.util.Collection => System.Collections.ICollection

+

+(def #^{:tag String 

+        :doc "Returns escape string for char or nil if none"}

+  char-escape-string

+    {\newline "\\n"

+     \tab  "\\t"

+     \return "\\r"

+     \" "\\\""

+     \\  "\\\\"

+     \formfeed "\\f"

+     \backspace "\\b"})  

+

+(defmethod print-method String [#^String s, #^System.IO.TextWriter w]

+  (if (or *print-dup* *print-readably*)

+    (do (.Write w \")                          

+      (dotimes [n (count s)]

+        (let [c (.get_Chars s n)                    ;; .charAt => .get_Chars

+              e (char-escape-string c)]

+          (if e (.Write w e) (.Write w c))))   

+      (.Write w \"))                           

+    (.Write w s))                                 

+  nil)

+

+(defmethod print-dup String [s w] (print-method s w))

+

+(defmethod print-method clojure.lang.IPersistentVector [v, #^System.IO.TextWriter w]

+  (print-meta v w)

+  (print-sequential "[" pr-on " " "]" v w))

+

+(defn- print-map [m print-one w]

+  (print-sequential 

+   "{"

+   (fn [e  #^System.IO.TextWriter w] 

+     (do (print-one (key e) w) (.Write w \space) (print-one (val e) w)))

+   ", "

+   "}"

+   (seq m) w))

+

+(defmethod print-method clojure.lang.IPersistentMap [m, #^System.IO.TextWriter w]

+  (print-meta m w)

+  (print-map m pr-on w))

+

+(defmethod print-dup java.util.Map [m, #^System.IO.TextWriter w]

+  (print-ctor m #(print-map (seq %1) print-method %2) w))

+

+(defmethod print-dup clojure.lang.IPersistentMap [m, #^System.IO.TextWriter w]

+  (print-meta m w)

+  (.Write w "#=(")

+  (.Write w (.FullName (class m)))   ;; .getName => .FullName

+  (.Write w "/create ")

+  (print-map m print-dup w)

+  (.Write w ")"))

+  

+(prefer-method print-dup clojure.lang.IPersistentMap System.Collections.IDictionary)    ;; java.util.Map  -> System.Collections.IDictionary

+

+(defmethod print-method clojure.lang.IPersistentSet [s, #^System.IO.TextWriter w]

+  (print-meta s w)

+  (print-sequential "#{" pr-on " " "}" (seq s) w))

+

+(def #^{:tag String 

+        :doc "Returns name string for char or nil if none"} 

+ char-name-string

+   {\newline "newline"

+    \tab "tab"

+    \space "space"

+    \backspace "backspace"

+    \formfeed "formfeed"

+    \return "return"})

+

+(defmethod print-method Char [#^Char c, #^System.IO.TextWriter w]

+  (if (or *print-dup* *print-readably*)

+    (do (.Write w \\)

+        (let [n (char-name-string c)]

+          (if n (.Write w n) (.Write w c))))

+    (.Write w c))

+  nil)

+

+(defmethod print-dup Char   [c w] (print-method c w))             ;;; java.lang.Character

+(defmethod print-dup Int32  [o w] (print-method o w))               ;;; java.lang.Integer

+(defmethod print-dup Double [o w] (print-method o w))                ;;; java.lang.Double

+(defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))

+(defmethod print-dup java.math.BigDecimal [o w] (print-method o w))

+(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))

+(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w)) 

+(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))

+(defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))

+

+(def primitives-classnames    ;; not clear what the equiv should be

+  {Single  "Single"   ;;{Float/TYPE "Float/TYPE"

+   Int32   "Int32"    ;; Integer/TYPE "Integer/TYPE"

+   Int64   "Int64"    ;; Long/TYPE "Long/TYPE"

+   Boolean "Boolean"  ;; Boolean/TYPE "Boolean/TYPE"

+   Char    "Char"     ;; Character/TYPE "Character/TYPE"

+   Double  "Double"   ;; Double/TYPE "Double/TYPE"

+   Byte    "Byte"     ;; Byte/TYPE "Byte/TYPE"

+   Int16   "Int16"})  ;; Short/TYPE "Short/TYPE"})

+  

+(defmethod print-method Type [#^Type c, #^System.IO.TextWriter w]

+  (.Write w (.FullName c)))   ;;; .getName => .FullName

+

+(defmethod print-dup Type [#^Type c, #^System.IO.TextWriter w]

+  (cond

+    (.IsPrimitive c) (do                                             ;; .isPrimitive

+                       (.Write w "#=(identity ")

+                       (.Write w #^String (primitives-classnames c))

+                       (.Write w ")"))

+    (.IsArray c) (do                                                 ;; .isArray ,  java.lang.Class/forName =>

+                   (.Write w "#=(clojure.lang.RT/classForName \"")

+                   (.Write w (.FullName c))                           ;; .getName => .FullName

+                   (.Write w "\")"))

+    :else (do

+            (.Write w "#=")

+            (.Write w (.FullName c)))))    ;;; .getName => .FullName

+

+(defmethod print-method java.math.BigDecimal [b, #^System.IO.TextWriter w]

+  (.Write w (str b))

+  (.Write w "M"))

+

+(defmethod print-method System.Text.RegularExpressions.Regex [p #^System.IO.TextWriter w]         ;;; java.util.regex.Pattern =>

+  (.Write w "#\"")

+  (loop [[#^Char c & r :as s] (seq (.ToString #^System.Text.RegularExpressions.Regex p))   ;;; .pattern => .ToString

+         qmode false]

+    (when s

+      (cond

+        (= c \\) (let [[#^Char c2 & r2] r]

+                   (.Write w \\)

+                   (.Write w c2)

+                   (if qmode

+                      (recur r2 (not= c2 \E))

+                      (recur r2 (= c2 \Q))))

+        (= c \") (do

+                   (if qmode

+                     (.Write w "\\E\\\"\\Q")

+                     (.Write w "\\\""))

+                   (recur r qmode))

+        :else    (do

+                   (.Write w c)

+                   (recur r qmode)))))

+  (.Write w \"))

+

+(defmethod print-dup System.Text.RegularExpressions.Regex [p #^System.IO.TextWriter w] (print-method p w))  ;;; java.util.regex.Pattern =>

+  

+(defmethod print-dup clojure.lang.Namespace [#^clojure.lang.Namespace n #^System.IO.TextWriter w]

+  (.Write w "#=(find-ns ")

+  (print-dup (.Name n) w)    ;; .name

+  (.Write w ")"))

+

+(defmethod print-method clojure.lang.IDeref [o #^System.IO.TextWriter w]

+  (print-sequential (format "#<%s@%x: "

+                            (.Name (class o))     ;;; .getSimpleName => .Name

+                            (.GetHashCode o))    ;;; No easy equivelent in CLR: (System/identityHashCode o)))

+                    pr-on, "", ">", (list @o), w))

+

+(def #^{:private true} print-initialized true)  
\ No newline at end of file
diff --git a/ClojureCLR/Clojure/Clojure/Bootstrap/main.clj b/ClojureCLR/Clojure/Clojure/Bootstrap/main.clj
new file mode 100644
index 00000000..766cc7f7
--- /dev/null
+++ b/ClojureCLR/Clojure/Clojure/Bootstrap/main.clj
@@ -0,0 +1,337 @@
+;; Copyright (c) Rich Hickey All rights reserved. The use and
+;; distribution terms for this software are covered by the Eclipse Public
+;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found
+;; in the file epl-v10.html at the root of this distribution. By using this
+;; software in any fashion, you are agreeing to be bound by the terms of
+;; this license. You must not remove this notice, or any other, from this
+;; software.
+
+;; Originally contributed by Stephen C. Gilardi
+
+(ns clojure.main
+  (:import (clojure.lang Compiler Compiler+CompilerException             ;;;Compiler$CompilerException
+                         LineNumberingTextReader RT)))                   ;;; LineNumberingPushbackReader
+
+(declare main)
+ 
+(defmacro with-bindings
+  "Executes body in the context of thread-local bindings for several vars
+  that often need to be set!: *ns* *warn-on-reflection* *print-meta*
+  *print-length* *print-level* *compile-path* *command-line-args* *1
+  *2 *3 *e"
+  [& body]
+  `(binding [*ns* *ns*
+             *warn-on-reflection* *warn-on-reflection*
+             *print-meta* *print-meta*
+             *print-length* *print-length*
+             *print-level* *print-level*
+             *compile-path* (or (Environment/GetEnvironmentVariable "clojure.compile.path") "classes")  ;;;(System/getProperty "clojure.compile.path" "classes")
+             *command-line-args* *command-line-args*
+             *1 nil
+             *2 nil
+             *3 nil
+             *e nil]
+     ~@body))
+
+(defn repl-prompt
+  "Default :prompt hook for repl"
+  []
+  (print (str (ns-name *ns*) "=> ")))    ;;;  until we get printf defined for real:  (printf "%s=> " (ns-name *ns*)))
+
+(defn skip-if-eol
+  "If the next character on stream s is a newline, skips it, otherwise
+  leaves the stream untouched. Returns :line-start, :stream-end, or :body
+  to indicate the relative location of the next character on s. The stream
+  must either be an instance of LineNumberingPushbackReader or duplicate
+  its behavior of both supporting .unread and collapsing all of CR, LF, and
+  CRLF to a single \\newline."
+  [s]
+  (let [c (.Read s)]                             ;;; .read
+    (cond
+     (= c (int \newline)) :line-start
+     (= c -1) :stream-end
+     :else (do (.Unread s c) :body))))           ;;; .unread
+
+(defn skip-whitespace
+  "Skips whitespace characters on stream s. Returns :line-start, :stream-end,
+  or :body to indicate the relative location of the next character on s.
+  Interprets comma as whitespace and semicolon as comment to end of line.
+  Does not interpret #! as comment to end of line because only one
+  character of lookahead is available. The stream must either be an
+  instance of LineNumberingPushbackReader or duplicate its behavior of both
+  supporting .unread and collapsing all of CR, LF, and CRLF to a single
+  \\newline."
+  [s]
+  (loop [c (.Read s)]							;;; .read
+    (cond
+     (= c (int \newline)) :line-start
+     (= c -1) :stream-end
+     (= c (int \;)) (do (.ReadLine s) :line-start)                      ;;; .readLine
+     (or (Char/IsWhiteSpace (char c)) (= c (int \,))) (recur (.Read s))        ;;; (Character/isWhitespace c)    .read
+     :else (do (.Unread s c) :body))))                                  ;;; .unread
+
+(defn repl-read
+  "Default :read hook for repl. Reads from *in* which must either be an
+  instance of LineNumberingPushbackReader or duplicate its behavior of both
+  supporting .unread and collapsing all of CR, LF, and CRLF into a single
+  \\newline. repl-read:
+    - skips whitespace, then
+      - returns request-prompt on start of line, or
+      - returns request-exit on end of stream, or
+      - reads an object from the input stream, then
+        - skips the next input character if it's end of line, then
+        - returns the object."
+  [request-prompt request-exit]
+  (or ({:line-start request-prompt :stream-end request-exit}
+       (skip-whitespace *in*))
+      (let [input (read)]
+        (skip-if-eol *in*)
+        input)))
+
+(defn- root-cause
+  "Returns the initial cause of an exception or error by peeling off all of
+  its wrappers"
+  [throwable]
+  (loop [cause throwable]
+    (if-let [cause (.InnerException cause)]    ;;; .getCause
+      (recur cause)
+      cause)))
+
+(defn repl-exception
+  "Returns CompilerExceptions in tact, but only the root cause of other
+  throwables"
+  [throwable]
+  (if (instance? clojure.lang.Compiler+CompilerException throwable)   ;;; Compiler$CompilerException
+    throwable
+    (root-cause throwable)))
+
+(defn repl-caught
+  "Default :caught hook for repl"
+  [e]
+  (.WriteLine *err* (repl-exception e)))      ;;; .println
+
+(defn repl
+  "Generic, reusable, read-eval-print loop. By default, reads from *in*,
+  writes to *out*, and prints exception summaries to *err*. If you use the
+  default :read hook, *in* must either be an instance of
+  LineNumberingPushbackReader or duplicate its behavior of both supporting
+  .unread and collapsing CR, LF, and CRLF into a single \\newline. Options
+  are sequential keyword-value pairs. Available options and their defaults:
+
+     - :init, function of no arguments, initialization hook called with
+       bindings for set!-able vars in place.
+       default: #()
+
+     - :need-prompt, function of no arguments, called before each
+       read-eval-print except the first, the user will be prompted if it
+       returns true.
+       default: (if (instance? LineNumberingPushbackReader *in*)
+                  #(.atLineStart *in*)
+                  #(identity true))
+
+     - :prompt, function of no arguments, prompts for more input.
+       default: repl-prompt
+
+     - :flush, function of no arguments, flushes output
+       default: flush
+
+     - :read, function of two arguments, reads from *in*:
+         - returns its first argument to request a fresh prompt
+           - depending on need-prompt, this may cause the repl to prompt
+             before reading again
+         - returns its second argument to request an exit from the repl
+         - else returns the next object read from the input stream
+       default: repl-read
+
+     - :eval, funtion of one argument, returns the evaluation of its
+       argument
+       default: eval
+
+     - :print, function of one argument, prints its argument to the output
+       default: prn
+
+     - :caught, function of one argument, a throwable, called when
+       read, eval, or print throws an exception or error
+       default: repl-caught"
+  [& options]
+  (let [{:keys [init need-prompt prompt flush read eval print caught]
+         :or {init        #()
+              need-prompt (if (instance? LineNumberingTextReader *in*)     ;;; LineNumberingPushbackReader
+                            #(.AtLineStart *in*)                           ;;; atLineStart
+                            #(identity true))
+              prompt      repl-prompt
+              flush       flush
+              read        repl-read
+              eval        eval
+              print       prn
+              caught      repl-caught}}
+        (apply hash-map options)
+        request-prompt (Object.)
+        request-exit (Object.)
+        read-eval-print
+        (fn []
+          (try
+           (let [input (read request-prompt request-exit)]
+             (or (#{request-prompt request-exit} input)
+                 (let [value (eval input)]
+                   (print value)
+                   (set! *3 *2)
+                   (set! *2 *1)
+                   (set! *1 value))))
+           (catch Exception e           ;;; Throwable
+             (caught e)
+             (set! *e e))))]
+    (with-bindings
+     (try
+      (init)
+      (catch Exception e                ;;; Throwable
+        (caught e)
+        (set! *e e)))
+     (prompt)
+     (flush)
+     (loop []
+       (when-not (= (read-eval-print) request-exit)
+         (when (need-prompt)
+           (prompt)
+           (flush))
+         (recur))))))
+
+(defn load-script
+  "Loads Clojure source from a file or resource given its path. Paths
+  beginning with @ or @/ are considered relative to classpath."
+  [path]
+  (if (.StartsWith path "@")                                  ;;; startsWith
+    (RT/LoadCljScript                                         ;;; loadResourceScript
+     (.Substring path (if (.StartsWith path "@/") 2 1)))      ;;; substring  startsWith
+    (Compiler/loadFile path)))
+
+(defn- init-opt
+  "Load a script"
+  [path]
+  (load-script path))
+
+(defn- eval-opt
+  "Evals expressions in str, prints each non-nil result using prn"
+  [str]
+  (let [eof (Object.)]
+    (with-in-str str
+      (loop [input (read *in* false eof)]
+        (when-not (= input eof)
+          (let [value (eval input)]
+            (when-not (nil? value)
+              (prn value))
+            (recur (read *in* false eof))))))))
+
+(defn- init-dispatch
+  "Returns the handler associated with an init opt"
+  [opt]
+  ({"-i"     init-opt
+    "--init" init-opt
+    "-e"     eval-opt
+    "--eval" eval-opt} opt))
+
+(defn- initialize
+  "Common initialize routine for repl, script, and null opts"
+  [args inits]
+  (in-ns 'user)
+  (set! *command-line-args* args)
+  (doseq [[opt arg] inits]
+    ((init-dispatch opt) arg)))
+
+(defn- repl-opt
+  "Start a repl with args and inits. Print greeting if no eval options were
+  present"
+  [[_ & args] inits]
+  (when-not (some #(= eval-opt (init-dispatch (first %))) inits)
+    (println "Clojure" (clojure-version)))
+  (repl :init #(initialize args inits))
+  (prn)
+  (Environment/Exit 0))                        ;;;  System.Exit
+
+(defn- script-opt
+  "Run a script from a file, resource, or standard in with args and inits"
+  [[path & args] inits]
+  (with-bindings
+    (initialize args inits)
+    (if (= path "-")
+      (load-reader *in*)
+      (load-script path))))
+
+(defn- null-opt
+  "No repl or script opt present, just bind args and run inits"
+  [args inits]
+  (with-bindings
+    (initialize args inits)))
+
+(defn- help-opt
+  "Print help text for main"
+  [_ _]
+  (println (:doc (meta (var main)))))
+
+(defn- main-dispatch
+  "Returns the handler associated with a main option"
+  [opt]
+  (or
+   ({"-r"     repl-opt
+     "--repl" repl-opt
+     nil      null-opt
+     "-h"     help-opt
+     "--help" help-opt
+     "-?"     help-opt} opt)
+   script-opt))
+
+(defn- legacy-repl
+  "Called by the clojure.lang.Repl.main stub to run a repl with args
+  specified the old way"
+  [args]
+  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
+    (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits))))
+
+(defn- legacy-script
+  "Called by the clojure.lang.Script.main stub to run a script with args
+  specified the old way"
+  [args]
+  (let [[inits [sep & args]] (split-with (complement #{"--"}) args)]
+    (null-opt args (map vector (repeat "-i") inits))))
+
+(defn main
+  "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*]
+
+  With no options or args, runs an interactive Read-Eval-Print Loop
+
+  init options:
+    -i, --init path   Load a file or resource
+    -e, --eval string Evaluate expressions in string; print non-nil values
+
+  main options:
+    -r, --repl        Run a repl
+    path              Run a script from from a file or resource
+    -                 Run a script from standard input
+    -h, -?, --help    Print this help message and exit
+
+  operation:
+
+    - Establishes thread-local bindings for commonly set!-able vars
+    - Enters the user namespace
+    - Binds *command-line-args* to a seq of strings containing command line
+      args that appear after any main option
+    - Runs all init options in order
+    - Runs a repl or script if requested
+
+  The init options may be repeated and mixed freely, but must appear before
+  any main option. The appearance of any eval option before running a repl
+  suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\".
+
+  Paths may be absolute or relative in the filesystem or relative to
+  classpath. Classpath-relative paths have prefix of @ or @/"
+  [& args]
+  (try
+   (if args
+     (loop [[opt arg & more :as args] args inits []]
+       (if (init-dispatch opt)
+         (recur more (conj inits [opt arg]))
+         ((main-dispatch opt) args inits)))
+     (repl-opt nil nil))
+   (finally 
+     (flush))))
+
diff --git a/ClojureCLR/Clojure/Clojure/Bootstrap/set.clj b/ClojureCLR/Clojure/Clojure/Bootstrap/set.clj
new file mode 100644
index 00000000..87113508
--- /dev/null
+++ b/ClojureCLR/Clojure/Clojure/Bootstrap/set.clj
@@ -0,0 +1,148 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns clojure.set)
+
+(defn- bubble-max-key [k coll]
+  "Move a maximal element of coll according to fn k (which returns a number) 
+   to the front of coll."
+  (let [max (apply max-key k coll)]
+    (cons max (remove #(identical? max %) coll))))
+
+(defn union
+  "Return a set that is the union of the input sets"
+  ([] #{})
+  ([s1] s1)
+  ([s1 s2]
+     (if (< (count s1) (count s2))
+       (reduce conj s2 s1)
+       (reduce conj s1 s2)))
+  ([s1 s2 & sets]
+     (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))]
+       (reduce into (first bubbled-sets) (rest bubbled-sets)))))
+
+(defn intersection
+  "Return a set that is the intersection of the input sets"
+  ([s1] s1)
+  ([s1 s2]
+     (if (< (count s2) (count s1))
+       (recur s2 s1)
+       (reduce (fn [result item]
+                   (if (contains? s2 item)
+		     result
+                     (disj result item)))
+	       s1 s1)))
+  ([s1 s2 & sets] 
+     (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))]
+       (reduce intersection (first bubbled-sets) (rest bubbled-sets)))))
+
+(defn difference
+  "Return a set that is the first set without elements of the remaining sets"
+  ([s1] s1)
+  ([s1 s2] 
+     (if (< (count s1) (count s2))
+       (reduce (fn [result item] 
+                   (if (contains? s2 item) 
+                     (disj result item) 
+                     result))
+               s1 s1)
+       (reduce disj s1 s2)))
+  ([s1 s2 & sets] 
+     (reduce difference s1 (conj sets s2))))
+
+
+(defn select
+  "Returns a set of the elements for which pred is true"
+  [pred xset]
+    (reduce (fn [s k] (if (pred k) s (disj s k)))
+            xset xset))
+
+(defn project
+  "Returns a rel of the elements of xrel with only the keys in ks"
+  [xrel ks]
+    (set (map #(select-keys % ks) xrel)))
+
+(defn rename-keys
+  "Returns the map with the keys in kmap renamed to the vals in kmap"
+  [map kmap]
+    (reduce 
+     (fn [m [old new]]
+       (if (not= old new)
+         (-> m (assoc new (m old)) (dissoc old))
+         m)) 
+     map kmap))
+
+(defn rename
+  "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap"
+  [xrel kmap]
+    (set (map #(rename-keys % kmap) xrel)))
+
+(defn index
+  "Returns a map of the distinct values of ks in the xrel mapped to a
+  set of the maps in xrel with the corresponding values of ks."
+  [xrel ks]
+    (reduce
+     (fn [m x]
+       (let [ik (select-keys x ks)]
+         (assoc m ik (conj (get m ik #{}) x))))
+     {} xrel))
+   
+(defn map-invert
+  "Returns the map with the vals mapped to the keys."
+  [m] (reduce (fn [m [k v]] (assoc m v k)) {} m))
+
+(defn join
+  "When passed 2 rels, returns the rel corresponding to the natural
+  join. When passed an additional keymap, joins on the corresponding
+  keys."
+  ([xrel yrel] ;natural join
+   (if (and (seq xrel) (seq yrel))
+     (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel))))
+           [r s] (if (<= (count xrel) (count yrel))
+                   [xrel yrel]
+                   [yrel xrel])
+           idx (index r ks)]
+       (reduce (fn [ret x]
+                 (let [found (idx (select-keys x ks))]
+                   (if found
+                     (reduce #(conj %1 (merge %2 x)) ret found)
+                     ret)))
+               #{} s))
+     #{}))
+  ([xrel yrel km] ;arbitrary key mapping
+   (let [[r s k] (if (<= (count xrel) (count yrel))
+                   [xrel yrel (map-invert km)]
+                   [yrel xrel km])
+         idx (index r (vals k))]
+     (reduce (fn [ret x]
+               (let [found (idx (rename-keys (select-keys x (keys k)) k))]
+                 (if found
+                   (reduce #(conj %1 (merge %2 x)) ret found)
+                   ret)))
+             #{} s))))
+
+(comment
+(refer 'set)
+(def xs #{{:a 11 :b 1 :c 1 :d 4}
+         {:a 2 :b 12 :c 2 :d 6}
+         {:a 3 :b 3 :c 3 :d 8 :f 42}})
+
+(def ys #{{:a 11 :b 11 :c 11 :e 5}
+         {:a 12 :b 11 :c 12 :e 3}
+         {:a 3 :b 3 :c 3 :e 7 }})
+
+(join xs ys)
+(join xs (rename ys {:b :yb :c :yc}) {:a :a})
+
+(union #{:a :b :c} #{:c :d :e })
+(difference #{:a :b :c} #{:c :d :e})
+(intersection #{:a :b :c} #{:c :d :e})
+
+(index ys [:b])
+)
+
diff --git a/ClojureCLR/Clojure/Clojure/Bootstrap/version.properties b/ClojureCLR/Clojure/Clojure/Bootstrap/version.properties
new file mode 100644
index 00000000..89769621
--- /dev/null
+++ b/ClojureCLR/Clojure/Clojure/Bootstrap/version.properties
@@ -0,0 +1,5 @@
+clojure.version.major=1

+clojure.version.minor=1

+clojure.version.incremental=0

+clojure.version.qualifier=alpha

+clojure.version.interim=true
\ No newline at end of file
diff --git a/ClojureCLR/Clojure/Clojure/Bootstrap/zip.clj b/ClojureCLR/Clojure/Clojure/Bootstrap/zip.clj
new file mode 100644
index 00000000..81b09060
--- /dev/null
+++ b/ClojureCLR/Clojure/Clojure/Bootstrap/zip.clj
@@ -0,0 +1,278 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+;functional hierarchical zipper, with navigation, editing and enumeration
+;see Huet
+
+(ns clojure.zip
+    (:refer-clojure :exclude (replace remove next)))
+
+(defn zipper
+  "Creates a new zipper structure. 
+
+  branch? is a fn that, given a node, returns true if can have
+  children, even if it currently doesn't.
+
+  children is a fn that, given a branch node, returns a seq of its
+  children.
+
+  make-node is a fn that, given an existing node and a seq of
+  children, returns a new branch node with the supplied children.
+  root is the root node."  
+  [branch? children make-node root]
+    #^{:zip/branch? branch? :zip/children children :zip/make-node make-node} 
+    [root nil])
+
+(defn seq-zip
+  "Returns a zipper for nested sequences, given a root sequence"
+  [root]
+    (zipper seq? identity (fn [node children] children) root))
+
+(defn vector-zip
+  "Returns a zipper for nested vectors, given a root vector"
+  [root]
+    (zipper vector? seq (fn [node children] (apply vector children)) root))
+
+(defn xml-zip
+  "Returns a zipper for xml elements (as from xml/parse),
+  given a root element"
+  [root]
+    (zipper (complement string?) 
+            (comp seq :content)
+            (fn [node children]
+              (assoc node :content (and children (apply vector children))))
+            root))
+
+(defn node
+  "Returns the node at loc"
+  [loc] (loc 0))
+
+(defn branch?
+  "Returns true if the node at loc is a branch"
+  [loc]
+    ((:zip/branch? ^loc) (node loc)))
+
+(defn children
+  "Returns a seq of the children of node at loc, which must be a branch"
+  [loc]
+    ((:zip/children ^loc) (node loc)))
+
+(defn make-node
+  "Returns a new branch node, given an existing node and new
+  children. The loc is only used to supply the constructor."
+  [loc node children]
+    ((:zip/make-node ^loc) node children))
+
+(defn path
+  "Returns a seq of nodes leading to this loc"
+  [loc]
+    (:pnodes (loc 1)))
+
+(defn lefts
+  "Returns a seq of the left siblings of this loc"
+  [loc]
+    (seq (:l (loc 1))))
+
+(defn rights
+  "Returns a seq of the right siblings of this loc"
+  [loc]
+    (:r (loc 1)))
+
+
+(defn down
+  "Returns the loc of the leftmost child of the node at this loc, or
+  nil if no children"
+  [loc]
+    (let [[node path] loc
+          [c & cnext :as cs] (children loc)]
+      (when cs
+        (with-meta [c {:l [] 
+                       :pnodes (if path (conj (:pnodes path) node) [node]) 
+                       :ppath path 
+                       :r cnext}] ^loc))))
+
+(defn up
+  "Returns the loc of the parent of the node at this loc, or nil if at
+  the top"
+  [loc]
+    (let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc]
+      (when pnodes
+        (let [pnode (peek pnodes)]
+          (with-meta (if changed?
+                       [(make-node loc pnode (concat l (cons node r))) 
+                        (and ppath (assoc ppath :changed? true))]
+                       [pnode ppath])
+                     ^loc)))))
+
+(defn root
+  "zips all the way up and returns the root node, reflecting any
+ changes."
+  [loc]
+    (if (= :end (loc 1))
+      (node loc)
+      (let [p (up loc)]
+        (if p
+          (recur p)
+          (node loc)))))
+
+(defn right
+  "Returns the loc of the right sibling of the node at this loc, or nil"
+  [loc]
+    (let [[node {l :l  [r & rnext :as rs] :r :as path}] loc]
+      (when (and path rs)
+        (with-meta [r (assoc path :l (conj l node) :r rnext)] ^loc))))
+
+(defn rightmost
+  "Returns the loc of the rightmost sibling of the node at this loc, or self"
+  [loc]
+    (let [[node {l :l r :r :as path}] loc]
+      (if (and path r)
+        (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] ^loc)
+        loc)))
+
+(defn left
+  "Returns the loc of the left sibling of the node at this loc, or nil"
+  [loc]
+    (let [[node {l :l r :r :as path}] loc]
+      (when (and path (seq l))
+        (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] ^loc))))
+
+(defn leftmost
+  "Returns the loc of the leftmost sibling of the node at this loc, or self"
+  [loc]
+    (let [[node {l :l r :r :as path}] loc]
+      (if (and path (seq l))
+        (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] ^loc)
+        loc)))
+
+(defn insert-left
+  "Inserts the item as the left sibling of the node at this loc,
+ without moving"
+  [loc item]
+    (let [[node {l :l :as path}] loc]
+      (if (nil? path)
+        (throw (new Exception "Insert at top"))
+        (with-meta [node (assoc path :l (conj l item) :changed? true)] ^loc))))
+
+(defn insert-right
+  "Inserts the item as the right sibling of the node at this loc,
+  without moving"
+  [loc item]
+    (let [[node {r :r :as path}] loc]
+      (if (nil? path)
+        (throw (new Exception "Insert at top"))
+        (with-meta [node (assoc path :r (cons item r) :changed? true)] ^loc))))
+
+(defn replace
+  "Replaces the node at this loc, without moving"
+  [loc node]
+    (let [[_ path] loc]
+      (with-meta [node (assoc path :changed? true)] ^loc)))
+
+(defn edit
+  "Replaces the node at this loc with the value of (f node args)"
+  [loc f & args]
+    (replace loc (apply f (node loc) args)))
+
+(defn insert-child
+  "Inserts the item as the leftmost child of the node at this loc,
+  without moving"
+  [loc item]
+    (replace loc (make-node loc (node loc) (cons item (children loc)))))
+
+(defn append-child
+  "Inserts the item as the rightmost child of the node at this loc,
+  without moving"
+  [loc item]
+    (replace loc (make-node loc (node loc) (concat (children loc) [item]))))
+
+(defn next
+  "Moves to the next loc in the hierarchy, depth-first. When reaching
+  the end, returns a distinguished loc detectable via end?. If already
+  at the end, stays there."
+  [loc]
+    (if (= :end (loc 1))
+      loc
+      (or 
+       (and (branch? loc) (down loc))
+       (right loc)
+       (loop [p loc]
+         (if (up p)
+           (or (right (up p)) (recur (up p)))
+           [(node p) :end])))))
+
+(defn prev
+  "Moves to the previous loc in the hierarchy, depth-first. If already
+  at the root, returns nil."
+  [loc]
+    (if-let [lloc (left loc)]
+      (loop [loc lloc]
+        (if-let [child (and (branch? loc) (down loc))]
+          (recur (rightmost child))
+          loc))
+      (up loc)))
+
+(defn end?
+  "Returns true if loc represents the end of a depth-first walk"
+  [loc]
+    (= :end (loc 1)))
+
+(defn remove
+  "Removes the node at loc, returning the loc that would have preceded
+  it in a depth-first walk."
+  [loc]
+    (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc]
+      (if (nil? path)
+        (throw (new Exception "Remove at top"))
+        (if (pos? (count l))
+          (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] ^loc)]
+            (if-let [child (and (branch? loc) (down loc))]
+              (recur (rightmost child))
+              loc))
+          (with-meta [(make-node loc (peek pnodes) rs) 
+                      (and ppath (assoc ppath :changed? true))]
+                     ^loc)))))
+  
+(comment
+
+(load-file "/Users/rich/dev/clojure/src/zip.clj")
+(refer 'zip)
+(def data '[[a * b] + [c * d]])
+(def dz (vector-zip data))
+
+(right (down (right (right (down dz)))))
+(lefts (right (down (right (right (down dz))))))
+(rights (right (down (right (right (down dz))))))
+(up (up (right (down (right (right (down dz)))))))
+(path (right (down (right (right (down dz))))))
+
+(-> dz down right right down right)
+(-> dz down right right down right (replace '/) root)
+(-> dz next next (edit str) next next next (replace '/) root)
+(-> dz next next next next next next next next next remove root)
+(-> dz next next next next next next next next next remove (insert-right 'e) root)
+(-> dz next next next next next next next next next remove up (append-child 'e) root)
+
+(end? (-> dz next next next next next next next next next remove next))
+
+(-> dz next remove next remove root)
+
+(loop [loc dz]
+  (if (end? loc)
+    (root loc)
+    (recur (next (if (= '* (node loc)) 
+                   (replace loc '/)
+                   loc)))))
+
+(loop [loc dz]
+  (if (end? loc)
+    (root loc)
+    (recur (next (if (= '* (node loc)) 
+                   (remove loc)
+                   loc)))))
+)