From b9f9b82bc7a3ae8e0b8764af906cc5a491d7bfd7 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Mon, 9 Sep 2013 14:27:27 +0200
Subject: [PATCH 1/8] Add the SICP metacircular evaluator as a sample
 implementation of a Lisp runtime with ClojureC. Copy/port some cljs functions
 to core.cljc, some reader still needs porting. Fix README.

---
 README.md                 |   8 +-
 samples/metacircular.cljc | 349 ++++++++++++++++++++++++++++++++++++++
 src/cljc/cljc/core.cljc   |  58 ++++++-
 3 files changed, 403 insertions(+), 12 deletions(-)
 create mode 100644 samples/metacircular.cljc

diff --git a/README.md b/README.md
index c8f9bc1..a4d7b5d 100644
--- a/README.md
+++ b/README.md
@@ -46,10 +46,10 @@ ClojureC provides a very simple command line compiler interface.  Let's say we w
 
 If you do the following in the `clojurec` directory
 
-    lein run -c src/cljc/cljc/core.cljc cljc.core run run
-    lein run -c samples/echo.cljc cljc.user run run
-	lein run -d cljc.user/-main run
-    cd run
+    lein run -c src/cljc/cljc/core.cljc cljc.core run/c run
+    lein run -c samples/echo.cljc cljc.user run/c run
+	lein run -d cljc.user/-main run/c
+    cd run/c
     make
 
 you should have a `cljc` executable in the `run` directory that acts mostly like `echo`.
diff --git a/samples/metacircular.cljc b/samples/metacircular.cljc
new file mode 100644
index 0000000..baadb42
--- /dev/null
+++ b/samples/metacircular.cljc
@@ -0,0 +1,349 @@
+(ns sample.metacircular)
+
+; WIP, reader not yet implemented in cljc
+; otherwise works already, also in clojure
+
+(def serror println)
+(def display println)
+
+(def car first)
+(def cdr rest)
+(defn cadr [seq] (car (cdr seq)))
+(defn cddr [seq] (cdr (cdr seq)))
+(defn caadr [seq] (car (car (cdr seq))))
+(defn caddr [seq] (car (cdr (cdr seq))))
+(defn cdadr [seq] (cdr (car (cdr seq))))
+(defn cdddr [seq] (cdr (cdr (cdr seq))))
+(defn cadddr [seq] (car (cdr (cdr (cdr seq)))))
+
+
+(defn tagged-list? [exp tag]
+  (if (seq? exp)
+    (= (car exp) tag)
+    false))
+
+(defn assignment? [exp]
+  (tagged-list? exp 'set!))
+(defn assignment-variable [exp] (cadr exp))
+(defn assignment-value [exp] (caddr exp))
+
+
+(defn lambda? [exp]
+  (tagged-list? exp 'lambda))
+(defn lambda-parameters [exp] (cadr exp))
+(defn lambda-body [exp] (cddr exp))
+
+(defn make-lambda [parameters body]
+  (cons 'lambda (cons parameters body)))
+
+(defn definition? [exp]
+  (tagged-list? exp 'define))
+(defn definition-variable [exp]
+  (if (symbol? (cadr exp))
+    (cadr exp)
+    (caadr exp)))
+(defn definition-value [exp]
+  (if (symbol? (cadr exp))
+    (caddr exp)
+    (make-lambda (cdadr exp) ; formal parameters
+                 (cddr exp)))) ; body
+
+(defn begin? [exp] (tagged-list? exp 'begin))
+(defn begin-actions [exp] (cdr exp))
+(defn last-exp? [seq] (empty? (cdr seq)))
+(defn first-exp [seq] (car seq))
+(defn rest-exps [seq] (cdr seq))
+
+(defn make-begin [seq]
+  (list 'begin seq))
+
+(defn sequence->exp [seq]
+  (cond (empty? seq) seq
+        (last-exp? seq) (first-exp seq)
+        :else (make-begin seq)))
+
+
+(defn variable? [exp]
+  (symbol? exp))
+
+(defn self-evaluating? [exp]
+  (cond (number? exp) true
+        (string? exp) true
+        :else false))
+
+(defn quoted? [exp]
+  (tagged-list? exp 'quote))
+
+(defn text-of-quotation [exp]
+  (cdr exp))
+
+(defn application? [exp] (list? exp))
+(defn operator [exp] (car exp))
+(defn operands [exp] (cdr exp))
+(defn no-operands? [ops] (empty? ops))
+(defn first-operand [ops] (car ops))
+(defn rest-operands [ops] (cdr ops))
+
+
+
+
+(defn cond? [exp] (tagged-list? exp 'cond))
+(defn cond-clauses [exp] (cdr exp))
+(defn cond-predicate [clause] (car clause))
+(defn cond-else-clause? [clause] (= (cond-predicate clause) 'else))
+(defn cond-actions [clause] (cdr clause))
+(declare expand-clauses)
+(defn cond->if [exp]
+  (expand-clauses (cond-clauses exp)))
+
+(declare make-if)
+(defn expand-clauses [clauses]
+  (if (empty? clauses)
+    'false
+    (let [first (car clauses)
+          rest (cdr clauses)]
+      (if (cond-else-clause? first)
+        (if (empty? rest)
+          (sequence->exp (cond-actions first))
+          (serror "ELSE clause isn't last -- COND->IF"
+                 clauses))
+        (make-if (cond-predicate first)
+                 (sequence->exp (cond-actions first))
+                 (expand-clauses rest))))))
+
+
+(declare seval)
+(defn list-of-values [exps env]
+  (if (no-operands? exps) '()
+      (cons (seval (first-operand exps) env)
+            (list-of-values (rest-operands exps) env))))
+
+(defn if? [exp] (tagged-list? exp 'if))
+(defn if-predicate [exp] (cadr exp))
+(defn if-consequent [exp] (caddr exp))
+(defn if-alternative [exp]
+  (if (not (empty? (cdddr exp)))
+    (cadddr exp)
+    'false))
+
+(defn make-if [predicate consequent alternative]
+  (list 'if predicate consequent alternative))
+
+(defn true? [x]
+  (not= x false))
+
+(defn false? [x]
+  (= x false))
+
+(defn eval-if [exp env]
+  (if (true? (seval (if-predicate exp) env))
+    (seval (if-consequent exp) env)
+    (seval (if-alternative exp) env)))
+
+(defn eval-sequence [exps env]
+  (cond (last-exp? exps) (seval (first-exp exps) env)
+        :else (do (seval (first-exp exps) env)
+                  (eval-sequence (rest-exps exps) env))))
+
+(declare set-variable-value!)
+(defn eval-assignment [exp env]
+  (set-variable-value! (assignment-variable exp)
+                       (seval (assignment-value exp) env)
+                       env)
+  'ok)
+
+(declare define-variable!)
+(defn eval-definition [exp env]
+  (define-variable! (definition-variable exp)
+    (seval (definition-value exp) env)
+    env)
+  'ok)
+
+(defn make-procedure [parameters body env]
+  (list 'procedure parameters body env))
+(defn compound-procedure? [p]
+  (tagged-list? p 'procedure))
+(defn procedure-parameters [p] (cadr p))
+(defn procedure-body [p] (caddr p))
+(defn procedure-environment [p] (cadddr p))
+
+(defn enclosing-environment [env] (cdr env))
+(defn first-frame [env] (car env))
+(def the-empty-environment '())
+
+(defn make-frame [variables values]
+  (cons variables values))
+
+(defn frame-variables [frame] (car frame))
+(defn frame-values [frame] (cdr frame))
+
+
+(defn extend-environment [vars vals base-env]
+  (swap! base-env
+         #(if (= (count vars) (count vals))
+            (cons (make-frame vars vals) %)
+            (if (< (count vars) (count vals))
+              (serror "Too many arguments supplied" vars vals)
+              (serror "Too few arguments supplied" vars vals))))
+  base-env)
+
+(defn lookup-variable-value [var env]
+  (defn env-loop [env]
+    (defn scan [vars vals]
+      (cond (empty? vars) (env-loop (enclosing-environment env))
+            (= var (car vars)) (car vals)
+            :else (scan (cdr vars) (cdr vals))))
+    (if (= env the-empty-environment)
+      (serror "Unbound variable" var)
+      (let [frame (first-frame env)]
+        (scan (frame-variables frame)
+              (frame-values frame)))))
+  (env-loop @env))
+
+(defn define-variable! [var val env]
+  (defn scan [vars vals]
+    (cond (empty? vars) (cons (list var) (list val))
+          (= var (car vars)) (cons vars (cons val (cdr vals)))
+          :else (let [[nvars & nvals] (scan (cdr vars) (cdr vals))]
+                  (cons (cons (car vars) nvars)
+                        (cons (car vals) nvals)))))
+  (swap! env (fn [old] (let [frame (first-frame old)
+                            others (enclosing-environment old)]
+                        (cons (scan (frame-variables frame)
+                                    (frame-values frame)) others)))))
+
+(defn set-variable-value! [var val env]
+  (defn env-loop [env]
+    (defn scan [vars vals]
+      (cond (empty? vars) nil
+            (= var (car vars)) (cons vars (cons val (cdr vals)))
+            :else (let [[nvars & nvals] (scan (cdr vars) (cdr vals))]
+                    (cons (cons (car vars) nvars)
+                          (cons (car vals) nvals)))))
+    (if (= env the-empty-environment)
+      (serror "Unbound variable -- SET!" var)
+      (let [frame (first-frame env)
+            others (enclosing-environment env)
+            nframe (scan (frame-variables frame)
+                         (frame-values frame))]
+        (if nframe
+          (cons nframe others)
+          (cons frame (env-loop (enclosing-environment env)))))))
+  (swap! env env-loop))
+
+
+
+(defn primitive-procedure? [proc]
+  (tagged-list? proc 'primitive))
+
+(defn primitive-implementation [proc] (cadr proc))
+
+
+(declare the-global-environment)
+(defn print-env ; ugly hack to allow debugging from REPL
+  ([] (print-env @the-global-environment))
+  ([elem]
+     (if-not (= elem the-global-environment)
+       (if (seq? elem)
+         (do (print "(")
+             (doall (map print-env elem))
+             (print ")"))
+         (print (str elem " "))))))
+
+(declare seval sapply)
+(def primitive-procedures
+  (list (list 'car car)
+        (list 'cdr cdr)
+        (list 'cons cons)
+        (list 'null? empty?)
+        (list '+ +)
+        (list '* *)
+        (list 'env print-env)
+        (list 'eval #(seval % the-global-environment))
+        (list 'apply #(sapply % the-global-environment))))
+
+
+
+(defn primitive-procedure-names []
+  (map car primitive-procedures))
+
+(defn primitive-procedure-objects []
+  (map (fn [proc] (list 'primitive (cadr proc)))
+       primitive-procedures))
+
+(def apply-in-underlying-scheme apply)
+(defn apply-primitive-procedure [proc args]
+  (apply-in-underlying-scheme
+   (primitive-implementation proc) args))
+
+(defn setup-environment []
+  (let [initial-env (extend-environment (primitive-procedure-names)
+                                        (primitive-procedure-objects)
+                                        (atom the-empty-environment))]
+    (define-variable! 'true true initial-env)
+    (define-variable! 'false false initial-env)
+    initial-env))
+(def the-global-environment (setup-environment))
+
+
+(def input-prompt ";;; M-Eval input:")
+(def output-prompt ";;; M-Eval value:")
+
+(defn prompt-for-input [string]
+  (newline) (newline) (display string) (newline))
+(defn announce-output [string]
+  (newline) (display string) (newline))
+
+(defn user-print [object]
+  (if (compound-procedure? object)
+    (display (list 'compound-procedure
+                   (procedure-parameters object)
+                   (procedure-body object)
+                   '<procedure-env>))
+    (display object)))
+
+(defn read []
+  (read-line)
+  (list '+ 1000 (list '* 5 4) 4))
+
+(defn driver-loop []
+  (prompt-for-input input-prompt)
+  (let [input (read)
+        output (seval input the-global-environment)]
+    (announce-output output-prompt)
+    (user-print output)
+    (if (not= 'quit input) (driver-loop))))
+
+
+
+(declare sapply)
+(defn seval [exp env]
+  (println "eval: " exp)
+  (cond (self-evaluating? exp) exp
+        (variable? exp) (lookup-variable-value exp env)
+        (quoted? exp) (text-of-quotation exp)
+        (assignment? exp) (eval-assignment exp env)
+        (definition? exp) (eval-definition exp env)
+        (if? exp) (eval-if exp env)
+        (lambda? exp) (make-procedure (lambda-parameters exp)
+                                      (lambda-body exp)
+                                      env)
+        (begin? exp) (eval-sequence (begin-actions exp) env)
+        (cond? exp) (seval (cond->if exp) env)
+        (application? exp) (sapply (seval (operator exp) env)
+                                   (list-of-values (operands exp) env))
+        :else (serror "Unknown expression type -- EVAL" exp)))
+
+
+(defn sapply [procedure arguments]
+  (cond (primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)
+        (compound-procedure? procedure) (eval-sequence (procedure-body procedure)
+                                                       (extend-environment
+                                                        (procedure-parameters procedure)
+                                                        arguments
+                                                        (procedure-environment procedure)))
+        :else (serror "Unknown procedure type -- APPLY" procedure)))
+
+
+(defn -main [& args]
+  (driver-loop))
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 2add31d..1c1d422 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -71,6 +71,9 @@
     (c* "fputs (string_get_utf8 (~{}), stdout)" s)
     nil))
 
+(defn read-line []
+  (c* "make_string( fgets ( ((string_t*)(make_string_with_size(1024)))->utf8, 1024, stdin) )"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; arrays ;;;;;;;;;;;;;;;;
 
 (defn aclone
@@ -1194,7 +1197,8 @@ reduces them without incurring seq initialization"
 (defn int
   "Coerce to int by stripping decimal places."
   [x]
-  (fix x))
+  (cond (char? x) (c* "make_integer ((long)character_get (~{}))" x)
+        :else (fix x)))
 
 (defn long
   "Coerce to long by stripping decimal places. Identical to `int'."
@@ -1593,6 +1597,9 @@ reduces them without incurring seq initialization"
     (Cons. nil x coll nil)
     (Cons. nil x (seq coll) nil)))
 
+(defn ^boolean list? [x]
+  (satisfies? IList x))
+
 (extend-type Character
   IEquiv
   (-equiv [c o]
@@ -2039,6 +2046,11 @@ reduces them without incurring seq initialization"
    (pred (first coll)) (recur pred (next coll))
    true false))
 
+(defn ^boolean not-every?
+  "Returns false if (pred x) is logical true for every x in
+  coll, else true."
+  [pred coll] (not (every? pred coll)))
+
 (defn some
   "Returns the first logical true value of (pred x) for any x in coll,
   else nil.  One common idiom is to use a set as pred, for example
@@ -2843,7 +2855,7 @@ reduces them without incurring seq initialization"
   IEmptyableCollection
   (-empty [coll]
     (-with-meta cljc.core.PersistentVector/EMPTY meta))
-  
+
   IPrintable
   (-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll)))
 
@@ -3977,7 +3989,7 @@ reduces them without incurring seq initialization"
 
   IHash
   (-hash [coll] (caching-hash coll hash-coll __hash))
-  
+
   IPrintable
   (-pr-seq [coll opts] (pr-sequential pr-seq "(" " " ")" opts coll)))
 
@@ -5370,6 +5382,34 @@ reduces them without incurring seq initialization"
          ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))
          ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))
 
+(defn dorun
+  "When lazy sequences are produced via functions that have side
+  effects, any effects other than those needed to produce the first
+  element in the seq do not occur until the seq is consumed. dorun can
+  be used to force any effects. Walks through the successive nexts of
+  the seq, does not retain the head and returns nil."
+  ([coll]
+   (when (seq coll)
+     (recur (next coll))))
+  ([n coll]
+   (when (and (seq coll) (pos? n))
+     (recur (dec n) (next coll)))))
+
+(defn doall
+  "When lazy sequences are produced via functions that have side
+  effects, any effects other than those needed to produce the first
+  element in the seq do not occur until the seq is consumed. doall can
+  be used to force any effects. Walks through the successive nexts of
+  the seq, retains the head and returns it, thus causing the entire
+  seq to reside in memory at one time."
+  ([coll]
+   (dorun coll)
+   coll)
+  ([n coll]
+   (dorun n coll)
+   coll))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing ;;;;;;;;;;;;;;;;
 
 (defn pr-sequential [print-one begin sep end opts coll]
@@ -5435,10 +5475,12 @@ reduces them without incurring seq initialization"
         (string-print string))
       (recur (next objs) true))))
 
-(defn newline [opts]
-  (string-print "\n")
-  (when (get opts :flush-on-newline)
-    (flush)))
+(defn newline
+  ([] (newline nil))
+  ([opts]
+     (string-print "\n")
+     (when (get opts :flush-on-newline)
+       (flush))))
 
 (def *flush-on-newline* true)
 (def *print-readably* true)
@@ -6202,7 +6244,7 @@ reduces them without incurring seq initialization"
            (do-split s (count s) re limit 0 0)))
       ([s re]
          (split s re 0)))))
-  
+
 (defn split-lines
   "Splits s on \\n or \\r\\n."
   [s]

From 691d6d5096e4dc4d648e2a6067f4577b042ad3a6 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Fri, 13 Sep 2013 11:19:34 +0200
Subject: [PATCH 2/8] Add ported cljs.reader as cljc.reader.

Port reader from ClojureScript, works for:
Integer
Ratio
Float/Double
String
Symbol
Keyword
Vector
List
Map

Some problem corrupts symbols though, still investigating, possibly a
garbage collection error. Can be tested by applying nested arithmetic
expressions repeatedly with the metacircular REPL.
---
 samples/metacircular.cljc |  29 +-
 src/c/cljc.h              |   2 +
 src/c/runtime.c           |   8 +-
 src/clj/cljc/compiler.clj |  12 +-
 src/cljc/cljc/core.cljc   |  45 ++-
 src/cljc/cljc/reader.cljc | 620 ++++++++++++++++++++++++++++++++++++++
 6 files changed, 692 insertions(+), 24 deletions(-)
 create mode 100644 src/cljc/cljc/reader.cljc

diff --git a/samples/metacircular.cljc b/samples/metacircular.cljc
index baadb42..f71b789 100644
--- a/samples/metacircular.cljc
+++ b/samples/metacircular.cljc
@@ -1,4 +1,5 @@
-(ns sample.metacircular)
+(ns sample.metacircular
+  (:use [cljc.reader :only [read-string]]))
 
 ; WIP, reader not yet implemented in cljc
 ; otherwise works already, also in clojure
@@ -31,7 +32,7 @@
 (defn lambda? [exp]
   (tagged-list? exp 'lambda))
 (defn lambda-parameters [exp] (cadr exp))
-(defn lambda-body [exp] (cddr exp))
+(defn lambda-body [exp] (caddr exp)) ; was cddr
 
 (defn make-lambda [parameters body]
   (cons 'lambda (cons parameters body)))
@@ -75,10 +76,10 @@
   (tagged-list? exp 'quote))
 
 (defn text-of-quotation [exp]
-  (cdr exp))
+  (cadr exp)) ; was cdr
 
 (defn application? [exp] (list? exp))
-(defn operator [exp] (car exp))
+(defn operator [exp] (println "exp: " exp " op:" (car exp)) (car exp))
 (defn operands [exp] (cdr exp))
 (defn no-operands? [ops] (empty? ops))
 (defn first-operand [ops] (car ops))
@@ -190,6 +191,7 @@
 (defn lookup-variable-value [var env]
   (defn env-loop [env]
     (defn scan [vars vals]
+      (println "comparing: " var " with " (car vars))
       (cond (empty? vars) (env-loop (enclosing-environment env))
             (= var (car vars)) (car vals)
             :else (scan (cdr vars) (cdr vals))))
@@ -302,18 +304,19 @@
                    '<procedure-env>))
     (display object)))
 
-(defn read []
-  (read-line)
-  (list '+ 1000 (list '* 5 4) 4))
 
 (defn driver-loop []
   (prompt-for-input input-prompt)
-  (let [input (read)
-        output (seval input the-global-environment)]
-    (announce-output output-prompt)
-    (user-print output)
-    (if (not= 'quit input) (driver-loop))))
-
+  (let [input (try (read-string (read-line))
+                   (catch Exception e (str "Cannot read input: \n"
+                                           (-get-message e))))]
+    (if-not (= 'quit input)
+      (let [output (try (seval input the-global-environment)
+                        (catch Exception e ("Cannot evaluate: \n"
+                                            (-get-message e))))]
+        (announce-output output-prompt)
+        (user-print output)
+        (driver-loop)))))
 
 
 (declare sapply)
diff --git a/src/c/cljc.h b/src/c/cljc.h
index 57b0a8a..064f5ce 100644
--- a/src/c/cljc.h
+++ b/src/c/cljc.h
@@ -285,10 +285,12 @@ extern value_t* make_string_from_unichar (cljc_unichar_t c);
 extern value_t* make_string_from_buf (const char *start, const char *end);
 extern const char* string_get_utf8 (value_t *v);
 extern uint32_t string_hash_code (const char *utf8);
+extern value_t* make_symbol (const char *utf8);
 extern value_t* intern_symbol (const char *utf8, bool copy);
 extern const char* symbol_get_utf8 (value_t *v);
 extern value_t* symbol_get_name (value_t *v);
 extern value_t* symbol_get_namespace (value_t *v);
+extern value_t* make_keyword (const char *utf8);
 extern value_t* intern_keyword (const char *utf8, bool copy);
 extern const char* keyword_get_utf8 (value_t *v);
 extern value_t* keyword_get_name (value_t *v);
diff --git a/src/c/runtime.c b/src/c/runtime.c
index fd59cec..7cf7d95 100644
--- a/src/c/runtime.c
+++ b/src/c/runtime.c
@@ -580,12 +580,12 @@ string_hash_code (const char *utf8)
         return hashmurmur3_32(utf8, len);
 }
 
-static symbol_t*
+value_t* // was static symbol_t*
 make_symbol (const char *utf8)
 {
 	symbol_t *sym = (symbol_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Symbol), sizeof (symbol_t));
 	sym->utf8 = utf8;
-	return sym;
+	return &sym->val;
 }
 
 KHASH_MAP_INIT_STR (SYMBOLS, symbol_t*);
@@ -620,12 +620,12 @@ symbol_get_utf8 (value_t *v)
 	return s->utf8;
 }
 
-static keyword_t*
+value_t*
 make_keyword (const char *utf8)
 {
 	keyword_t *kw = (keyword_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Keyword), sizeof (keyword_t));
 	kw->utf8 = utf8;
-	return kw;
+	return &kw->val;
 }
 
 KHASH_MAP_INIT_STR (KEYWORDS, keyword_t*);
diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj
index 57b598c..242029f 100644
--- a/src/clj/cljc/compiler.clj
+++ b/src/clj/cljc/compiler.clj
@@ -313,8 +313,9 @@
          (emitln ";")
          name#))))
 
-(defn FIXME-IMPLEMENT []
-  (throw (UnsupportedOperationException.)))
+(defn FIXME-IMPLEMENT
+  ([] (throw (UnsupportedOperationException.)))
+  ([msg] (throw (UnsupportedOperationException. msg))))
 
 (defmulti emit-constant class)
 (defmethod emit-constant nil [x] "value_nil")
@@ -333,7 +334,8 @@
 (defmethod emit-constant Boolean [x] (if x "value_true" "value_false"))
 
 (defmethod emit-constant java.util.regex.Pattern [x]
-  (FIXME-IMPLEMENT))
+  (emit-value-wrap :pattern-const nil (emits "pcre_pattern ( make_string (" (wrap-in-double-quotes (escape-string (str x))) "))"))
+  #_(FIXME-IMPLEMENT (str "Cannot emit java.util.regex.Pattern for constant " x " yet.")))
 
 (defmethod emit-constant clojure.lang.Keyword [x]
   (emit-value-wrap :keyword nil
@@ -926,7 +928,7 @@
 
      :else
      ;; actually, this case probably shouldn't happen
-     (FIXME-IMPLEMENT))))
+     (FIXME-IMPLEMENT (str "Cannot emit code for: " target " with value: " val)))))
 
 (defmethod emit :ns
   [{:keys [name requires uses requires-macros env]}]
@@ -1374,7 +1376,7 @@
      (when (and allowed-argcs (not (allowed-argcs argc)))
        (warning env
          (str "WARNING: Wrong number of args (" argc ") passed to " ctor)))
-     
+
      {:env env :op :new :form form :ctor ctorexpr :args argexprs
       :children (into [ctorexpr] argexprs)})))
 
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 1c1d422..6b8b25c 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -864,6 +864,36 @@ reduces them without incurring seq initialization"
   [s]
   (has-type? s Symbol))
 
+(declare str)
+(defn keyword
+  "Returns a Keyword with the given namespace and name.  Do not use :
+  in the keyword strings, it will be added automatically."
+  ([name] (c* "make_keyword( string_get_utf8(~{}) )" (if (symbol? name)
+                                                       (name name)
+                                                       name))
+     #_(cond
+      (keyword? name) (Keyword. nil name name nil)
+      (symbol? name) (Keyword. nil (name name) (name name) nil)
+      :else (Keyword. nil name name nil)))
+  ([ns name] (c* "make_keyword( string_get_utf8(~{}) )" (str ns "/" name))
+     #_(Keyword. ns name (str (when ns (str ns "/")) name) nil)))
+
+
+
+
+(defn symbol
+  ([name]
+     (if (symbol? name)
+       name
+       (symbol nil name)))
+  ([ns name]
+     (let [sym-str (if-not (nil? ns)
+                     (str ns "/" name)
+                     name)]
+       #_(Symbol. ns name sym-str nil nil)
+       (c* "make_symbol( string_get_utf8( make_string_copy( string_get_utf8 (~{}) ) ) )" sym-str))))
+
+
 (defn ^boolean number? [n]
   (or
    (has-type? n Integer)
@@ -1318,6 +1348,7 @@ reduces them without incurring seq initialization"
   (-append! [sb appendee])
   (-to-string [sb]))
 
+(declare println)
 (if-objc
   (do
     (deftype StringBuilder [string]
@@ -1744,10 +1775,13 @@ reduces them without incurring seq initialization"
   (-pr-seq [k opts]
     (list (str k))))
 
+(declare name)
 (extend-type Symbol
   IEquiv
   (-equiv [s o]
-    (identical? s o))
+    (or (identical? s o)
+        (and (symbol? s) (symbol? o)
+             (= (name s) (name o)))))
 
   IFn
   (-invoke [k coll]
@@ -6277,7 +6311,14 @@ reduces them without incurring seq initialization"
    ;; decide general semantics (parseInteger vs strtoll() style, etc.).
    (if-objc
     (§ s :integerValue)
-    (c* "make_integer (g_ascii_strtoll (string_get_utf8 (~{}), NULL, 10))" s base)))
+    (c* "make_integer (g_ascii_strtoll (string_get_utf8 (~{}), NULL, 10))" s)))
+
+  (defn- parse-float [s]
+    (if-objc
+     :TODO
+     (c* "make_float (strtod (string_get_utf8 (~{}), NULL ) )" s s (count s))))
+
+
 
 (defn- replacement->handler [r]
   ;; Returns a function to handle "foo$1$3bar$2" replacements in s, if any.
diff --git a/src/cljc/cljc/reader.cljc b/src/cljc/cljc/reader.cljc
new file mode 100644
index 0000000..85bc81c
--- /dev/null
+++ b/src/cljc/cljc/reader.cljc
@@ -0,0 +1,620 @@
+;   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 cljc.reader
+  (:require [cljc.string :as string])
+  #_(:require [goog.string :as gstring]))
+
+
+(defprotocol PushbackReader
+  (read-char [reader] "Returns the next char from the Reader,
+nil if the end of stream has been reached")
+  (unread [reader ch] "Push back a single character on to the stream"))
+
+(deftype StringPushbackReader [s buffer ^:mutable idx ^:mutable bidx]
+  PushbackReader
+  (read-char [reader]
+    (if (zero? bidx)
+      (if (= (count s) idx)
+        nil
+        (do
+          (set! idx (inc idx))
+          (nth s idx)))
+      (do
+        (set! bidx (dec bidx))
+        (aget buffer bidx))))
+  (unread [reader ch]
+    (aset buffer bidx ch)
+    (set! bidx (inc bidx))))
+
+(defn push-back-reader [s]
+  "Creates a StringPushbackReader from a given string"
+  (StringPushbackReader. s (make-array 1024) -1 0))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; predicates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- ^boolean whitespace?
+  "Checks whether a given character is whitespace"
+  [ch]
+  (string/blank-char? ch)
+  #_(or #_(gstring/isBreakingWhitespace ch)
+      (= " " ch)
+      (= \n ch)
+      (= \r ch)
+      (= \t ch)
+      (= \, ch)))
+
+(defn- ^boolean numeric?
+  "Checks whether a given character is numeric"
+  [ch]
+  (or (= \0 ch)
+      (= \1 ch)
+      (= \2 ch)
+      (= \3 ch)
+      (= \4 ch)
+      (= \5 ch)
+      (= \6 ch)
+      (= \7 ch)
+      (= \8 ch)
+      (= \9 ch)))
+
+(defn- ^boolean comment-prefix?
+  "Checks whether the character begins a comment."
+  [ch]
+  (= \; ch))
+
+(defn- ^boolean number-literal?
+  "Checks whether the reader is at the start of a number literal"
+  [reader initch]
+  (or (numeric? initch)
+      (and (or (= \+ initch) (= \- initch))
+           (numeric? (let [next-ch (read-char reader)]
+                       (unread reader next-ch)
+                       next-ch)))))
+
+(declare read macros dispatch-macros)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; read helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+; later will do e.g. line numbers...
+(defn reader-error
+  [rdr & msg]
+  (throw (Exception. (apply str msg))))
+
+(defn ^boolean macro-terminating? [ch]
+  (and (not (= ch "#"))
+       (not (= ch \'))
+       (not (= ch ":"))
+       (macros ch)))
+
+(defn read-token
+  [rdr initch]
+  (loop [sb (sb-make (str initch))
+         ch (read-char rdr)]
+    (if (or (nil? ch)
+            (whitespace? ch)
+            (macro-terminating? ch))
+      (do (unread rdr ch) (-to-string sb))
+      (recur (-append! sb (str ch)) (read-char rdr)))))
+
+(defn skip-line
+  "Advances the reader to the end of a line. Returns the reader"
+  [reader _]
+  (loop []
+    (let [ch (read-char reader)]
+      (if (or (= ch \n) (= ch \r) (nil? ch))
+        reader
+        (recur)))))
+
+(def int-pattern (re-pattern "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?"))
+(def ratio-pattern (re-pattern "([-+]?[0-9]+)/([0-9]+)"))
+(def float-pattern (re-pattern "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"))
+(def symbol-pattern (re-pattern "[:]?([^0-9/].*/)?([^0-9/][^/]*)"))
+
+(defn- re-find*
+  [re s]
+  (let [[matches] (re-seq re s)]
+    (when-not (nil? matches)
+      (if (== (count matches) 1)
+        (nth matches 0)
+        matches))))
+
+(defn- match-int
+  [s]
+  (let [groups (re-find* int-pattern s)
+        group3 (nth groups 2)]
+    (if-not (or (nil? group3)
+                (< (count group3) 1))
+      0
+      (let [negate (if (= "-" (nth groups 1)) -1 1)
+            a (cond
+               (nth groups 3) (array (nth groups 3) 10)
+               (nth groups 4) (array (nth groups 4) 16)
+               (nth groups 5) (array (nth groups 5) 8)
+               (nth groups 7) (array (nth groups 7) (string/parse-integer (nth groups 7)))
+               :default (array nil nil))
+            n (nth a 0)
+            radix (nth a 1)]
+        (if (nil? n)
+          nil
+                                        ; TODO radix
+          #_(* negate (string/parse-integer n radix))
+          (* negate (string/parse-integer n)))))))
+
+
+ (defn- match-ratio
+   [s]
+   (let [groups (re-find* ratio-pattern s)
+         numinator (nth groups 1)
+         denominator (nth groups 2)]
+     (/ (string/parse-integer numinator) (string/parse-integer denominator))))
+
+ (defn- match-float
+   ; TODO possibly need extension of underlying strtod
+   [s]
+   (let [groups (re-find* float-pattern s)
+         group1 (nth groups 0)]
+    (if-not (or (nil? group1)
+            (< (count group1) 1))
+      (string/parse-float s)))
+   #_(js/parseFloat s))
+
+ (defn- re-matches*
+   [re s]
+   (let [dirt-matches (re-seq re s)
+         [matches] dirt-matches]
+     #_(println "matches: " dirt-matches)
+     (when (and (not (nil? matches))
+                (= (nth matches 0) s))
+       (if (== (count matches) 1)
+         (nth matches 0)
+         matches))))
+
+ (defn- match-number
+   [s]
+   (cond
+    (re-matches* int-pattern s) (match-int s)
+    (re-matches* ratio-pattern s) (match-ratio s)
+    (re-matches* float-pattern s) (match-float s)))
+
+ (defn escape-char-map [c]
+   (cond
+    (= c \t) "\t"
+    (= c \r) "\r"
+    (= c \n) "\n"
+    (= c \\) \\
+    (= c \") \"
+    (= c \b) "\b"
+    (= c \f) "\f"
+    :else nil))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; unicode
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (defn read-2-chars [reader]
+   (-to-string
+     (sb-make
+      (str
+       (read-char reader)
+       (read-char reader)))))
+
+ (defn read-4-chars [reader]
+   (-to-string
+    (sb-make
+     (str
+      (read-char reader)
+      (read-char reader)
+      (read-char reader)
+      (read-char reader)))))
+
+ (def unicode-2-pattern (re-pattern "[0-9A-Fa-f]{2}"))
+ (def unicode-4-pattern (re-pattern "[0-9A-Fa-f]{4}"))
+
+ (defn validate-unicode-escape [unicode-pattern reader escape-char unicode-str]
+   (if (re-matches unicode-pattern unicode-str)
+     unicode-str
+     (reader-error reader "Unexpected unicode escape \\" escape-char unicode-str)))
+
+ (defn make-unicode-char [code-str]
+   "TODO UNICODE"
+     #_(let [code (string/parse-integer code-str 16)]
+       (.fromCharCode js/String code)))
+
+ (defn escape-char
+   [buffer reader]
+   (let [ch (read-char reader)
+         mapresult (escape-char-map ch)]
+     (if mapresult
+       mapresult
+       (cond
+         (= ch \x)
+         (->> (read-2-chars reader)
+           (validate-unicode-escape unicode-2-pattern reader ch)
+           (make-unicode-char))
+
+         (= ch \u)
+         (->> (read-4-chars reader)
+           (validate-unicode-escape unicode-4-pattern reader ch)
+           (make-unicode-char))
+
+         (numeric? ch)
+         "TODO NUMERIC"
+         #_(.fromCharCode js/String ch)
+
+         :else
+         (reader-error reader "Unexpected unicode escape \\" ch )))))
+
+ (defn read-past
+   "Read until first character that doesn't match pred, returning
+    char."
+   [pred rdr]
+   (loop [ch (read-char rdr)]
+     (if (and ch (pred ch))
+       (recur (read-char rdr))
+       ch)))
+
+ (defn read-delimited-list
+   [delim rdr recursive?]
+   (loop [a (transient [])]
+     (let [ch (read-past whitespace? rdr)]
+       (when-not ch (reader-error rdr "EOF while reading"))
+       (if (= delim ch)
+         (persistent! a)
+         (if-let [macrofn (macros ch)]
+           (let [mret (macrofn rdr ch)]
+             (recur (if (= mret rdr) a (conj! a mret))))
+           (do
+             (unread rdr ch)
+             (let [o (read rdr true nil recursive?)]
+               (recur (if (= o rdr) a (conj! a o))))))))))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; data structure readers
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ (defn not-implemented
+   [rdr ch]
+   (reader-error rdr "Reader for " ch " not implemented yet"))
+
+ (declare maybe-read-tagged-type)
+
+ (defn read-dispatch
+   [rdr _]
+   (let [ch (read-char rdr)
+         dm (dispatch-macros ch)]
+     (if dm
+       (dm rdr _)
+       (if-let [obj (maybe-read-tagged-type rdr ch)]
+         obj
+         (reader-error rdr "No dispatch macro for " ch)))))
+
+ (defn read-unmatched-delimiter
+   [rdr ch]
+   (reader-error rdr "Unmatched delimiter " ch))
+
+ (defn read-list
+   [rdr _]
+   (apply list (read-delimited-list \) rdr true)))
+
+ (def read-comment skip-line)
+
+ (defn read-vector
+   [rdr _]
+   (read-delimited-list \] rdr true))
+
+ (defn read-map
+   [rdr _]
+   (let [l (read-delimited-list \} rdr true)]
+     (when (odd? (count l))
+       (reader-error rdr "Map literal must contain an even number of forms"))
+     (apply hash-map l)))
+
+ (defn read-number
+   [reader initch]
+   (loop [buffer (sb-make (str initch))
+          ch (read-char reader)]
+     (if (or (nil? ch) (whitespace? ch) (macros ch))
+       (do
+         (unread reader ch)
+         (let [s (-to-string buffer)]
+           (or (match-number s)
+               (reader-error reader "Invalid number format [" s "]"))))
+       (recur (do (-append! buffer (str ch))) (read-char reader)))))
+
+ (defn read-string*
+   [reader _]
+   (loop [buffer (sb-make "") #_(gstring/StringBuffer.)
+          ch (read-char reader)]
+     (cond
+      (nil? ch) (reader-error reader "EOF while reading")
+      (= "\\" ch) (recur (do (-append! buffer (str (escape-char buffer reader))))
+                         (read-char reader))
+      (= \" ch) (-to-string buffer)
+      :default (recur (do (-append! buffer (str ch))) (read-char reader)))))
+
+ (defn special-symbols [t not-found]
+   (cond
+    (= t "nil") nil
+    (= t "true") true
+    (= t "false") false
+    :else not-found))
+
+ (defn- contains
+   ([s t] (not (nil? (string/index-of s t)))))
+
+ (defn read-symbol
+   [reader initch]
+   (let [token (read-token reader initch)]
+     (if (contains token "/")
+       (symbol (subs token 0 (string/index-of token "/"))
+               (subs token (inc (string/index-of token "/")) (count token)))
+       (special-symbols token (symbol token)))))
+
+ (defn read-keyword
+   [reader initch]
+   (let [token (read-token reader (read-char reader))
+         a (re-matches* symbol-pattern token)
+         token (nth a 0)
+         ns (nth a 1)
+         name (nth a 2)]
+     (if (or (and (not (empty? ns)) ; was js undefined?
+                  (= (subs ns (- (count ns) 2) (count ns)) ":/"))
+             (= (nth name (dec (count name))) ":")
+             (not (nil? (string/index-of token "::" 1))))
+       (reader-error reader "Invalid token: " token)
+       (if (and (not (empty? ns)) (> (count ns) 0))
+         (keyword (subs ns 0 (string/index-of ns "/")) name)
+         (keyword token)))))
+
+ (defn desugar-meta
+   [f]
+   (cond
+    (symbol? f) {:tag f}
+    (string? f) {:tag f}
+    (keyword? f) {f true}
+    :else f))
+
+ (defn wrapping-reader
+   [sym]
+   (fn [rdr _]
+     (list sym (read rdr true nil true))))
+
+ (defn throwing-reader
+   [msg]
+   (fn [rdr _]
+     (reader-error rdr msg)))
+
+ (defn read-meta
+   [rdr _]
+   (let [m (desugar-meta (read rdr true nil true))]
+     (when-not (map? m)
+       (reader-error rdr "Metadata must be Symbol,Keyword,String or Map"))
+     (let [o (read rdr true nil true)]
+       (if (satisfies? IWithMeta o)
+         (with-meta o (merge (meta o) m))
+         (reader-error rdr "Metadata can only be applied to IWithMetas")))))
+
+ (defn read-set
+   [rdr _]
+   (set (read-delimited-list \} rdr true)))
+
+ (defn read-regex
+   [rdr ch]
+   (-> (read-string* rdr ch) re-pattern))
+
+ (defn read-discard
+   [rdr _]
+   (read rdr true nil true)
+   rdr)
+
+ (defn macros [c]
+   (cond
+    (= c \") read-string*
+    (= c \:) read-keyword
+    (= c \;) not-implemented ;; never hit this
+    (= c \') (wrapping-reader 'quote)
+    (= c \@) (wrapping-reader 'deref)
+    (= c \^) read-meta
+    (= c \`) not-implemented
+    (= c \~) not-implemented
+    (= c \() read-list
+    (= c \)) read-unmatched-delimiter
+    (= c \[) read-vector
+    (= c \]) read-unmatched-delimiter
+    (= c \{) read-map
+    (= c \}) read-unmatched-delimiter
+    (= c \\) read-char
+    (= c \#) read-dispatch
+    :else nil))
+
+ ;; omitted by design: var reader, eval reader
+ (defn dispatch-macros [s]
+   (cond
+    (= s "{") read-set
+    (= s "<") (throwing-reader "Unreadable form")
+    (= s "\"") read-regex
+    (= s"!") read-comment
+    (= s "_") read-discard
+    :else nil))
+
+ (defn read
+   "Reads the first object from a PushbackReader. Returns the object read.
+    If EOF, throws if eof-is-error is true. Otherwise returns sentinel."
+   [reader eof-is-error sentinel is-recursive]
+   (let [ch (read-char reader)]
+     (cond
+      (nil? ch) (if eof-is-error (reader-error reader "EOF while reading") sentinel)
+      (whitespace? ch) (recur reader eof-is-error sentinel is-recursive)
+      (comment-prefix? ch) (recur (read-comment reader ch) eof-is-error sentinel is-recursive)
+      :else (let [f (macros ch)
+                  res
+                  (cond
+                   f (f reader ch)
+                   (number-literal? reader ch) (read-number reader ch)
+                   :else (read-symbol reader ch))]
+      (if (= res reader)
+        (recur reader eof-is-error sentinel is-recursive)
+        res)))))
+
+ (defn read-string
+   "Reads one object from the string s"
+   [s]
+   (let [r (push-back-reader s)]
+     (read r true nil false)))
+
+
+ ;; read instances
+
+ (defn ^:private zero-fill-right-and-truncate [s width]
+   (cond (= width (count s)) s
+         (< width (count s)) (subs s 0 width)
+         :else (loop [b (sb-make s)]
+                 (if (< (-count b) width) ; TODO getLength
+                   (recur (-append! b "0"))
+                   (-to-string b)))))
+
+ (defn ^:private divisible?
+   [num div]
+   (zero? (mod num div)))
+
+ (defn ^:private indivisible?
+   [num div]
+     (not (divisible? num div)))
+
+ (defn ^:private leap-year?
+   [year]
+   (and (divisible? year 4)
+        (or (indivisible? year 100)
+            (divisible? year 400))))
+
+ (def ^:private days-in-month
+   (let [dim-norm [nil 31 28 31 30 31 30 31 31 30 31 30 31]
+         dim-leap [nil 31 29 31 30 31 30 31 31 30 31 30 31]]
+     (fn [month leap-year?]
+       (get (if leap-year? dim-leap dim-norm) month))))
+
+ (def ^:private timestamp-regex #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?")
+
+ (defn ^:private parse-int [s]
+   (string/parse-integer s)
+   #_(let [n (string/parse-integer s)]
+    (if-not (js/isNaN n)
+      n)))
+
+(defn ^:private check [low n high msg]
+  (when-not (<= low n high)
+    (reader-error nil (str msg " Failed:  " low "<=" n "<=" high)))
+  n)
+
+(defn parse-and-validate-timestamp [s]
+  (let [[_ years months days hours minutes seconds fraction offset-sign offset-hours offset-minutes :as v]
+        (re-matches timestamp-regex s)]
+    (if-not v
+      (reader-error nil (str "Unrecognized date/time syntax: " s))
+      (let [years (parse-int years)
+            months (or (parse-int months) 1)
+            days (or (parse-int days) 1)
+            hours (or (parse-int hours) 0)
+            minutes (or (parse-int minutes) 0)
+            seconds (or (parse-int seconds) 0)
+            fraction (or (parse-int (zero-fill-right-and-truncate fraction 3)) 0)
+            offset-sign (if (= offset-sign "-") -1 1)
+            offset-hours (or (parse-int offset-hours) 0)
+            offset-minutes (or (parse-int offset-minutes) 0)
+            offset (* offset-sign (+ (* offset-hours 60) offset-minutes))]
+        [years
+         (check 1 months 12 "timestamp month field must be in range 1..12")
+         (check 1 days (days-in-month months (leap-year? years)) "timestamp day field must be in range 1..last day in month")
+         (check 0 hours 23 "timestamp hour field must be in range 0..23")
+         (check 0 minutes 59 "timestamp minute field must be in range 0..59")
+         (check 0 seconds (if (= minutes 59) 60 59) "timestamp second field must be in range 0..60")
+         (check 0 fraction 999 "timestamp millisecond field must be in range 0..999")
+         offset]))))
+
+(defn parse-timestamp
+  [ts]
+  (if-let [[years months days hours minutes seconds ms offset]
+           (parse-and-validate-timestamp ts)]
+    [years months days hours minutes seconds ms offset]
+    #_(js/Date.
+     (- (.UTC js/Date years (dec months) days hours minutes seconds ms)
+        (* offset 60 1000)))
+    (reader-error nil (str "Unrecognized date/time syntax: " ts))))
+
+(defn ^:private read-date
+  [s]
+  (if (string? s)
+    (parse-timestamp s)
+    (reader-error nil "Instance literal expects a string for its timestamp.")))
+
+
+(defn ^:private read-queue
+  [elems]
+  (if (vector? elems)
+    #_(into cljc.core.PersistentQueue/EMPTY elems)
+    (into '() elems)
+    (reader-error nil "Queue literal expects a vector for its elements.")))
+
+
+(defn ^:private read-uuid
+  [uuid]
+  (if (string? uuid)
+    "TODO UUID"
+    #_(UUID. uuid)
+    (reader-error nil "UUID literal expects a string as its representation.")))
+
+(def *tag-table* (atom {"inst"  read-date
+                        "uuid"  read-uuid
+                        "queue" read-queue}))
+
+(def *default-data-reader-fn*
+  (atom nil))
+
+(defn maybe-read-tagged-type
+  [rdr initch]
+  (let [tag (read-symbol rdr initch)
+        pfn (get @*tag-table* (str tag))
+        dfn @*default-data-reader-fn*]
+    (cond
+     pfn (pfn (read rdr true nil false))
+     dfn (dfn tag (read rdr true nil false))
+     :else (reader-error rdr
+                         "Could not find tag parser for " (str tag)
+                         " in " (pr-str (keys @*tag-table*))))))
+
+(defn register-tag-parser!
+  [tag f]
+  (let [tag (str tag)
+        old-parser (get @*tag-table* tag)]
+    (swap! *tag-table* assoc tag f)
+    old-parser))
+
+(defn deregister-tag-parser!
+  [tag]
+  (let [tag (str tag)
+        old-parser (get @*tag-table* tag)]
+    (swap! *tag-table* dissoc tag)
+    old-parser))
+
+(defn register-default-tag-parser!
+  [f]
+  (let [old-parser @*default-data-reader-fn*]
+    (swap! *default-data-reader-fn* (fn [_] f))
+    old-parser))
+
+(defn deregister-default-tag-parser!
+  []
+  (let [old-parser @*default-data-reader-fn*]
+    (swap! *default-data-reader-fn* (fn [_] nil))
+    old-parser))

From 1a02c96944bad2d0230ddb939273027e2d3222ec Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Fri, 13 Sep 2013 22:44:49 +0200
Subject: [PATCH 3/8] Fix symbol string corruption.

Fix symbol string corruption by using strdup to copy the symbol
string. Probably this leaks still. Add Objective-C code to
parse-float. REPL works now as expected :-D
---
 samples/metacircular.cljc | 7 ++++---
 src/c/runtime.c           | 2 +-
 src/cljc/cljc/core.cljc   | 8 ++++----
 3 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/samples/metacircular.cljc b/samples/metacircular.cljc
index f71b789..f7dfa21 100644
--- a/samples/metacircular.cljc
+++ b/samples/metacircular.cljc
@@ -32,7 +32,7 @@
 (defn lambda? [exp]
   (tagged-list? exp 'lambda))
 (defn lambda-parameters [exp] (cadr exp))
-(defn lambda-body [exp] (caddr exp)) ; was cddr
+(defn lambda-body [exp] (cddr exp)) ; was cddr
 
 (defn make-lambda [parameters body]
   (cons 'lambda (cons parameters body)))
@@ -79,7 +79,7 @@
   (cadr exp)) ; was cdr
 
 (defn application? [exp] (list? exp))
-(defn operator [exp] (println "exp: " exp " op:" (car exp)) (car exp))
+(defn operator [exp] (car exp))
 (defn operands [exp] (cdr exp))
 (defn no-operands? [ops] (empty? ops))
 (defn first-operand [ops] (car ops))
@@ -191,7 +191,6 @@
 (defn lookup-variable-value [var env]
   (defn env-loop [env]
     (defn scan [vars vals]
-      (println "comparing: " var " with " (car vars))
       (cond (empty? vars) (env-loop (enclosing-environment env))
             (= var (car vars)) (car vals)
             :else (scan (cdr vars) (cdr vals))))
@@ -350,3 +349,5 @@
 
 (defn -main [& args]
   (driver-loop))
+
+#_(define (reduce f init seq) (if (null? seq) init (reduce f (f init (car seq)) (cdr seq))))
diff --git a/src/c/runtime.c b/src/c/runtime.c
index 7cf7d95..22117c4 100644
--- a/src/c/runtime.c
+++ b/src/c/runtime.c
@@ -584,7 +584,7 @@ value_t* // was static symbol_t*
 make_symbol (const char *utf8)
 {
 	symbol_t *sym = (symbol_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Symbol), sizeof (symbol_t));
-	sym->utf8 = utf8;
+	sym->utf8 = strdup( utf8 );
 	return &sym->val;
 }
 
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 6b8b25c..248757d 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -6313,10 +6313,10 @@ reduces them without incurring seq initialization"
     (§ s :integerValue)
     (c* "make_integer (g_ascii_strtoll (string_get_utf8 (~{}), NULL, 10))" s)))
 
-  (defn- parse-float [s]
-    (if-objc
-     :TODO
-     (c* "make_float (strtod (string_get_utf8 (~{}), NULL ) )" s s (count s))))
+ (defn- parse-float [s]
+   (if-objc
+   (§ s :floatValue)
+    (c* "make_float (g_ascii_strtod (string_get_utf8 (~{}), NULL ) )" s)))
 
 
 

From 12c10eff57cae1affe21d5810d9e96503369ed54 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Sun, 15 Sep 2013 21:59:31 +0200
Subject: [PATCH 4/8] Fix regular expression literals.

This allows cljc.reader to read: #inst "2013-09-02T16:42:00.000-00:00",
but since we don't have a Date type yet it just emits a vector of the
respective fields as integers. Cleanups.
---
 src/clj/cljc/compiler.clj | 9 ++++++---
 src/cljc/cljc/core.cljc   | 7 +++++--
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/src/clj/cljc/compiler.clj b/src/clj/cljc/compiler.clj
index 242029f..1a8c047 100644
--- a/src/clj/cljc/compiler.clj
+++ b/src/clj/cljc/compiler.clj
@@ -334,8 +334,11 @@
 (defmethod emit-constant Boolean [x] (if x "value_true" "value_false"))
 
 (defmethod emit-constant java.util.regex.Pattern [x]
-  (emit-value-wrap :pattern-const nil (emits "pcre_pattern ( make_string (" (wrap-in-double-quotes (escape-string (str x))) "))"))
-  #_(FIXME-IMPLEMENT (str "Cannot emit java.util.regex.Pattern for constant " x " yet.")))
+
+  (emit-value-wrap :pattern-const
+                   nil
+                   (emits "FUNCALL1 ((closure_t*)VAR_NAME (cljc_DOT_core_SLASH_re_pattern), make_string ("
+                          (wrap-in-double-quotes (escape-string (str x))) "))")))
 
 (defmethod emit-constant clojure.lang.Keyword [x]
   (emit-value-wrap :keyword nil
@@ -1987,7 +1990,7 @@
 (comment
 
 ;;the new way - use the REPL!!
-(require '[cljs.compiler :as comp])
+(require '[cljc.compiler :as comp])
 (def repl-env (comp/repl-env))
 (comp/repl repl-env)
 ;having problems?, try verbose mode
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 248757d..88f64f5 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -94,6 +94,9 @@
 	  (recur (inc i) args))))
     a))
 
+(defn ^boolean array? [cand]
+  (has-type? cand Array))
+
 (defn make-array [size]
   (c* "make_array (integer_get (~{}))" size))
 
@@ -891,7 +894,7 @@ reduces them without incurring seq initialization"
                      (str ns "/" name)
                      name)]
        #_(Symbol. ns name sym-str nil nil)
-       (c* "make_symbol( string_get_utf8( make_string_copy( string_get_utf8 (~{}) ) ) )" sym-str))))
+       (c* "make_symbol( string_get_utf8( ~{}) )" sym-str))))
 
 
 (defn ^boolean number? [n]
@@ -6315,7 +6318,7 @@ reduces them without incurring seq initialization"
 
  (defn- parse-float [s]
    (if-objc
-   (§ s :floatValue)
+    (§ s :floatValue)
     (c* "make_float (g_ascii_strtod (string_get_utf8 (~{}), NULL ) )" s)))
 
 

From 1c50b4879593770a870ac11f5aaa2c228c73bd89 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Tue, 24 Sep 2013 06:52:46 +0200
Subject: [PATCH 5/8] Start to port analyzer.

- Port analyzer and make it accessible from the REPL. Add respective
runtime data primitives to cljc.core. Doesn't work yet, because
sample.metacircular building seems to depend on init_cljc_DOT_*
constructor order in driver.c, either the REGEX constants are not
properly initialized or the vtable of the methods is null (?).

- Port printing to new IPrintWithWriter protocol and move string
  conversion to str. Isolation of IPrintable protocol still TODO.

- Add UUID. Fix reading of sets and other '#' initialized objects.

- Make StringBuilder mutable and behave like in Java or JavaScript, not
returning a new StringBuilder on -append!. This makes code more easily
portable.

- Date type still missing as well as port of macro system removed for
  now.
---
 samples/metacircular.cljc   |    4 +-
 src/clj/cljc/core.clj       |   20 +-
 src/cljc/cljc/analyzer.cljc |  976 +++++++++++++++++++++++++++++
 src/cljc/cljc/core.cljc     | 1178 +++++++++++++++++++++++++++--------
 src/cljc/cljc/reader.cljc   |   22 +-
 5 files changed, 1935 insertions(+), 265 deletions(-)
 create mode 100644 src/cljc/cljc/analyzer.cljc

diff --git a/samples/metacircular.cljc b/samples/metacircular.cljc
index f7dfa21..08ad025 100644
--- a/samples/metacircular.cljc
+++ b/samples/metacircular.cljc
@@ -1,5 +1,6 @@
 (ns sample.metacircular
-  (:use [cljc.reader :only [read-string]]))
+  (:use [cljc.analyzer :only [analyze]]
+        [cljc.reader :only [read-string]]))
 
 ; WIP, reader not yet implemented in cljc
 ; otherwise works already, also in clojure
@@ -260,6 +261,7 @@
         (list '+ +)
         (list '* *)
         (list 'env print-env)
+        (list 'analyze #(analyze (cljc.analyzer/empty-env) %))
         (list 'eval #(seval % the-global-environment))
         (list 'apply #(sapply % the-global-environment))))
 
diff --git a/src/clj/cljc/core.clj b/src/clj/cljc/core.clj
index 5f98876..69465ae 100644
--- a/src/clj/cljc/core.clj
+++ b/src/clj/cljc/core.clj
@@ -52,6 +52,10 @@
 (defmacro false? [x]
   (bool-expr (list 'c* "(make_boolean (~{} == value_false))" x)))
 
+(defmacro undefined? [x]
+  ; TODO reasonable?
+  (bool-expr (list 'c* "(make_boolean ((void*)~{} == 0))" x)))
+
 (defmacro has-type? [val t]
   ;; FIXME: This is a horrible hack - it can't cope with user types
   ;; because they need to be resolved to get their namespaces.
@@ -461,7 +465,7 @@
 (defmacro *
   ([] 1)
   ([x] x)
-  ([x y] `(math-op * ~x ~y))  
+  ([x y] `(math-op * ~x ~y))
   ([x y & more] `(* (* ~x ~y) ~@more)))
 
 (defmacro number-as-float [n]
@@ -484,22 +488,22 @@
 
 (defmacro <
   ([x] true)
-  ([x y] (bool-expr `(math-op-as-bool < ~x ~y)))  
+  ([x y] (bool-expr `(math-op-as-bool < ~x ~y)))
   ([x y & more] `(and (< ~x ~y) (< ~y ~@more))))
 
 (defmacro >
   ([x] true)
-  ([x y] (bool-expr `(math-op-as-bool > ~x ~y)))  
+  ([x y] (bool-expr `(math-op-as-bool > ~x ~y)))
   ([x y & more] `(and (> ~x ~y) (> ~y ~@more))))
 
 (defmacro <=
   ([x] true)
-  ([x y] (bool-expr `(math-op-as-bool <= ~x ~y)))  
+  ([x y] (bool-expr `(math-op-as-bool <= ~x ~y)))
   ([x y & more] `(and (<= ~x ~y) (<= ~y ~@more))))
 
 (defmacro >=
   ([x] true)
-  ([x y] (bool-expr `(math-op-as-bool >= ~x ~y)))  
+  ([x y] (bool-expr `(math-op-as-bool >= ~x ~y)))
   ([x y & more] `(and (>= ~x ~y) (>= ~y ~@more))))
 
 (defmacro mod [num div]
@@ -689,8 +693,8 @@
 
 (defmacro amap
   "Maps an expression across an array a, using an index named idx, and
-  return value named ret, initialized to a clone of a, then setting 
-  each element of ret to the evaluation of expr, returning the new 
+  return value named ret, initialized to a clone of a, then setting
+  each element of ret to the evaluation of expr, returning the new
   array ret."
   [a idx ret expr]
   `(let [a# ~a
@@ -704,7 +708,7 @@
 
 (defmacro areduce
   "Reduces an expression across an array a, using an index named idx,
-  and return value named ret, initialized to init, setting ret to the 
+  and return value named ret, initialized to init, setting ret to the
   evaluation of expr at each step, returning ret."
   [a idx ret init expr]
   `(let [a# ~a]
diff --git a/src/cljc/cljc/analyzer.cljc b/src/cljc/cljc/analyzer.cljc
new file mode 100644
index 0000000..504e1a0
--- /dev/null
+++ b/src/cljc/cljc/analyzer.cljc
@@ -0,0 +1,976 @@
+;   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.
+
+;; (set! *warn-on-reflection* true)
+
+(ns cljc.analyzer
+  (:refer-clojure :exclude [macroexpand-1])
+  (:require ;; [clojure.java.io :as io]
+            [cljc.string :as string]
+            [cljc.reader :as reader]
+            ;;[cljc.tagged-literals :as tags]
+            )
+  ; TODO port and disable identity mapping
+  ;;(:use-macros [cljc.analyzer-macros :only [disallowing-recur]])
+  ;;(:import java.lang.StringBuilder)
+  )
+
+(def disallowing-recur identity)
+
+(declare resolve-var)
+(declare resolve-existing-var)
+(declare warning)
+(def ^:dynamic *cljc-warn-on-undeclared* false)
+(declare confirm-bindings)
+(declare ^:dynamic *cljc-file*)
+
+;; to resolve keywords like ::foo when *ns-sym* isn't set (i.e. when
+;; not at the REPL) - the namespace must be determined during analysis
+;; because the reader did not know
+(def ^:dynamic *reader-ns-name* (gensym))
+
+;; "refer" it from somewhere that it will exist from the start
+(def namespaces cljc.core/namespaces)
+
+(def ^:dynamic *cljc-ns* 'cljc.user)
+(def ^:dynamic *cljc-file* nil)
+(def ^:dynamic *cljc-warn-on-redef* true)
+(def ^:dynamic *cljc-warn-on-dynamic* true)
+(def ^:dynamic *cljc-warn-on-fn-var* true)
+(def ^:dynamic *cljc-warn-fn-arity* true)
+(def ^:dynamic *cljc-warn-fn-deprecated* true)
+(def ^:dynamic *cljc-warn-protocol-deprecated* true)
+(def ^:dynamic *unchecked-if* (atom false))
+(def ^:dynamic *cljc-static-fns* false)
+(def ^:dynamic *cljc-macros-path* "/cljc/core")
+(def ^:dynamic *cljc-macros-is-classpath* false) ; TODO was true
+(def  -cljc-macros-loaded (atom false))
+
+(defn load-core []
+  (when (not @-cljc-macros-loaded)
+    (reset! -cljc-macros-loaded true)
+    (if *cljc-macros-is-classpath*
+      nil #_(load *cljc-macros-path*)
+      (load-file *cljc-macros-path*))))
+
+;;(defmacro with-core-macros
+;;  [path & body]
+;;  `(do
+;;     (when (not= *cljc-macros-path* ~path)
+;;       (reset! -cljs-macros-loaded false))
+;;     (binding [*cljs-macros-path* ~path]
+;;       ~@body)))
+;;
+;;(defmacro with-core-macros-file
+;;  [path & body]
+;;  `(do
+;;     (when (not= *cljs-macros-path* ~path)
+;;       (reset! -cljs-macros-loaded false))
+;;     (binding [*cljs-macros-path* ~path
+;;               *cljs-macros-is-classpath* false]
+;;       ~@body)))
+
+(defn empty-env []
+  {:ns (@namespaces *cljc-ns*) :context :statement :locals {}})
+
+;;(defmacro ^:private debug-prn
+;;  [& args]
+;;  `(.println System/err (str ~@args)))
+
+(defn warning [env s]
+; (binding [*out* *err*]
+    (println
+     (str s (when (:line env)
+              (str " at line " (:line env) " " *cljc-file*)))))
+;)
+
+(defn confirm-var-exists [env prefix suffix]
+  (when *cljc-warn-on-undeclared*
+    (let [crnt-ns (-> env :ns :name)]
+      (when (= prefix crnt-ns)
+        (when-not (-> @namespaces crnt-ns :defs suffix)
+          (warning env
+            (str "WARNING: Use of undeclared Var " prefix "/" suffix)))))))
+
+(defn resolve-ns-alias [env name]
+  (let [sym (symbol name)]
+    (get (:requires (:ns env)) sym sym)))
+
+(defn core-name?
+  "Is sym visible from core in the current compilation namespace?"
+  [env sym]
+  (and (get (:defs (@namespaces 'cljc.core)) sym)
+       (not (contains? (-> env :ns :excludes) sym))))
+
+(defn resolve-existing-var [env sym]
+  (if (= (namespace sym) "js")
+    {:name sym :ns 'js}
+    (let [s (str sym)
+          lb (-> env :locals sym)]
+      (cond
+       lb lb
+
+       (namespace sym)
+       (let [ns (namespace sym)
+             ns (if (= "clojure.core" ns) "cljc.core" ns)
+             full-ns (resolve-ns-alias env ns)]
+         (confirm-var-exists env full-ns (symbol (name sym)))
+         (merge (get-in @namespaces [full-ns :defs (symbol (name sym))])
+           {:name (symbol (str full-ns) (str (name sym)))
+            :ns full-ns}))
+
+       (and (not= ".." s) (>= (string/index-of s ".") 0))
+       (let [idx (string/index-of s ".")
+             prefix (symbol (subs s 0 idx))
+             suffix (subs s (inc idx))
+             lb (-> env :locals prefix)]
+         (if lb
+           {:name (symbol (str (:name lb) suffix))}
+           (do
+             (confirm-var-exists env prefix (symbol suffix))
+             (merge (get-in @namespaces [prefix :defs (symbol suffix)])
+              {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix))
+               :ns prefix}))))
+
+       (get-in @namespaces [(-> env :ns :name) :uses sym])
+       (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
+         (merge
+          (get-in @namespaces [full-ns :defs sym])
+          {:name (symbol (str full-ns) (str sym))
+           :ns (-> env :ns :name)}))
+
+       (get-in @namespaces [(-> env :ns :name) :imports sym])
+       (recur env (get-in @namespaces [(-> env :ns :name) :imports sym]))
+
+       :else
+       (let [full-ns (if (core-name? env sym)
+                       'cljc.core
+                       (-> env :ns :name))]
+         (confirm-var-exists env full-ns sym)
+         (merge (get-in @namespaces [full-ns :defs sym])
+           {:name (symbol (str full-ns) (str sym))
+            :ns full-ns}))))))
+
+(defn resolve-var [env sym]
+  (if (= (namespace sym) "js")
+    {:name sym}
+    (let [s (str sym)
+          lb (-> env :locals sym)]
+      (cond
+       lb lb
+
+       (namespace sym)
+       (let [ns (namespace sym)
+             ns (if (= "clojure.core" ns) "cljc.core" ns)]
+         {:name (symbol (str (resolve-ns-alias env ns)) (name sym))})
+
+       (and (not= ".." s) (>= (string/index-of s ".") 0))
+       (let [idx (string/index-of s ".")
+             prefix (symbol (subs s 0 idx))
+             suffix (subs s idx)
+             lb (-> env :locals prefix)]
+         (if lb
+           {:name (symbol (str (:name lb) suffix))}
+           {:name sym}))
+
+       (get-in @namespaces [(-> env :ns :name) :uses sym])
+       (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])]
+         (merge
+          (get-in @namespaces [full-ns :defs sym])
+          {:name (symbol (str full-ns) (name sym))}))
+
+       (get-in @namespaces [(-> env :ns :name) :imports sym])
+       (recur env (get-in @namespaces [(-> env :ns :name) :imports sym]))
+
+       :else
+       (let [ns (if (core-name? env sym)
+                  'cljc.core
+                  (-> env :ns :name))]
+         {:name (symbol (str ns) (name sym))})))))
+
+(defn confirm-bindings [env names]
+  (doseq [name names]
+    (let [env (merge env {:ns (@namespaces *cljc-ns*)})
+          ev (resolve-existing-var env name)]
+      (when (and *cljc-warn-on-dynamic*
+                 ev (not (-> ev :dynamic)))
+        (warning env
+          (str "WARNING: " (:name ev) " not declared ^:dynamic"))))))
+
+(declare analyze analyze-symbol analyze-seq)
+
+(def specials '#{if def fn* do let* loop* letfn* throw try* recur new set! ns deftype* defrecord* . js* & quote})
+
+(def ^:dynamic *recur-frames* nil)
+(def ^:dynamic *loop-lets* nil)
+
+;;(defmacro disallowing-recur [& body]
+;;  `(binding [*recur-frames* (cons nil *recur-frames*)] ~@body))
+
+(defn analyze-keyword
+    [env sym]
+    ;; When not at the REPL, *ns-sym* is not set so the reader did not
+    ;; know the namespace of the keyword
+    {:op :constant :env env
+     :form (if (= (namespace sym) (name *reader-ns-name*))
+               (keyword (-> env :ns :name name) (name sym))
+               sym)})
+
+(defn analyze-block
+  "returns {:statements .. :ret ..}"
+  [env exprs]
+  (let [statements (disallowing-recur
+                     (seq (map #(analyze (assoc env :context :statement) %) (butlast exprs))))
+        ret (if (<= (count exprs) 1)
+              (analyze env (first exprs))
+              (analyze (assoc env :context (if (= :statement (:context env)) :statement :return)) (last exprs)))]
+    {:statements statements :ret ret}))
+
+(defmulti parse (fn [op & rest] op))
+
+(defmethod parse 'if
+  [op env [_ test then else :as form] name]
+  (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
+        then-expr (analyze env then)
+        else-expr (analyze env else)]
+    {:env env :op :if :form form
+     :test test-expr :then then-expr :else else-expr
+     :unchecked @*unchecked-if*
+     :children [test-expr then-expr else-expr]}))
+
+(defmethod parse 'throw
+  [op env [_ throw :as form] name]
+  (let [throw-expr (disallowing-recur (analyze (assoc env :context :expr) throw))]
+    {:env env :op :throw :form form
+     :throw throw-expr
+     :children [throw-expr]}))
+
+(defn- block-children [{:keys [statements ret] :as block}]
+  (when block (conj (vec statements) ret)))
+
+(defmethod parse 'try*
+  [op env [_ & body :as form] name]
+  (let [body (vec body)
+        catchenv (update-in env [:context] #(if (= :expr %) :return %))
+        tail (peek body)
+        fblock (when (and (seq? tail) (= 'finally (first tail)))
+                  (rest tail))
+        finally (when fblock
+                  (analyze-block
+                   (assoc env :context :statement)
+                   fblock))
+        body (if finally (pop body) body)
+        tail (peek body)
+        cblock (when (and (seq? tail)
+                          (= 'catch (first tail)))
+                 (rest tail))
+        name (first cblock)
+        locals (:locals catchenv)
+        locals (if name
+                 (assoc locals name {:name name})
+                 locals)
+        catch (when cblock
+                (analyze-block (assoc catchenv :locals locals) (rest cblock)))
+        body (if name (pop body) body)
+        try (when body
+              (analyze-block (if (or name finally) catchenv env) body))]
+    (when name (assert (not (namespace name)) "Can't qualify symbol in catch"))
+    {:env env :op :try* :form form
+     :try try
+     :finally finally
+     :name name
+     :catch catch
+     :children (vec (mapcat block-children
+                            [try catch finally]))}))
+
+(defmethod parse 'def
+  [op env form name]
+  (let [pfn (fn
+              ([_ sym] {:sym sym})
+              ([_ sym init] {:sym sym :init init})
+              ([_ sym doc init] {:sym sym :doc doc :init init}))
+        args (apply pfn form)
+        sym (:sym args)
+        sym-meta (meta sym)
+        tag (-> sym meta :tag)
+        protocol (-> sym meta :protocol)
+        dynamic (-> sym meta :dynamic)
+        ns-name (-> env :ns :name)]
+    (assert (not (namespace sym)) "Can't def ns-qualified name")
+    (let [env (if (or (and (not= ns-name 'cljc.core)
+                           (core-name? env sym))
+                      (get-in @namespaces [ns-name :uses sym]))
+                (let [ev (resolve-existing-var (dissoc env :locals) sym)]
+                  (when *cljc-warn-on-redef*
+                    (warning env
+                      (str "WARNING: " sym " already refers to: " (symbol (str (:ns ev)) (str sym))
+                           " being replaced by: " (symbol (str ns-name) (str sym)))))
+                  (swap! namespaces update-in [ns-name :excludes] conj sym)
+                  (update-in env [:ns :excludes] conj sym))
+                env)
+          name (:name (resolve-var (dissoc env :locals) sym))
+          init-expr (when (contains? args :init)
+                      (disallowing-recur
+                       (analyze (assoc env :context :expr) (:init args) sym)))
+          fn-var? (and init-expr (= (:op init-expr) :fn))
+          export-as (when-let [export-val (-> sym meta :export)]
+                      (if (= true export-val) name export-val))
+          doc (or (:doc args) (-> sym meta :doc))]
+      (when-let [v (get-in @namespaces [ns-name :defs sym])]
+        (when (and *cljc-warn-on-fn-var*
+                   (not (-> sym meta :declared))
+                   (and (:fn-var v) (not fn-var?)))
+          (warning env
+            (str "WARNING: " (symbol (str ns-name) (str sym))
+                 " no longer fn, references are stale"))))
+      (swap! namespaces assoc-in [ns-name :defs sym]
+                 (merge
+                   {:name name}
+                   sym-meta
+                   (when doc {:doc doc})
+                   (when dynamic {:dynamic true})
+                   (when-let [line (:line env)]
+                     {:file *cljc-file* :line line})
+                   ;; the protocol a protocol fn belongs to
+                   (when protocol
+                     {:protocol protocol})
+                   ;; symbol for reified protocol
+                   (when-let [protocol-symbol (-> sym meta :protocol-symbol)]
+                     {:protocol-symbol protocol-symbol})
+                   (when fn-var?
+                     {:fn-var true
+                      ;; protocol implementation context
+                      :protocol-impl (:protocol-impl init-expr)
+                      ;; inline protocol implementation context
+                      :protocol-inline (:protocol-inline init-expr)
+                      :variadic (:variadic init-expr)
+                      :max-fixed-arity (:max-fixed-arity init-expr)
+                      :method-params (map :params (:methods init-expr))})))
+      (merge {:env env :op :def :form form
+              :name name :doc doc :init init-expr}
+             (when tag {:tag tag})
+             (when dynamic {:dynamic true})
+             (when export-as {:export export-as})
+             (when init-expr {:children [init-expr]})))))
+
+(defn- analyze-fn-method [env locals form type]
+  (let [param-names (first form)
+        variadic (boolean (some '#{&} param-names))
+        param-names (vec (remove '#{&} param-names))
+        body (next form)
+        [locals params] (reduce (fn [[locals params] name]
+                                  (let [param {:name name
+                                               :tag (-> name meta :tag)
+                                               :shadow (locals name)}]
+                                    [(assoc locals name param) (conj params param)]))
+                                [locals []] param-names)
+        fixed-arity (count (if variadic (butlast params) params))
+        recur-frame {:params params :flag (atom nil)}
+        block (binding [*recur-frames* (cons recur-frame *recur-frames*)]
+                (analyze-block (assoc env :context :return :locals locals) body))]
+    (merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity
+            :type type :form form :recurs @(:flag recur-frame)}
+           block)))
+
+(defmethod parse 'fn*
+  [op env [_ & args :as form] name]
+  (let [[name meths] (if (symbol? (first args))
+                       [(first args) (next args)]
+                       [name (seq args)])
+        ;;turn (fn [] ...) into (fn ([]...))
+        meths (if (vector? (first meths)) (list meths) meths)
+        locals (:locals env)
+        locals (if name (assoc locals name {:name name :shadow (locals name)}) locals)
+        type (-> form meta ::type)
+        fields (-> form meta ::fields)
+        protocol-impl (-> form meta :protocol-impl)
+        protocol-inline (-> form meta :protocol-inline)
+        locals (reduce (fn [m fld]
+                         (assoc m fld
+                                {:name fld
+                                 :field true
+                                 :mutable (-> fld meta :mutable)
+                                 :tag (-> fld meta :tag)
+                                 :shadow (m fld)}))
+                       locals fields)
+
+        menv (if (> (count meths) 1) (assoc env :context :expr) env)
+        menv (merge menv
+               {:protocol-impl protocol-impl
+                :protocol-inline protocol-inline})
+        methods (map #(analyze-fn-method menv locals % type) meths)
+        max-fixed-arity (apply max (map :max-fixed-arity methods))
+        variadic (boolean (some :variadic methods))
+        locals (if name
+                 (update-in locals [name] assoc
+                            :fn-var true
+                            :variadic variadic
+                            :max-fixed-arity max-fixed-arity
+                            :method-params (map :params methods))
+                 locals)
+        methods (if name
+                  ;; a second pass with knowledge of our function-ness/arity
+                  ;; lets us optimize self calls
+                  (map #(analyze-fn-method menv locals % type) meths)
+                  methods)]
+    ;;todo - validate unique arities, at most one variadic, variadic takes max required args
+    {:env env :op :fn :form form :name name :methods methods :variadic variadic
+     :recur-frames *recur-frames* :loop-lets *loop-lets*
+     :jsdoc [(when variadic "@param {...*} var_args")]
+     :max-fixed-arity max-fixed-arity
+     :protocol-impl protocol-impl
+     :protocol-inline protocol-inline
+     :children (vec (mapcat block-children
+                            methods))}))
+
+(defmethod parse 'letfn*
+  [op env [_ bindings & exprs :as form] name]
+  (assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
+  (let [n->fexpr (into {} (map (juxt first second) (partition 2 bindings)))
+        names    (keys n->fexpr)
+        context  (:context env)
+        [meth-env bes]
+        (reduce (fn [[{:keys [locals] :as env} bes] n]
+                  (let [be {:name   n
+                            :tag    (-> n meta :tag)
+                            :local  true
+                            :shadow (locals n)}]
+                    [(assoc-in env [:locals n] be)
+                     (conj bes be)]))
+                [env []] names)
+        meth-env (assoc meth-env :context :expr)
+        bes (vec (map (fn [{:keys [name shadow] :as be}]
+                        (let [env (assoc-in meth-env [:locals name] shadow)]
+                          (assoc be :init (analyze env (n->fexpr name)))))
+                      bes))
+        {:keys [statements ret]}
+        (analyze-block (assoc meth-env :context (if (= :expr context) :return context)) exprs)]
+    {:env env :op :letfn :bindings bes :statements statements :ret ret :form form
+     :children (into (vec (map :init bes))
+                     (conj (vec statements) ret))}))
+
+(defmethod parse 'do
+  [op env [_ & exprs :as form] _]
+  (let [block (analyze-block env exprs)]
+    (merge {:env env :op :do :form form :children (block-children block)} block)))
+
+(defn analyze-let
+  [encl-env [_ bindings & exprs :as form] is-loop]
+  (assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements")
+  (let [context (:context encl-env)
+        [bes env]
+        (disallowing-recur
+         (loop [bes []
+                env (assoc encl-env :context :expr)
+                bindings (seq (partition 2 bindings))]
+           (if-let [[name init] (first bindings)]
+             (do
+               (assert (not (or (namespace name) (>= (string/index-of (str name) ".") 0))) (str "Invalid local name: " name))
+               (let [init-expr (analyze env init)
+                     be {:name name
+                         :init init-expr
+                         :tag (or (-> name meta :tag)
+                                  (-> init-expr :tag)
+                                  (-> init-expr :info :tag))
+                         :local true
+                         :shadow (-> env :locals name)}
+                     be (if (= (:op init-expr) :fn)
+                          (merge be
+                            {:fn-var true
+                             :variadic (:variadic init-expr)
+                             :max-fixed-arity (:max-fixed-arity init-expr)
+                             :method-params (map :params (:methods init-expr))})
+                          be)]
+                 (recur (conj bes be)
+                        (assoc-in env [:locals name] be)
+                        (next bindings))))
+             [bes env])))
+        recur-frame (when is-loop {:params bes :flag (atom nil)})
+        {:keys [statements ret]}
+        (binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)
+                  *loop-lets* (cond
+                               is-loop (or *loop-lets* ())
+                               *loop-lets* (cons {:params bes} *loop-lets*))]
+          (analyze-block (assoc env :context (if (= :expr context) :return context)) exprs))]
+    {:env encl-env :op :let :loop is-loop
+     :bindings bes :statements statements :ret ret :form form
+     :children (into (vec (map :init bes))
+                     (conj (vec statements) ret))}))
+
+(defmethod parse 'let*
+  [op encl-env form _]
+  (analyze-let encl-env form false))
+
+(defmethod parse 'loop*
+  [op encl-env form _]
+  (analyze-let encl-env form true))
+
+(defmethod parse 'recur
+  [op env [_ & exprs :as form] _]
+  (let [context (:context env)
+        frame (first *recur-frames*)
+        exprs (disallowing-recur (vec (map #(analyze (assoc env :context :expr) %) exprs)))]
+    (assert frame "Can't recur here")
+    (assert (= (count exprs) (count (:params frame))) "recur argument count mismatch")
+    (reset! (:flag frame) true)
+    (assoc {:env env :op :recur :form form}
+      :frame frame
+      :exprs exprs
+      :children exprs)))
+
+(defmethod parse 'quote
+  [_ env [_ x] _]
+  {:op :constant :env env :form x})
+
+(defmethod parse 'new
+  [_ env [_ ctor & args :as form] _]
+  (assert (symbol? ctor) "First arg to new must be a symbol")
+  (disallowing-recur
+   (let [enve (assoc env :context :expr)
+         ctorexpr (analyze enve ctor)
+         argexprs (vec (map #(analyze enve %) args))
+         known-num-fields (:num-fields (resolve-existing-var env ctor))
+         argc (count args)]
+     (when (and known-num-fields (not= known-num-fields argc))
+       (warning env
+         (str "WARNING: Wrong number of args (" argc ") passed to " ctor)))
+
+     {:env env :op :new :form form :ctor ctorexpr :args argexprs
+      :children (into [ctorexpr] argexprs)})))
+
+(defmethod parse 'set!
+  [_ env [_ target val alt :as form] _]
+  (let [[target val] (if alt
+                       ;; (set! o -prop val)
+                       [`(. ~target ~val) alt]
+                       [target val])]
+    (disallowing-recur
+     (let [enve (assoc env :context :expr)
+           targetexpr (cond
+                       ;; TODO: proper resolve
+                       (= target '*unchecked-if*)
+                       (do
+                         (reset! *unchecked-if* val)
+                         ::set-unchecked-if)
+
+                       (symbol? target)
+                       (do
+                         (let [local (-> env :locals target)]
+                           (assert (or (nil? local)
+                                       (and (:field local)
+                                            (:mutable local)))
+                                   "Can't set! local var or non-mutable field"))
+                         (analyze-symbol enve target))
+
+                       :else
+                       (when (seq? target)
+                         (let [targetexpr (analyze-seq enve target nil)]
+                           (when (:field targetexpr)
+                             targetexpr))))
+           valexpr (analyze enve val)]
+       (assert targetexpr "set! target must be a field or a symbol naming a var")
+       (cond
+        (= targetexpr ::set-unchecked-if) {:env env :op :no-op}
+        :else {:env env :op :set! :form form :target targetexpr :val valexpr
+               :children [targetexpr valexpr]})))))
+
+(defn munge-path [ss]
+  #_(clojure.lang.Compiler/munge (str ss)))
+
+(defn ns->relpath [s]
+  (str (string/replace (munge-path s) \. \/) ".cljc"))
+
+(declare analyze-file)
+
+;; (defn analyze-deps [deps]
+;;   (doseq [dep deps]
+;;     (when-not (:defs (@namespaces dep))
+;;       (let [relpath (ns->relpath dep)]
+;;         (when (io/resource relpath)
+;;           (analyze-file relpath))))))
+
+(defmethod parse 'ns
+  [_ env [_ name & args :as form] _]
+  (let [docstring (if (string? (first args)) (first args) nil)
+        args      (if docstring (next args) args)
+        excludes
+        (reduce (fn [s [k exclude xs]]
+                  (if (= k :refer-clojure)
+                    (do
+                      (assert (= exclude :exclude) "Only [:refer-clojure :exclude (names)] form supported")
+                      (assert (not (seq s)) "Only one :refer-clojure form is allowed per namespace definition")
+                      (into s xs))
+                    s))
+                #{} args)
+        deps (atom #{})
+        valid-forms (atom #{:use :use-macros :require :require-macros :import})
+        error-msg (fn [spec msg] (str msg "; offending spec: " (pr-str spec)))
+        parse-require-spec (fn parse-require-spec [macros? spec]
+                             (assert (or (symbol? spec) (vector? spec))
+                                     (error-msg spec "Only [lib.ns & options] and lib.ns specs supported in :require / :require-macros"))
+                             (when (vector? spec)
+                               (assert (symbol? (first spec))
+                                       (error-msg spec "Library name must be specified as a symbol in :require / :require-macros"))
+                               (assert (odd? (count spec))
+                                       (error-msg spec "Only :as alias and :refer (names) options supported in :require"))
+                               (assert (every? #{:as :refer} (map first (partition 2 (next spec))))
+                                       (error-msg spec "Only :as and :refer options supported in :require / :require-macros"))
+                               (assert (let [fs (frequencies (next spec))]
+                                         (and (<= (fs :as 0) 1)
+                                              (<= (fs :refer 0) 1)))
+                                       (error-msg spec "Each of :as and :refer options may only be specified once in :require / :require-macros")))
+                             (if (symbol? spec)
+                               (recur macros? [spec])
+                               (let [[lib & opts] spec
+                                     {alias :as referred :refer :or {alias lib}} (apply hash-map opts)
+                                     [rk uk] (if macros? [:require-macros :use-macros] [:require :use])]
+                                 (assert (or (symbol? alias) (nil? alias))
+                                         (error-msg spec ":as must be followed by a symbol in :require / :require-macros"))
+                                 (assert (or (and (sequential? referred) (every? symbol? referred))
+                                             (nil? referred))
+                                         (error-msg spec ":refer must be followed by a sequence of symbols in :require / :require-macros"))
+                                 (when-not macros?
+                                   (swap! deps conj lib))
+                                 (merge (when alias {rk {alias lib}})
+                                        (when referred {uk (apply hash-map (interleave referred (repeat lib)))})))))
+        use->require (fn use->require [[lib kw referred :as spec]]
+                       (assert (and (symbol? lib) (= :only kw) (sequential? referred) (every? symbol? referred))
+                               (error-msg spec "Only [lib.ns :only (names)] specs supported in :use / :use-macros"))
+                       [lib :refer referred])
+        parse-import-spec (fn parse-import-spec [spec]
+                            (assert (and (symbol? spec) (nil? (namespace spec)))
+                                    (error-msg spec "Only lib.Ctor specs supported in :import"))
+                            (swap! deps conj spec)
+                            (let [ctor-sym (symbol (last (string/split (str spec) #"\.")))]
+                              {:import  {ctor-sym spec}
+                               :require {ctor-sym spec}}))
+        spec-parsers {:require        (partial parse-require-spec false)
+                      :require-macros (partial parse-require-spec true)
+                      :use            (comp (partial parse-require-spec false) use->require)
+                      :use-macros     (comp (partial parse-require-spec true) use->require)
+                      :import         parse-import-spec}
+        {uses :use requires :require uses-macros :use-macros requires-macros :require-macros imports :import :as params}
+        (reduce (fn [m [k & libs]]
+                  (assert (#{:use :use-macros :require :require-macros :import} k)
+                          "Only :refer-clojure, :require, :require-macros, :use and :use-macros libspecs supported")
+                  (assert (@valid-forms k)
+                          (str "Only one " k " form is allowed per namespace definition"))
+                  (swap! valid-forms disj k)
+                  (apply merge-with merge m (map (spec-parsers k) libs)))
+                {} (remove (fn [[r]] (= r :refer-clojure)) args))]
+    (when (seq @deps)
+      ;; (analyze-deps @deps)
+      (println "// **** Skipping analyze-deps ****")
+      )
+    (set! *cljc-ns* name)
+    (set! cljc.core/*ns-sym* name)
+    ;;(load-core)
+    (doseq [nsym (concat (vals requires-macros) (vals uses-macros))]
+      (cljc.core/require nsym))
+    (swap! namespaces #(-> %
+                           (assoc-in [name :name] name)
+                           (assoc-in [name :doc] docstring)
+                           (assoc-in [name :excludes] excludes)
+                           (assoc-in [name :uses] uses)
+                           (assoc-in [name :requires] requires)
+                           (assoc-in [name :uses-macros] uses-macros)
+                           (assoc-in [name :requires-macros]
+                                     (into {} (map (fn [[alias nsym]]
+                                                     [alias (find-ns nsym)])
+                                                   requires-macros)))
+                           (assoc-in [name :imports] imports)))
+    {:env env :op :ns :form form :name name :doc docstring :uses uses :requires requires :imports imports
+     :uses-macros uses-macros :requires-macros requires-macros :excludes excludes}))
+
+(defmethod parse 'deftype*
+  [_ env [_ tsym fields pmasks :as form] _]
+  (let [t (:name (resolve-var (dissoc env :locals) tsym))]
+    (swap! namespaces update-in [(-> env :ns :name) :defs tsym]
+           (fn [m]
+             (let [m (assoc (or m {})
+                       :name t
+                       :type true
+                       :num-fields (count fields))]
+               (merge m
+                 {:protocols (-> tsym meta :protocols)}
+                 (when-let [line (:line env)]
+                   {:file *cljc-file*
+                    :line line})))))
+    {:env env :op :deftype* :form form :t t :fields fields :pmasks pmasks}))
+
+(defmethod parse 'defrecord*
+  [_ env [_ tsym fields pmasks :as form] _]
+  (let [t (:name (resolve-var (dissoc env :locals) tsym))]
+    (swap! namespaces update-in [(-> env :ns :name) :defs tsym]
+           (fn [m]
+             (let [m (assoc (or m {}) :name t :type true)]
+               (merge m
+                 {:protocols (-> tsym meta :protocols)}
+                 (when-let [line (:line env)]
+                   {:file *cljc-file*
+                    :line line})))))
+    {:env env :op :defrecord* :form form :t t :fields fields :pmasks pmasks}))
+
+;; dot accessor code
+
+(def ^:private property-symbol? #(boolean (and (symbol? %) (re-matches #"^-.*" (name %)))))
+
+(defn- classify-dot-form
+  [[target member args]]
+  [(cond (nil? target) ::error
+         :default      ::expr)
+   (cond (property-symbol? member) ::property
+         (symbol? member)          ::symbol
+         (seq? member)             ::list
+         :default                  ::error)
+   (cond (nil? args) ()
+         :default    ::expr)])
+
+(defmulti build-dot-form #(classify-dot-form %))
+
+;; (. o -p)
+;; (. (...) -p)
+(defmethod build-dot-form [::expr ::property ()]
+  [[target prop _]]
+  {:dot-action ::access :target target :field (-> prop name (subs 1) symbol)})
+
+;; (. o -p <args>)
+(defmethod build-dot-form [::expr ::property ::list]
+  [[target prop args]]
+  (throw (Exception. (str "Cannot provide arguments " args " on property access " prop))))
+
+(defn- build-method-call
+  "Builds the intermediate method call map used to reason about the parsed form during
+  compilation."
+  [target meth args]
+  (if (symbol? meth)
+    {:dot-action ::call :target target :method meth :args args}
+    {:dot-action ::call :target target :method (first meth) :args args}))
+
+;; (. o m 1 2)
+(defmethod build-dot-form [::expr ::symbol ::expr]
+  [[target meth args]]
+  (build-method-call target meth args))
+
+;; (. o m)
+(defmethod build-dot-form [::expr ::symbol ()]
+  [[target meth args]]
+  (build-method-call target meth args))
+
+;; (. o (m))
+;; (. o (m 1 2))
+(defmethod build-dot-form [::expr ::list ()]
+  [[target meth-expr _]]
+  (build-method-call target (first meth-expr) (rest meth-expr)))
+
+(defmethod build-dot-form :default
+  [dot-form]
+  (throw (Exception. (str "Unknown dot form of " (list* '. dot-form) " with classification " (classify-dot-form dot-form)))))
+
+(defmethod parse '.
+  [_ env [_ target & [field & member+] :as form] _]
+  (disallowing-recur
+   (let [{:keys [dot-action target method field args]} (build-dot-form [target field member+])
+         enve        (assoc env :context :expr)
+         targetexpr  (analyze enve target)]
+     (case dot-action
+           ::access {:env env :op :dot :form form
+                     :target targetexpr
+                     :field field
+                     :children [targetexpr]
+                     :tag (-> form meta :tag)}
+           ::call   (let [argexprs (map #(analyze enve %) args)]
+                      {:env env :op :dot :form form
+                       :target targetexpr
+                       :method method
+                       :args argexprs
+                       :children (into [targetexpr] argexprs)
+                       :tag (-> form meta :tag)})))))
+
+(defmethod parse 'js*
+  [op env [_ jsform & args :as form] _]
+  (assert (string? jsform))
+  (if args
+    (disallowing-recur
+     (let [seg (fn seg [^String s]
+                 (let [idx (string/index-of s "~{")]
+                   (if (= -1 idx)
+                     (list s)
+                     (let [end (string/index-of s "}" idx)]
+                       (cons (subs s 0 idx) (seg (subs s (inc end))))))))
+           enve (assoc env :context :expr)
+           argexprs (vec (map #(analyze enve %) args))]
+       {:env env :op :js :segs (seg jsform) :args argexprs
+        :tag (-> form meta :tag) :form form :children argexprs}))
+    (let [interp (fn interp [^String s]
+                   (let [idx (string/index-of s "~{")]
+                     (if (= -1 idx)
+                       (list s)
+                       (let [end (string/index-of s "}" idx)
+                             inner (:name (resolve-existing-var env (symbol (subs s (+ 2 idx) end))))]
+                         (cons (subs s 0 idx) (cons inner (interp (subs s (inc end)))))))))]
+      {:env env :op :js :form form :code (apply str (interp jsform))
+       :tag (-> form meta :tag)})))
+
+(defn parse-invoke
+  [env [f & args :as form]]
+  (disallowing-recur
+   (let [enve (assoc env :context :expr)
+         fexpr (analyze enve f)
+         argexprs (vec (map #(analyze enve %) args))
+         argc (count args)]
+     (if (and *cljc-warn-fn-arity* (-> fexpr :info :fn-var))
+       (let [{:keys [variadic max-fixed-arity method-params name]} (:info fexpr)]
+         (when (and (not (some #{argc} (map count method-params)))
+                    (or (not variadic)
+                        (and variadic (< argc max-fixed-arity))))
+           (warning env
+             (str "WARNING: Wrong number of args (" argc ") passed to " name)))))
+     (if (and *cljc-warn-fn-deprecated* (-> fexpr :info :deprecated)
+              (not (-> form meta :deprecation-nowarn)))
+       (warning env
+         (str "WARNING: " (-> fexpr :info :name) " is deprecated.")))
+     {:env env :op :invoke :form form :f fexpr :args argexprs
+      :tag (or (-> fexpr :info :tag) (-> form meta :tag)) :children (into [fexpr] argexprs)})))
+
+(defn analyze-symbol
+  "Finds the var associated with sym"
+  [env sym]
+  (let [ret {:env env :form sym}
+        lb (-> env :locals sym)]
+    (if lb
+      (assoc ret :op :var :info lb)
+      (assoc ret :op :var :info (resolve-existing-var env sym)))))
+
+
+;; implicit dependency on cljc.compiler
+(defn get-expander [sym env]
+  (let [mvar
+        (when-not (or (-> env :locals sym)        ;locals hide macros
+                      (and (or (-> env :ns :excludes sym)
+                               (get-in @namespaces [(-> env :ns :name) :excludes sym]))
+                           (not (or (-> env :ns :uses-macros sym)
+                                    (get-in @namespaces [(-> env :ns :name) :uses-macros sym])))))
+          (if-let [nstr (namespace sym)]
+            (if-let [ns (-> env :ns :requires-macros (get (symbol nstr)))]
+              (get-in ns [:defs (symbol (name sym))])
+              (resolve-existing-var (empty-env) sym))
+            (if-let [nsym (-> env :ns :uses-macros sym)]
+              (get-in @namespaces [nsym :defs sym])
+              (resolve-existing-var (empty-env) sym))))]
+;;    (println "// get-expander:" sym (type mvar) (keys mvar) (:macro? mvar))
+    (when (and mvar (:macro? mvar))
+      #_(js/eval (str (cljc.compiler/munge (:name mvar)))))))
+
+(defn macroexpand-1 [env form]
+  (let [op (first form)]
+    (if (specials op)
+      form
+      (if-let [mac (and (symbol? op) (get-expander op env))]
+        (binding [cljc.core/*ns-sym* *cljc-ns*]
+          ;;(println "// macroexpand-1, detected macro: " form "->" )
+          (apply mac form env (rest form)))
+        (if (symbol? op)
+          (let [opname (str op)]
+            (cond
+             (= (first opname) \.) (let [[target & args] (next form)]
+                                     (with-meta (list* '. target (symbol (subs opname 1)) args)
+                                       (meta form)))
+             (= (last opname) \.) (with-meta
+                                    (list* 'new (symbol (subs opname 0 (dec (count opname)))) (next form))
+                                    (meta form))
+             :else form))
+          form)))))
+
+(defn analyze-seq
+  [env form name]
+  (let [env (assoc env :line
+                   (or (-> form meta :line)
+                       (:line env)))]
+    (let [op (first form)]
+      (assert (not (nil? op)) "Can't call nil")
+      (let [mform (macroexpand-1 env form)]
+        (if (identical? form mform)
+          (if (specials op)
+            (parse op env form name)
+            (parse-invoke env form))
+          (analyze env mform name))))))
+
+(declare analyze-wrap-meta)
+
+(defn analyze-map
+  [env form name]
+  (let [expr-env (assoc env :context :expr)
+        simple-keys? (every? #(or (string? %) (keyword? %))
+                             (keys form))
+        ks (disallowing-recur (vec (map #(analyze expr-env % name) (keys form))))
+        vs (disallowing-recur (vec (map #(analyze expr-env % name) (vals form))))]
+    (analyze-wrap-meta {:op :map :env env :form form
+                        :keys ks :vals vs :simple-keys? simple-keys?
+                        :children (vec (interleave ks vs))}
+                       name)))
+
+(defn analyze-vector
+  [env form name]
+  (let [expr-env (assoc env :context :expr)
+        items (disallowing-recur (vec (map #(analyze expr-env % name) form)))]
+    (analyze-wrap-meta {:op :vector :env env :form form :items items :children items} name)))
+
+(defn analyze-set
+  [env form name]
+  (let [expr-env (assoc env :context :expr)
+        items (disallowing-recur (vec (map #(analyze expr-env % name) form)))]
+    (analyze-wrap-meta {:op :set :env env :form form :items items :children items} name)))
+
+(defn analyze-wrap-meta [expr name]
+  (let [form (:form expr)]
+    (if (meta form)
+      (let [env (:env expr) ; take on expr's context ourselves
+            expr (assoc-in expr [:env :context] :expr) ; change expr to :expr
+            meta-expr (analyze-map (:env expr) (meta form) name)]
+        {:op :meta :env env :form form
+         :meta meta-expr :expr expr :children [meta-expr expr]})
+      expr)))
+
+(defn analyze
+  "Given an environment, a map containing {:locals (mapping of names to bindings), :context
+  (one of :statement, :expr, :return), :ns (a symbol naming the
+  compilation ns)}, and form, returns an expression object (a map
+  containing at least :form, :op and :env keys). If expr has any (immediately)
+  nested exprs, must have :children [exprs...] entry. This will
+  facilitate code walking without knowing the details of the op set."
+  ([env form] (analyze env form nil))
+  ([env form name]
+     (let [form (if (instance? LazySeq form) ; was  cljc.core.LazySeq, but improperly munged
+                  (or (seq form) ())
+                  form)]
+       ;;(load-core)
+       (cond
+        (symbol? form) (analyze-symbol env form)
+        (and (seq? form) (seq form)) (analyze-seq env form name)
+        (map? form) (analyze-map env form name)
+        (vector? form) (analyze-vector env form name)
+        (set? form) (analyze-set env form name)
+        (keyword? form) (analyze-keyword env form)
+        :else {:op :constant :env env :form form}))))
+
+;; TODO: Implicit dependency on cljc.reader.
+(defn analyze-file
+  [^String f]
+  (let [raw-string (slurp f)]
+    (binding [*cljc-ns* 'cljc.user
+              *cljc-file* f
+              cljc.core/*ns-sym* *reader-ns-name*]
+      (let [env (empty-env)
+            pbr (reader/push-back-reader raw-string)
+            eof "TODO_EOF_OBJECT" #_(js/Object.)]
+        (loop [r (reader/read pbr false eof false)]
+          (let [env (assoc env :ns (find-ns *cljc-ns*))]
+            (when-not (identical? eof r)
+              (analyze env r)
+              (recur (reader/read pbr false eof false)))))))))
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 88f64f5..0abaa1b 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -1,4 +1,10 @@
 ;;; -*- clojure -*-
+(ns cljc.core
+  #_(:use-macros [cljc.core-macros :only [clj-defmacro]]))
+
+(def ^:dynamic *out*)
+(def ^:dynamic *err*)
+
 
 (ns cljc.core.PersistentVector)
 
@@ -224,9 +230,24 @@
   (-entry-key [coll entry])
   (-comparator [coll]))
 
-(defprotocol IPrintable
+(defprotocol ^:deprecated IPrintable
+  "Do not use this.  It is kept for backwards compatibility with existing
+   user code that depends on it, but it has been superceded by IPrintWithWriter
+   User code that depends on this should be changed to use -pr-writer instead."
   (-pr-seq [o opts]))
 
+(defprotocol IWriter
+  (-write [writer s])
+  (-flush [writer]))
+
+(defprotocol IPrintWithWriter
+  "The old IPrintable protocol's implementation consisted of building a giant
+   list of strings to concatenate.  This involved lots of concat calls,
+   intermediate vectors, and lazy-seqs, and was very slow in some older JS
+   engines.  IPrintWithWriter implements printing via the IWriter protocol, so it
+   be implemented efficiently in terms of e.g. a StringBuffer append."
+  (-pr-writer [o writer opts]))
+
 (defprotocol IPending
   (-realized? [d]))
 
@@ -341,6 +362,9 @@
     ([_ f] (f))
     ([_ f start] start))
 
+  IPrintWithWriter
+  (-pr-writer [o writer _] (-write writer "nil"))
+
   IPrintable
   (-pr-seq [o opts] (list "nil")))
 
@@ -833,6 +857,10 @@ reduces them without incurring seq initialization"
 (defn ^boolean instance? [t o]
   (c* "make_boolean (~{}->ptable->constructor == ~{})" o t))
 
+(defn ^boolean undefined? [x]
+  (cljc.core/undefined? x))
+
+
 (defn ^boolean seq?
   "Return true if s satisfies ISeq"
   [s]
@@ -874,7 +902,7 @@ reduces them without incurring seq initialization"
   ([name] (c* "make_keyword( string_get_utf8(~{}) )" (if (symbol? name)
                                                        (name name)
                                                        name))
-     #_(cond
+     #_(cond ; TODO
       (keyword? name) (Keyword. nil name name nil)
       (symbol? name) (Keyword. nil (name name) (name name) nil)
       :else (Keyword. nil name name nil)))
@@ -893,8 +921,8 @@ reduces them without incurring seq initialization"
      (let [sym-str (if-not (nil? ns)
                      (str ns "/" name)
                      name)]
-       #_(Symbol. ns name sym-str nil nil)
-       (c* "make_symbol( string_get_utf8( ~{}) )" sym-str))))
+       (c* "make_symbol( string_get_utf8( ~{} ))" sym-str))))
+
 
 
 (defn ^boolean number? [n]
@@ -1228,7 +1256,7 @@ reduces them without incurring seq initialization"
     (c* "make_integer ((long)float_get (~{}))" q)))
 
 (defn int
-  "Coerce to int by stripping decimal places."
+  "Coerce to int by stripping decimal places or converting from char."
   [x]
   (cond (char? x) (c* "make_integer ((long)character_get (~{}))" x)
         :else (fix x)))
@@ -1353,44 +1381,52 @@ reduces them without incurring seq initialization"
 
 (declare println)
 (if-objc
-  (do
-    (deftype StringBuilder [string]
-      IStringBuilder
-      (-append! [sb appendee]
-        (§ string :appendString appendee)
-        sb)
-      (-to-string [sb]
-        (§ (§ NSString) :stringWithString string)))
-
-    (defn- sb-make [string]
-      (StringBuilder. (§ (§ NSMutableString) :stringWithString string))))
-  (do
-    (deftype StringBuilder [string size used]
-      IStringBuilder
-      (-append! [sb appendee]
-        (let [len (c* "make_integer (strlen (string_get_utf8 (~{})))" appendee)
-              new-used (+ used len)
-              new-sb (if (<= new-used size)
-                       (StringBuilder. string size new-used)
-                       (let [new-size (loop [size (if (< size 16)
-                                                    32
-                                                    (* size 2))]
-                                        (if (<= new-used size)
-                                          size
-                                          (recur (* size 2))))
-                             new-string (c* "make_string_with_size (integer_get (~{}))" new-size)]
-                         (c* "memcpy ((void*)string_get_utf8 (~{}), string_get_utf8 (~{}), integer_get (~{}))"
-                             new-string string used)
-                         (StringBuilder. new-string new-size new-used)))]
-          (c* "memcpy ((void*)string_get_utf8 (~{}) + integer_get (~{}), string_get_utf8 (~{}), integer_get (~{}))"
-              (.-string new-sb) used appendee len)
-          new-sb))
-      (-to-string [sb]
-        string))
-
-    (defn- sb-make [string]
-      (let [len (c* "make_integer (strlen (string_get_utf8 (~{})))" string)]
-        (StringBuilder. string len len)))))
+ (do
+   (deftype StringBuilder [string]
+     IStringBuilder
+     (-append! [sb appendee]
+       (§ string :appendString appendee)
+       sb)
+     (-to-string [sb]
+       (§ (§ NSString) :stringWithString string)))
+
+   (defn- sb-make
+     ([] (sb-make ""))
+     ([string]
+        (StringBuilder. (§ (§ NSMutableString) :stringWithString string)))))
+ (do
+   (deftype StringBuilder [^:mutable string ^:mutable size ^:mutable used]
+     IStringBuilder
+     (-append! [sb appendee]
+       (let [len (c* "make_integer (strlen (string_get_utf8 (~{})))" appendee)
+             new-used (+ used len)]
+         (if (<= new-used size)
+           (do (c* "memcpy ((void*)string_get_utf8 (~{}) + integer_get (~{}), string_get_utf8 (~{}), integer_get (~{}))"
+                   string used appendee len)
+               (set! used new-used))
+           (let [new-size (loop [size (if (< size 16)
+                                        32
+                                        (* size 2))]
+                            (if (<= new-used size)
+                              size
+                              (recur (* size 2))))
+                 new-string (c* "make_string_with_size (integer_get (~{}))" new-size)]
+             (c* "memcpy ((void*)string_get_utf8 (~{}), string_get_utf8 (~{}), integer_get (~{}))"
+                 new-string string used)
+             (c* "memcpy ((void*)string_get_utf8 (~{}) + integer_get (~{}), string_get_utf8 (~{}), integer_get (~{}))"
+                 new-string used appendee len)
+             (set! string new-string)
+             (set! size new-size)
+             (set! used new-used)))
+         sb))
+     (-to-string [sb]
+       (c* "make_string_copy (string_get_utf8(~{}))" string)))
+
+   (defn- sb-make
+     ([] (sb-make ""))
+     ([string]
+        (let [len (c* "make_integer (strlen (string_get_utf8 (~{})))" string)]
+          (StringBuilder. string len len))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;;
 
@@ -1399,7 +1435,7 @@ reduces them without incurring seq initialization"
 ;; FIXME: use StringBuilder
 (defn str
   "With no args, returns the empty string. With one arg x, returns
-  x.toString().  (str nil) returns the empty string. With more than
+  String of x.  (str nil) returns the empty string. With more than
   one arg, returns the concatenation of the str values of the args."
   ([] "")
   ([x] (cond
@@ -1407,11 +1443,20 @@ reduces them without incurring seq initialization"
         (symbol? x) (c* "make_string ((char*)symbol_get_utf8 (~{}))" x)
         (keyword? x) (str ":" (c* "make_string ((char*)keyword_get_utf8 (~{}))" x))
         (char? x) (c* "make_string_from_unichar (character_get (~{}))" x)
+        (has-type? x Integer) (if-objc
+                               (c* "make_objc_object ([NSString stringWithFormat: @\"%lld\", integer_get (~{})])" x)
+                               (c* "make_string_copy_free (g_strdup_printf (\"%lld\", integer_get (~{})))" x))
+        (has-type? x Float) (if-objc
+                             (c* "make_objc_object ([NSString stringWithFormat: @\"%f\", float_get (~{})])" x)
+                             (c* "make_string_copy_free (g_strdup_printf (\"%f\", float_get (~{})))" x))
+        (has-type? x Boolean) (if x "true" "false")
         (nil? x) ""
         (satisfies? IStringBuilder x) (-to-string x)
-        :else (pr-str x)))
+        :else  (if-objc
+                (c* "make_objc_object ([NSString stringWithFormat: @\"#<RawPointer %p>\", ~{}])" x)
+                (c* "make_string_copy_free (g_strdup_printf (\"#<RawPointer %p>\", ~{}))" x))))
   ([& xs]
-     (loop [sb (sb-make "")
+     (loop [sb (sb-make)
             xs (seq xs)]
        (if xs
          (recur (-append! sb (str (first xs)))
@@ -1436,6 +1481,18 @@ reduces them without incurring seq initialization"
   ([s start end]
      (checked-substring s start end)))
 
+(declare map)
+(defn format
+  "Formats a string. TODO implement printf formatting natively in Clojure."
+  [fmt & args]
+  (let [args (map (fn [x]
+                    (if (or (keyword? x) (symbol? x))
+                      (str x)
+                      x))
+                args)]
+    "TODO"
+    #_(apply str fmt "TODO" args)))
+
 (defn- equiv-sequential
   "Assumes x is sequential. Returns true if x equals y, otherwise
   returns false."
@@ -2358,11 +2415,36 @@ reduces them without incurring seq initialization"
                    s)))]
     (lazy-seq (step pred coll))))
 
+(defn cycle
+  "Returns a lazy (infinite!) sequence of repetitions of the items in coll."
+  [coll] (lazy-seq
+          (when-let [s (seq coll)]
+            (concat s (cycle s)))))
+
+
 (defn split-at
   "Returns a vector of [(take n coll) (drop n coll)]"
   [n coll]
   [(take n coll) (drop n coll)])
 
+(defn repeat
+  "Returns a lazy (infinite!, or length n if supplied) sequence of xs."
+  ([x] (lazy-seq (cons x (repeat x))))
+  ([n x] (take n (repeat x))))
+
+(defn replicate
+  "Returns a lazy seq of n xs."
+  [n x] (take n (repeat x)))
+
+(defn repeatedly
+  "Takes a function of no args, presumably with side effects, and
+  returns an infinite (or length n if supplied) lazy sequence of calls
+  to it"
+  ([f] (lazy-seq (cons (f) (repeatedly f))))
+  ([n f] (take n (repeatedly f))))
+
+
+
 (defn iterate
   "Returns a lazy sequence of x, (f x), (f (f x)) etc. f must be free of side-effects"
   {:added "1.0"}
@@ -2498,7 +2580,7 @@ reduces them without incurring seq initialization"
    If (cmap ch) is nil, append ch to the new string.
    If (cmap ch) is non-nil, append (str (cmap ch)) instead."
   [s cmap]
-  (loop [sb (sb-make "")
+  (loop [sb (sb-make)
          cs (seq s)]
     (if cs
       (let [c (first cs)
@@ -2566,11 +2648,13 @@ reduces them without incurring seq initialization"
    string.  Similar to Perl's chomp."
   (apply str (cljc.core/reverse (drop-while #{\return \newline} (reverse s)))))
 
+(declare split join replace)
+
 (ns cljc.core)
 
 ;; FIXME: horribly inefficient as well as incomplete
 (defn string-quote [s]
-  (loop [sb (sb-make "")
+  (loop [sb (sb-make)
          cs (seq s)]
     (if cs
       (let [c (first cs)]
@@ -5187,6 +5271,14 @@ reduces them without incurring seq initialization"
    (symbol? x) (c* "symbol_get_name (~{})" x)
    :else (error (str "Doesn't support name: " x))))
 
+
+(defn butlast [s]
+  (loop [ret [] s s]
+    (if (next s)
+      (recur (conj ret (first s)) (next s))
+      (seq ret))))
+
+
 (defn namespace
   "Returns the namespace String of a symbol or keyword, or nil if not present."
   [x]
@@ -5231,6 +5323,29 @@ reduces them without incurring seq initialization"
       (when-let [s (seq coll)]
         (cons (take n s) (partition-all n step (drop step s)))))))
 
+(defn partition
+  "Returns a lazy sequence of lists of n items each, at offsets step
+  apart. If step is not supplied, defaults to n, i.e. the partitions
+  do not overlap. If a pad collection is supplied, use its elements as
+  necessary to complete last partition upto n items. In case there are
+  not enough padding elements, return a partition with less than n items."
+  ([n coll]
+     (partition n n coll))
+  ([n step coll]
+     (lazy-seq
+       (when-let [s (seq coll)]
+         (let [p (take n s)]
+           (when (== n (count p))
+             (cons p (partition n step (drop step s))))))))
+  ([n step pad coll]
+     (lazy-seq
+       (when-let [s (seq coll)]
+         (let [p (take n s)]
+           (if (== n (count p))
+             (cons p (partition n step pad (drop step s)))
+             (list (take n (concat p pad)))))))))
+
+
 (defn take-while
   "Returns a lazy sequence of successive items from coll while
   (pred item) returns true. pred must be free of side-effects."
@@ -5446,14 +5561,185 @@ reduces them without incurring seq initialization"
    (dorun n coll)
    coll))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Regular Expressions ;;;;;;;;;;;;;;;;
+
+(defprotocol IPattern)
+
+(defn regexp? [o]
+  (satisfies? IPattern o))
+
+(if-objc
+ (extend-type (§ NSRegularExpression)
+   IPattern
+   IPrintable
+   (-pr-seq [p opts]
+     (list "(re-pattern \"" (§ p :pattern) "\")")))
+ (deftype Pattern [pattern re]
+   IPattern
+   IPrintable
+   (-pr-seq [p opts]
+     (list "(re-pattern \"" (string-quote pattern) "\")"))))
+
+(defn re-pattern [s]
+  "Returns a pattern for use by re-seq, etc. (Currently accepts PCRE syntax.)"
+  (if (satisfies? IPattern s)
+    s
+    (if-objc
+     (let [re (§ (§ NSRegularExpression)
+                 :regularExpressionWithPattern s
+                 :options UIKit/NSRegularExpressionCaseInsensitive
+                 :error nil)]
+       (if re
+         re
+         (throw (Exception. (str "Invalid regular expression pattern " s)))))
+     (let [result (c* "pcre_pattern (~{})" s)]
+       (when (has-type? result Array)
+         (let [[msg offset] result]
+           (throw (Exception. (str "Cannot compile pattern " (pr-str s)
+                                   " (" msg "; index " offset ")")))))
+       (Pattern. s result)))))
+
+(if-objc
+ (defn- text-checking-result->matches [s num-groups tcr]
+   (let [matches (map (fn [i]
+                        ;; FIXME: handle NSNotFound
+                        (§ s :substringWithRange (§ tcr :rangeAtIndex i)))
+                      (range (inc num-groups)))]
+     (if (zero? num-groups)
+       (first matches)
+       matches)))
+ (defn- pcre-match-offsets
+   ([re s offset]
+      (let [offsets (c* "pcre_match_offsets (~{}, ~{}, ~{})" (.-re re) s offset)]
+        (when offsets
+          (if (integer? offsets)
+            (throw (Exception. (str "PCRE search error " offsets " for pattern "
+                                    (pr-str re) " against " (pr-str s)
+                                    " at offset " offset))))
+          offsets)))
+   ([re s]
+      (pcre-match-offsets re s 0))))
+
+(defn- re-offsets->matches
+  "Returns \"whole-match\" if there were no captures, otherwise
+   [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
+  [s offsets]
+  (if (= 2 (count offsets))
+    (apply subs s offsets)
+    (map #(apply subs s %)
+         (partition-all 2 offsets))))
+
+(def ^:private re-first-match-range
+  (if-objc
+   (fn [re s offset]
+     (let [string-length (§ s :length)
+           range-length (- string-length offset)
+           tcr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange offset range-length))]
+       (when tcr
+         (mapcat (fn [i]
+                   (let [match-location (c* "make_integer ([objc_object_get (~{}) rangeAtIndex: integer_get (~{})].location)" tcr i)
+                         match-length (c* "make_integer ([objc_object_get (~{}) rangeAtIndex: integer_get (~{})].length)" tcr i)]
+                     [match-location (+ match-location match-length)]))
+                 (range (§ tcr :numberOfRanges))))))
+   pcre-match-offsets))
+
+(defn re-seq
+  "Returns a lazy sequence of successive matches of regex re in string s.
+   Each match will be \"whole-match\" if re has no captures, otherwise
+   [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
+  [re s]
+  (if-objc
+   (let [num-groups (§ re :numberOfCaptureGroups)
+         string-length (§ s :length)
+         tcrs (§ re :matchesInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))]
+     (map #(text-checking-result->matches s num-groups %) tcrs))
+   (when-let [offsets (pcre-match-offsets re s)]
+     (lazy-seq
+      (cons (re-offsets->matches s offsets)
+            (re-seq re (subs s (max 1 (nth offsets 1)))))))))
+
+(defn re-find
+  "Returns the first match for regex re in string s or nil.  The
+   match, if any, will be \"whole-match\" if re has no captures,
+   otherwise [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
+  [re s]
+  (first (re-seq re s)))
+
+(defn re-matches
+  "Returns the match for regex re in string s, if and only if re
+   matches s completely.  The match, if any, will be \"whole-match\"
+   if re has no captures, otherwise [\"whole-match\" \"capture-1\"
+   \"capture-2\" ...]."
+  [re s]
+  (if-objc
+   (let [num-groups (§ re :numberOfCaptureGroups)
+         string-length (§ s :length)
+         tcr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))
+         matched (and tcr (c* "make_boolean ([objc_object_get (~{}) range].location != NSNotFound)" tcr))]
+     (when matched
+       (let [match-location (c* "make_integer ([objc_object_get (~{}) range].location)" tcr)
+             match-length (c* "make_integer ([objc_object_get (~{}) range].length)" tcr)]
+         (when (and (= match-location 0) (= match-length string-length))
+           (text-checking-result->matches s num-groups tcr)))))
+   (let [offsets (pcre-match-offsets re s)]
+     (when (and offsets (= (count s) (- (nth offsets 1) (nth offsets 0))))
+       (re-offsets->matches s offsets)))))
+
+(defn re-partition
+  "Splits the string into a lazy sequence of substrings, alternating
+   between substrings that match the pattern and the substrings
+   between the matches.  The sequence always starts with the substring
+   before the first match, or an empty string if the beginning of the
+   string matches.
+
+   For example: (re-partition #\"[a-z]+\" \"abc123def\")
+
+   Returns: (\"\" \"abc\" \"123\" \"def\")"
+  ;; This is modeled after clojure-contrib.str-util/partition, but
+  ;; behaves differently in part due to the fact that PCRE matches
+  ;; differently.  For example, with PCRE the empty string matches
+  ;; nothing.  In Java, it matches everything.
+  [re s]
+  (let [s-len (count s)]
+    ((fn step [prev-end search-i]
+       (lazy-seq
+        (if-let [offsets (re-first-match-range re s search-i)]
+          (let [[match-start match-end] offsets
+                matches (re-offsets->matches s offsets)]
+            (cons (subs s prev-end match-start)
+                  (cons matches
+                        (step match-end
+                              (if (= match-start match-end)
+                                (inc match-end)
+                                match-end)))))
+          (when (< prev-end s-len)
+            (list (subs s prev-end))))))
+     0 0)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Printing ;;;;;;;;;;;;;;;;
 
-(defn pr-sequential [print-one begin sep end opts coll]
-  (concat (list begin)
+(defn ^:deprecated pr-sequential
+  "Do not use this.  It is kept for backwards compatibility with the
+   old IPrintable protocol."
+  [print-one begin sep end opts coll]
+  (concat [begin]
           (flatten1
-            (interpose (list sep) (map #(print-one % opts) coll)))
-          (list end)))
+            (interpose [sep] (map #(print-one % opts) coll)))
+          [end]))
+
+(defn pr-sequential-writer [writer print-one begin sep end opts coll]
+  (-write writer begin)
+  (when (seq coll)
+    (print-one (first coll) writer opts))
+  (doseq [o (next coll)]
+    (-write writer sep)
+    (print-one o writer opts))
+  (-write writer end))
+
+(defn write-all [writer & ss]
+  (doseq [s ss]
+    (-write writer s)))
 
 (defn string-print [x]
   (*print-fn* x)
@@ -5462,55 +5748,106 @@ reduces them without incurring seq initialization"
 (defn flush [] ;stub
   nil)
 
-(defn- pr-seq [obj opts]
-  ;; FIXME: print meta
-  (if (satisfies? IPrintable obj)
-    (-pr-seq obj opts)
-    (if-objc
-     (if (has-type? obj ObjCObject)
-       (list "#<" (UIKit/class_getName (§ obj :class)) ">")
-       (list "#<unknown>"))
-     (list "#<unknown>"))))
+(deftype StringBufferWriter [sb]
+  IWriter
+  (-write [_ s] (-append! sb s))
+  (-flush [_] nil))
 
-(defn- pr-sb [objs opts]
-  (loop [sb (sb-make "")
-         objs (seq objs)
-         need-sep false]
-    (if objs
-      (recur (loop [sb (if need-sep (-append! sb " ") sb)
-                    strings (seq (pr-seq (first objs) opts))]
-               (if strings
-                 (recur (-append! sb (first strings))
-                        (next strings))
-                 sb))
-             (next objs)
-             true)
-      sb)))
+(defn- ^:deprecated pr-seq
+  "Do not use this.  It is kept for backwards compatibility with the
+   old IPrintable protocol."
+  [obj opts]
+  (cond
+    (nil? obj) (list "nil")
+    (undefined? obj) (list "#<undefined>")
+    :else (concat
+            (when (and (get opts :meta)
+                       (satisfies? IMeta obj)
+                       (meta obj))
+              (concat ["^"] (pr-seq (meta obj) opts) [" "]))
+            (cond
+             ;; handle CLJS ctors
+;            (and (not (nil? obj))
+;                 ^boolean (.-cljc$lang$type obj))
+;            (.cljc$lang$ctorPrSeq obj obj)
+
+             (satisfies? IPrintable obj) (-pr-seq obj opts)
+
+             (regexp? obj) (list "#\"" (.-pattern obj) "\"")
+
+             :else (list "#<" (str obj) ">")))))
+
+(defn- pr-writer
+  "Prefer this to pr-seq, because it makes the printing function
+   configurable, allowing efficient implementations such as appending
+   to a StringBuffer."
+  [obj writer opts]
+  (cond
+    (nil? obj) (-write writer "nil")
+    (undefined? obj) (-write writer "#<undefined>")
+    :else (do
+            (when (and (get opts :meta)
+                       (satisfies? IMeta obj)
+                       (meta obj))
+              (-write writer "^")
+              (pr-writer (meta obj) writer opts)
+              (-write writer " "))
+            (cond
+              ;; handle CLJS ctors
+;              (and (not (nil? obj))
+;                  ^boolean (.-cljc$lang$type obj))
+;               (.cljc$lang$ctorPrWriter obj obj writer opts)
+
+              ; Use the new, more efficient, IPrintWithWriter interface when possible.
+              (satisfies? IPrintWithWriter obj) (-pr-writer obj writer opts)
+
+              ; Fall back on the deprecated IPrintable if necessary.  Note that this
+              ; will only happen when ClojureScript users have implemented -pr-seq
+              ; for their custom types.
+              (satisfies? IPrintable obj) (apply write-all writer (-pr-seq obj opts))
+
+              (regexp? obj) (write-all writer "#\""
+                                       ; Replace \/ with / since clojure does not escape it.
+                                       (cljc.string/join (cljc.string/split (.-pattern obj) (re-pattern "\\\\/")))
+                                       "\"")
+
+              :else (write-all writer "#<" (str obj) ">")))))
+
+(defn pr-seq-writer [objs writer opts]
+  (pr-writer (first objs) writer opts)
+  (doseq [obj (next objs)]
+    (-write writer " ")
+    (pr-writer obj writer opts)))
+
+(defn- pr-sb-with-opts [objs opts]
+  (let [sb (sb-make)
+        writer (StringBufferWriter. sb)]
+    (pr-seq-writer objs writer opts)
+    (-flush writer)
+    sb))
 
 (defn pr-str-with-opts
   "Prints a sequence of objects to a string, observing all the
   options given in opts"
   [objs opts]
-  (str (pr-sb objs opts)))
+  (if (empty? objs)
+    ""
+    (str (pr-sb-with-opts objs opts))))
 
 (defn prn-str-with-opts
   "Same as pr-str-with-opts followed by (newline)"
   [objs opts]
-  (let [sb (pr-sb objs opts)]
-    (str (-append! sb "\n"))))
+  (if (empty? objs)
+    "\n"
+    (let [sb (pr-sb-with-opts objs opts)]
+      (-append! sb \newline)
+      (str sb))))
 
-(defn pr-with-opts
+(defn- pr-with-opts
   "Prints a sequence of objects using string-print, observing all
   the options given in opts"
   [objs opts]
-  (loop [objs (seq objs)
-         need-sep false]
-    (when objs
-      (when need-sep
-        (string-print " "))
-      (doseq [string (pr-seq (first objs) opts)]
-        (string-print string))
-      (recur (next objs) true))))
+  (string-print (pr-str-with-opts objs opts)))
 
 (defn newline
   ([] (newline nil))
@@ -5552,7 +5889,7 @@ reduces them without incurring seq initialization"
   "Prints the object(s) using string-print.
   print and println produce output for human consumption."}
   print
-  (fn cljs-core-print [& objs]
+  (fn cljc-core-print [& objs]
     (pr-with-opts objs (assoc (pr-opts) :readably false))))
 
 (defn print-str
@@ -5577,7 +5914,284 @@ reduces them without incurring seq initialization"
   (pr-with-opts objs (pr-opts))
   (newline (pr-opts)))
 
-;; FIXME: extend-protocol IPrintable
+(defn printf
+  "Prints formatted output, as per format"
+  [fmt & args]
+  (print (apply format fmt args)))
+
+(def ^:private char-escapes {"\"" "\\\""
+                             "\\" "\\\\"
+                             "\b" "\\b"
+                             "\f" "\\f"
+                             "\n" "\\n"
+                             "\r" "\\r"
+                             "\t" "\\t"})
+
+(defn ^:private quote-string
+  [s]
+  (str \"
+       (cljc.string/replace s #_(js/RegExp "[\\\\\"\b\f\n\r\t]" "g") (re-pattern "[\\\\\"\b\f\n\r\t]") ; TODO
+         (fn [match] (get char-escapes match)))
+       \"))
+
+;; FIXME: extend-protocol IPrintable in one place (for later removal)
+#_(extend-protocol ^:deprecation-nowarn IPrintable
+  Boolean
+  (-pr-seq [bool opts] (list (str bool)))
+
+  Integer
+  (-pr-seq [n opts] (list (str n)))
+
+  Float
+  (-pr-seq [n opts] (list (str n)))
+
+  Array
+  (-pr-seq [a opts]
+    ^:deprecation-nowarn (pr-sequential pr-seq "#<Array [" ", " "]>" opts a))
+
+  String
+  (-pr-seq [obj opts]
+    (cond
+     (keyword? obj)
+     (list (str ":"
+                (when-let [nspc (namespace obj)]
+                  (str nspc "/"))
+                (name obj)))
+     (symbol? obj)
+     (list (str (when-let [nspc (namespace obj)]
+                  (str nspc "/"))
+                (name obj)))
+     :else (list (if (:readably opts)
+                   (quote-string obj)
+                   obj))))
+
+  #_function ; TODO
+  #_(-pr-seq [this]
+    (list "#<" (str this) ">"))
+
+  #_js/Date
+  #_(-pr-seq [d _]
+    (let [normalize (fn [n len]
+                      (loop [ns (str n)]
+                        (if (< (count ns) len)
+                          (recur (str "0" ns))
+                          ns)))]
+      (list
+       (str "#inst \""
+            (.getUTCFullYear d)                   "-"
+            (normalize (inc (.getUTCMonth d)) 2)  "-"
+            (normalize (.getUTCDate d) 2)         "T"
+            (normalize (.getUTCHours d) 2)        ":"
+            (normalize (.getUTCMinutes d) 2)      ":"
+            (normalize (.getUTCSeconds d) 2)      "."
+            (normalize (.getUTCMilliseconds d) 3) "-"
+            "00:00\""))))
+
+  LazySeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  IndexedSeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  PersistentTreeMapSeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  NodeSeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  ArrayNodeSeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  List
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  Cons
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  EmptyList
+  (-pr-seq [coll opts] (list "()"))
+
+  PersistentVector
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "[" " " "]" opts coll))
+
+  ChunkedCons
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  ChunkedSeq
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll))
+
+  Subvec
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "[" " " "]" opts coll))
+
+  BlackNode
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "[" " " "]" opts coll))
+
+  RedNode
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "[" " " "]" opts coll))
+
+  PersistentArrayMap
+  (-pr-seq [coll opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential pr-seq "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential pr-pair "{" ", " "}" opts coll)))
+
+  PersistentHashMap
+  (-pr-seq [coll opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential pr-seq "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential pr-pair "{" ", " "}" opts coll)))
+
+  PersistentTreeMap
+  (-pr-seq [coll opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential pr-seq "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential pr-pair "{" ", " "}" opts coll)))
+
+  PersistentHashSet
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "#{" " " "}" opts coll))
+
+  PersistentTreeSet
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "#{" " " "}" opts coll))
+
+  Range
+  (-pr-seq [coll opts] ^:deprecation-nowarn (pr-sequential pr-seq "(" " " ")" opts coll)))
+
+(extend-protocol IPrintWithWriter
+  Boolean
+  (-pr-writer [bool writer opts] (-write writer (str bool)))
+
+  Float
+  (-pr-writer [n writer opts] #_(/ 1 0) (-write writer (str n)))
+
+  Integer
+  (-pr-writer [n writer opts] #_(/ 1 0) (-write writer (str n)))
+
+  Array
+  (-pr-writer [a writer opts]
+    ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "#<Array [" ", " "]>" opts a))
+
+  Symbol
+  (-pr-writer [s writer _]
+    (do
+      (when-let [nspc (namespace s)]
+        (write-all writer (str nspc) "/"))
+      (-write writer (name s))))
+
+  String
+  (-pr-writer [obj writer opts]
+    (cond
+     (keyword? obj)
+       (do
+         (-write writer ":")
+         (when-let [nspc (namespace obj)]
+           (write-all writer (str nspc) "/"))
+         (-write writer (name obj)))
+     :else (if (:readably opts)
+             (-write writer (quote-string obj))
+             (-write writer obj))))
+
+  #_function
+  #_(-pr-writer [this writer _]
+    (write-all writer "#<" (str this) ">"))
+
+  #_js/Date
+  #_(-pr-writer [d writer _]
+    (let [normalize (fn [n len]
+                      (loop [ns (str n)]
+                        (if (< (count ns) len)
+                          (recur (str "0" ns))
+                          ns)))]
+      (write-all writer
+        "#inst \""
+        (str (.getUTCFullYear d))             "-"
+        (normalize (inc (.getUTCMonth d)) 2)  "-"
+        (normalize (.getUTCDate d) 2)         "T"
+        (normalize (.getUTCHours d) 2)        ":"
+        (normalize (.getUTCMinutes d) 2)      ":"
+        (normalize (.getUTCSeconds d) 2)      "."
+        (normalize (.getUTCMilliseconds d) 3) "-"
+        "00:00\"")))
+
+  LazySeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  IndexedSeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  PersistentTreeMapSeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  NodeSeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  ArrayNodeSeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  List
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  Cons
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  EmptyList
+  (-pr-writer [coll writer opts] (-write writer "()"))
+
+  PersistentVector
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+
+  ChunkedCons
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  ChunkedSeq
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll))
+
+  Subvec
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+
+  BlackNode
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+
+  RedNode
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "[" " " "]" opts coll))
+
+  PersistentArrayMap
+  (-pr-writer [coll writer opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+
+  PersistentHashMap
+  (-pr-writer [coll writer opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+
+  PersistentTreeMap
+  (-pr-writer [coll writer opts]
+    (let [pr-pair (fn [keyval _ _] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
+      ^:deprecation-nowarn (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll)))
+
+  PersistentHashSet
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll))
+
+  PersistentTreeSet
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "#{" " " "}" opts coll))
+
+  Range
+  (-pr-writer [coll writer opts] ^:deprecation-nowarn (pr-sequential-writer writer pr-writer "(" " " ")" opts coll)))
+
+
+
+(defn- pr-sb [objs opts]
+  (loop [sb (sb-make)
+         objs (seq objs)
+         need-sep false]
+    (if objs
+      (recur (loop [sb (if need-sep (-append! sb " ") sb)
+                    strings (seq (pr-seq (first objs) opts))]
+               (if strings
+                 (recur (-append! sb (first strings))
+                        (next strings))
+                 sb))
+             (next objs)
+             true)
+      sb)))
+
 
 ;; IComparable
 (extend-protocol IComparable
@@ -5732,6 +6346,28 @@ reduces them without incurring seq initialization"
   [iref key]
   (-remove-watch iref key))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; gensym ;;;;;;;;;;;;;;;;
+;; Internal - do not use!
+(def gensym_counter nil)
+
+(defn gensym
+  "Returns a new symbol 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__'. It is ensured to emit different
+  ids than the static cljc compiler."
+  ([] (gensym "G__"))
+  ([prefix-string]
+     (when (nil? gensym_counter)
+       (set! gensym_counter (atom 0)))
+     (symbol (str prefix-string "_" (swap! gensym_counter inc)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Fixtures ;;;;;;;;;;;;;;;;
+
+(def fixture1 1)
+(def fixture2 2)
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Delay ;;;;;;;;;;;;;;;;;;;;
 
 (deftype Delay [state f]
@@ -6042,7 +6678,194 @@ reduces them without incurring seq initialization"
   "Given a multimethod, returns a map of preferred value -> set of other values"
   [multifn] (-prefers multifn))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;
+;; UUID
+
+(deftype UUID [uuid]
+;  Object
+; (toString [this]
+;    (pr-str this))
+
+  IEquiv
+  (-equiv [_ other]
+    (and (instance? UUID other)
+         (= uuid (.-uuid other)))) ; was identical?
+
+  ^:deprecation-nowarn IPrintable
+  (-pr-seq [_ _]
+    (list (str "#uuid \"" uuid "\"")))
+
+  IPrintWithWriter
+  (-pr-writer [_ writer _]
+    (-write writer (str "#uuid \"" uuid "\"")))
+
+  IHash
+  (-hash [this]
+    (-hash (pr-str this))))
+
+
+;;;;;;;;;;;;;;;;;; Destructuring ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn destructure [bindings]
+  (let [bents (partition 2 bindings)
+         pb (fn pb [bvec b v]
+              (let [pvec
+                     (fn [bvec b val]
+                       (let [gvec (gensym "vec__")]
+                         (loop [ret (-> bvec (conj gvec) (conj val))
+                                     n 0
+                                     bs b
+                                     seen-rest? false]
+                           (if (seq bs)
+                             (let [firstb (first bs)]
+                               (cond
+                                 (= firstb '&) (recur (pb ret (second bs) (list `cljc.core/nthnext gvec n))
+                                                      n
+                                                      (nnext bs)
+                                                      true)
+                                 (= firstb :as) (pb ret (second bs) gvec)
+                                 :else (if seen-rest?
+                                         (throw (new Exception "Unsupported binding form, only :as can follow & parameter"))
+                                         (recur (pb ret firstb  (list `cljc.core/nth gvec n nil))
+                                                (inc n)
+                                                (next bs)
+                                                seen-rest?))))
+                             ret))))
+                     pmap
+                     (fn [bvec b v]
+                       (let [gmap (gensym "map__")
+                                  defaults (:or b)]
+                         (loop [ret (-> bvec (conj gmap) (conj v)
+                                             (conj gmap) (conj `(if (cljc.core/seq? ~gmap) (cljc.core/apply cljc.core/hash-map ~gmap) ~gmap))
+                                             ((fn [ret]
+                                                (if (:as b)
+                                                  (conj ret (:as b) gmap)
+                                                  ret))))
+                                     bes (reduce
+                                          (fn [bes entry]
+                                            (reduce #(assoc %1 %2 ((val entry) %2))
+                                                    (dissoc bes (key entry))
+                                                    ((key entry) bes)))
+                                          (dissoc b :as :or)
+                                          {:keys #(keyword (str %)), :strs str, :syms #(list `quote %)})]
+                           (if (seq bes)
+                             (let [bb (key (first bes))
+                                        bk (val (first bes))
+                                        has-default (contains? defaults bb)]
+                               (recur (pb ret bb (if has-default
+                                                   (list `cljc.core/get gmap bk (defaults bb))
+                                                   (list `cljc.core/get gmap bk)))
+                                      (next bes)))
+                             ret))))]
+                    (cond
+                      (symbol? b) (-> bvec (conj b) (conj v))
+                      (vector? b) (pvec bvec b v)
+                      (map? b) (pmap bvec b v)
+                      :else (throw (Exception. (str "Unsupported binding form: " b))))))
+         process-entry (fn [bvec b] (pb bvec (first b) (second b)))]
+        (if (every? symbol? (map first bents))
+          bindings
+          (reduce process-entry [] bents))))
+
+
+;;;;;;;;;;;;;;;;;; Namespace/Vars/Macro hackery ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def namespaces (atom '{cljc.core {:name cljc.core}
+                        cljc.user {:name cljc.user}}))
+
+(def ^:dynamic *ns-sym* nil)
+
+(defn find-ns
+  "Returns the namespace named by the symbol or nil if it doesn't
+  exist."
+  [sym]
+  (@namespaces sym))
+
+(defn create-ns
+  "Create a new namespace named by the symbol if one doesn't already
+  exist, returns it or the already-existing namespace of the same
+  name."
+  [sym]
+  (let [ns (find-ns sym)]
+    (if ns
+      ns
+      (do
+        (swap! namespaces assoc-in [sym :name] sym)
+        (find-ns sym)))))
+
+
+;; TODO: this belongs in REPL environment only
+;; Implicitly depends on cljs.analyzer
+(ns cljc.analyzer)
+
+(declare *cljc-ns*
+         resolve-var
+         *cljc-warn-on-undeclared*
+         resolve-existing-var warning
+         *cljc-warn-protocol-deprecated*
+         warning)
+
+(ns cljc.core)
+
+(defn in-ns [name]
+  (assert (symbol? name) "Unable to resolve namespace name")
+  (set! cljc.analyzer/*cljc-ns* name)
+  (set! *ns-sym* name))
+
+(defn ns-resolve
+  "Returns the \"var\" to which a symbol will be resolved in the
+  namespace, else nil."
+  {:added "1.0"
+   :static true}
+  [ns sym]
+  (get-in ns [:defs sym]))
+
+(defn resolve
+  "same as (ns-resolve (find-ns *ns-sym*) symbol)"
+  [sym]
+  (ns-resolve (find-ns *ns-sym*) sym))
+
+;;;;;;;;;;;;;;;;;;; File loading ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Implicitly depends on cljc.analyzer and cljc.compiler namespaces
+(defn load-file*
+  "Sequentially read and evaluate the set of forms contained in the
+  file. Returns a compile-forms* map that contains the emitted
+  JavaScript string (:emit-str) and the output (:output)."
+  [name]
+  ;; Use binding to restore *ns-sym* and *cljs-ns* after we're done
+  "TODO"
+  #_(binding [*ns-sym* *ns-sym*
+            cljs.analyzer/*cljs-ns* cljs.analyzer/*cljs-ns*]
+    (cljs.compiler/compile-and-eval-forms
+      (cljs.compiler/forms-seq name))))
+
+(defn load-file
+  "Sequentially read and evaluate the set of forms contained in the
+  file."
+  [name]
+  (let [lf (load-file* name)]
+    (print (:output lf))
+    (dissoc lf :output :emit-str)))
+
+(defn- root-resource
+  "Returns the root directory path for a lib"
+  {:tag String}
+  [lib]
+  (str \/
+       (-> (name lib)
+           (cljc.string/replace \- \_)
+           (cljc.string/replace \. \/))))
+
+(defn- lib->path
+  [lib]
+  (str "../src/cljc" (root-resource lib) ".cljc"))
+
+(defn require [& libs]
+  (doseq [lib libs]
+    (when-not (get-in @namespaces [lib :defs])
+      (load-file (lib->path lib)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;
 
 (if-objc
   nil
@@ -6097,158 +6920,6 @@ reduces them without incurring seq initialization"
                               char
                               0)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Regular Expressions ;;;;;;;;;;;;;;;;
-
-(defprotocol IPattern)
-
-(if-objc
- (extend-type (§ NSRegularExpression)
-   IPattern
-   IPrintable
-   (-pr-seq [p opts]
-     (list "(re-pattern \"" (§ p :pattern) "\")")))
- (deftype Pattern [pattern re]
-   IPattern
-   IPrintable
-   (-pr-seq [p opts]
-     (list "(re-pattern \"" (string-quote pattern) "\")"))))
-
-(defn re-pattern [s]
-  "Returns a pattern for use by re-seq, etc. (Currently accepts PCRE syntax.)"
-  (if (satisfies? IPattern s)
-    s
-    (if-objc
-     (let [re (§ (§ NSRegularExpression)
-                 :regularExpressionWithPattern s
-                 :options UIKit/NSRegularExpressionCaseInsensitive
-                 :error nil)]
-       (if re
-         re
-         (throw (Exception. (str "Invalid regular expression pattern " s)))))
-     (let [result (c* "pcre_pattern (~{})" s)]
-       (when (has-type? result Array)
-         (let [[msg offset] result]
-           (throw (Exception. (str "Cannot compile pattern " (pr-str s)
-                                   " (" msg "; index " offset ")")))))
-       (Pattern. s result)))))
-
-(if-objc
- (defn- text-checking-result->matches [s num-groups tcr]
-   (let [matches (map (fn [i]
-                        ;; FIXME: handle NSNotFound
-                        (§ s :substringWithRange (§ tcr :rangeAtIndex i)))
-                      (range (inc num-groups)))]
-     (if (zero? num-groups)
-       (first matches)
-       matches)))
- (defn- pcre-match-offsets
-   ([re s offset]
-      (let [offsets (c* "pcre_match_offsets (~{}, ~{}, ~{})" (.-re re) s offset)]
-        (when offsets
-          (if (integer? offsets)
-            (throw (Exception. (str "PCRE search error " offsets " for pattern "
-                                    (pr-str re) " against " (pr-str s)
-                                    " at offset " offset))))
-          offsets)))
-   ([re s]
-      (pcre-match-offsets re s 0))))
-
-(defn- re-offsets->matches
-  "Returns \"whole-match\" if there were no captures, otherwise
-   [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
-  [s offsets]
-  (if (= 2 (count offsets))
-    (apply subs s offsets)
-    (map #(apply subs s %)
-         (partition-all 2 offsets))))
-
-(def ^:private re-first-match-range
-  (if-objc
-   (fn [re s offset]
-     (let [string-length (§ s :length)
-           range-length (- string-length offset)
-           tcr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange offset range-length))]
-       (when tcr
-         (mapcat (fn [i]
-                   (let [match-location (c* "make_integer ([objc_object_get (~{}) rangeAtIndex: integer_get (~{})].location)" tcr i)
-                         match-length (c* "make_integer ([objc_object_get (~{}) rangeAtIndex: integer_get (~{})].length)" tcr i)]
-                     [match-location (+ match-location match-length)]))
-                 (range (§ tcr :numberOfRanges))))))
-   pcre-match-offsets))
-
-(defn re-seq
-  "Returns a lazy sequence of successive matches of regex re in string s.
-   Each match will be \"whole-match\" if re has no captures, otherwise
-   [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
-  [re s]
-  (if-objc
-   (let [num-groups (§ re :numberOfCaptureGroups)
-         string-length (§ s :length)
-         tcrs (§ re :matchesInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))]
-     (map #(text-checking-result->matches s num-groups %) tcrs))
-   (when-let [offsets (pcre-match-offsets re s)]
-     (lazy-seq
-      (cons (re-offsets->matches s offsets)
-            (re-seq re (subs s (max 1 (nth offsets 1)))))))))
-
-(defn re-find
-  "Returns the first match for regex re in string s or nil.  The
-   match, if any, will be \"whole-match\" if re has no captures,
-   otherwise [\"whole-match\" \"capture-1\" \"capture-2\" ...]."
-  [re s]
-  (first (re-seq re s)))
-
-(defn re-matches
-  "Returns the match for regex re in string s, if and only if re
-   matches s completely.  The match, if any, will be \"whole-match\"
-   if re has no captures, otherwise [\"whole-match\" \"capture-1\"
-   \"capture-2\" ...]."
-  [re s]
-  (if-objc
-   (let [num-groups (§ re :numberOfCaptureGroups)
-         string-length (§ s :length)
-         tcr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))
-         matched (and tcr (c* "make_boolean ([objc_object_get (~{}) range].location != NSNotFound)" tcr))]
-     (when matched
-       (let [match-location (c* "make_integer ([objc_object_get (~{}) range].location)" tcr)
-             match-length (c* "make_integer ([objc_object_get (~{}) range].length)" tcr)]
-         (when (and (= match-location 0) (= match-length string-length))
-           (text-checking-result->matches s num-groups tcr)))))
-   (let [offsets (pcre-match-offsets re s)]
-     (when (and offsets (= (count s) (- (nth offsets 1) (nth offsets 0))))
-       (re-offsets->matches s offsets)))))
-
-(defn re-partition
-  "Splits the string into a lazy sequence of substrings, alternating
-   between substrings that match the pattern and the substrings
-   between the matches.  The sequence always starts with the substring
-   before the first match, or an empty string if the beginning of the
-   string matches.
-
-   For example: (re-partition #\"[a-z]+\" \"abc123def\")
-
-   Returns: (\"\" \"abc\" \"123\" \"def\")"
-  ;; This is modeled after clojure-contrib.str-util/partition, but
-  ;; behaves differently in part due to the fact that PCRE matches
-  ;; differently.  For example, with PCRE the empty string matches
-  ;; nothing.  In Java, it matches everything.
-  [re s]
-  (let [s-len (count s)]
-    ((fn step [prev-end search-i]
-       (lazy-seq
-        (if-let [offsets (re-first-match-range re s search-i)]
-          (let [[match-start match-end] offsets
-                matches (re-offsets->matches s offsets)]
-            (cons (subs s prev-end match-start)
-                  (cons matches
-                        (step match-end
-                              (if (= match-start match-end)
-                                (inc match-end)
-                                match-end)))))
-          (when (< prev-end s-len)
-            (list (subs s prev-end))))))
-     0 0)))
-
 (ns cljc.string)
 
 (def split
@@ -6287,6 +6958,23 @@ reduces them without incurring seq initialization"
   [s]
   (split s (re-pattern "\r?\n")))
 
+(defn ^String join
+  "Returns a string of all elements in coll, as returned by (seq coll),
+separated by an optional separator."
+  {:added "1.2"}
+  ([coll]
+     (apply str coll))
+  ([separator coll]
+     (loop [sb (sb-make (str (first coll)))
+            more (next coll)
+            sep (str separator)]
+       (if more
+         (recur (-> sb (-append! sep) (-append! (str (first more))))
+                (next more)
+                sep)
+         (str sb)))))
+
+
 (defn index-of
   "Returns the first index of needle in haystack, or nil.  A negative
    offset is treated as zero, and an offset greater than the string
@@ -6337,7 +7025,7 @@ reduces them without incurring seq initialization"
           (fn [match]
             (let [match-item (vec match)]
               (loop [parts replacement-parts
-                     result (sb-make "")]
+                     result (sb-make)]
                 (if-not (seq parts)
                   (-to-string result)
                   (let [[part & remainder] parts]
@@ -6380,7 +7068,7 @@ reduces them without incurring seq initialization"
          s-len (count s)]
      (loop [offset 0
             prev-match-end 0
-            result (sb-make "")]
+            result (sb-make)]
        (if-let [match-pos (index-of s match offset)]
          (let [result (-> result
                           (-append! (subs s prev-match-end match-pos))
@@ -6400,7 +7088,7 @@ reduces them without incurring seq initialization"
      (let [s-len (count s)]
        (loop [offset 0
               prev-match-end 0
-              result (sb-make "")]
+              result (sb-make)]
          (if (> offset s-len)
            (-to-string (-append! result (subs s prev-match-end)))
            (if-let [match-offsets (re-first-match-range match s offset)]
diff --git a/src/cljc/cljc/reader.cljc b/src/cljc/cljc/reader.cljc
index 85bc81c..2166001 100644
--- a/src/cljc/cljc/reader.cljc
+++ b/src/cljc/cljc/reader.cljc
@@ -147,7 +147,7 @@ nil if the end of stream has been reached")
             radix (nth a 1)]
         (if (nil? n)
           nil
-                                        ; TODO radix
+                                        ; TODO
           #_(* negate (string/parse-integer n radix))
           (* negate (string/parse-integer n)))))))
 
@@ -160,7 +160,7 @@ nil if the end of stream has been reached")
      (/ (string/parse-integer numinator) (string/parse-integer denominator))))
 
  (defn- match-float
-   ; TODO possibly need extension of underlying strtod
+   ; TODO probably need extension of underlying strtod
    [s]
    (let [groups (re-find* float-pattern s)
          group1 (nth groups 0)]
@@ -171,9 +171,10 @@ nil if the end of stream has been reached")
 
  (defn- re-matches*
    [re s]
+   (println "re: " re " " s)
    (let [dirt-matches (re-seq re s)
          [matches] dirt-matches]
-     #_(println "matches: " dirt-matches)
+;     (println "matches: " dirt-matches)
      (when (and (not (nil? matches))
                 (= (nth matches 0) s))
        (if (== (count matches) 1)
@@ -334,7 +335,7 @@ nil if the end of stream has been reached")
 
  (defn read-string*
    [reader _]
-   (loop [buffer (sb-make "") #_(gstring/StringBuffer.)
+   (loop [buffer (sb-make)
           ch (read-char reader)]
      (cond
       (nil? ch) (reader-error reader "EOF while reading")
@@ -441,11 +442,11 @@ nil if the end of stream has been reached")
  ;; omitted by design: var reader, eval reader
  (defn dispatch-macros [s]
    (cond
-    (= s "{") read-set
-    (= s "<") (throwing-reader "Unreadable form")
-    (= s "\"") read-regex
-    (= s"!") read-comment
-    (= s "_") read-discard
+    (= s \{) read-set
+    (= s \<) (throwing-reader "Unreadable form")
+    (= s \") read-regex
+    (= s \!) read-comment
+    (= s \_) read-discard
     :else nil))
 
  (defn read
@@ -570,8 +571,7 @@ nil if the end of stream has been reached")
 (defn ^:private read-uuid
   [uuid]
   (if (string? uuid)
-    "TODO UUID"
-    #_(UUID. uuid)
+    (UUID. uuid)
     (reader-error nil "UUID literal expects a string as its representation.")))
 
 (def *tag-table* (atom {"inst"  read-date

From ad0e353c6790031a1e24c41e8e4d56c8effc7a96 Mon Sep 17 00:00:00 2001
From: Mark Probst <mark.probst@gmail.com>
Date: Sun, 29 Sep 2013 13:39:53 -0700
Subject: [PATCH 6/8] Init the cljc.core and cljc.objc namespaces first.

---
 src/clj/cljc/driver.clj | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/clj/cljc/driver.clj b/src/clj/cljc/driver.clj
index 7493eac..8a1b66b 100644
--- a/src/clj/cljc/driver.clj
+++ b/src/clj/cljc/driver.clj
@@ -166,15 +166,15 @@
   (str (cljc/munge namespace) "-exports.clj"))
 
 (defn spit-driver [init-name main-name with-core out-dir]
-  (let [used-namespaces (concat (if init-name
-                                  []
-                                  [(namespace main-name)])
-                                (if with-core
+  (let [used-namespaces (concat (if with-core
                                   ['cljc.core]
                                   [])
                                 (if (and with-core (:objc *build-options*))
                                   ['cljc.objc]
-                                  []))
+                                  [])
+                                (if init-name
+                                  []
+                                  [(namespace main-name)]))
         main-string (standard-init-or-main-function nil main-name
                                                     (if init-name
                                                       (str init-name " ();\n")

From 66a41a42d9b9dc1fc958f86bd0a8f32063a4bc79 Mon Sep 17 00:00:00 2001
From: Mark Probst <mark.probst@gmail.com>
Date: Sun, 29 Sep 2013 13:40:28 -0700
Subject: [PATCH 7/8] Make the metacircular interpreter build.

---
 samples/build-metacircular.sh | 32 ++++++++++++++++++++++++++++++++
 src/cljc/cljc/reader.cljc     | 33 ++++++++++++++++-----------------
 2 files changed, 48 insertions(+), 17 deletions(-)
 create mode 100755 samples/build-metacircular.sh

diff --git a/samples/build-metacircular.sh b/samples/build-metacircular.sh
new file mode 100755
index 0000000..ece5a27
--- /dev/null
+++ b/samples/build-metacircular.sh
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+LEIN=lein
+
+cd ..
+
+echo Compiling cljc.core
+"$LEIN" run -c src/cljc/cljc/core.cljc cljc.core run/c run
+if [ $? -ne 0 ] ; then
+    exit 1
+fi
+
+echo Compiling cljc.reader
+"$LEIN" run -c src/cljc/cljc/reader.cljc cljc.reader run/c run
+if [ $? -ne 0 ] ; then
+    exit 1
+fi
+
+echo Compiling sample.metacircular
+"$LEIN" run -c samples/metacircular.cljc sample.metacircular run/c run
+if [ $? -ne 0 ] ; then
+    exit 1
+fi
+
+echo Generating driver
+"$LEIN" run -d sample.metacircular/-main run/c
+if [ $? -ne 0 ] ; then
+    exit 1
+fi
+
+cd run/c
+make
diff --git a/src/cljc/cljc/reader.cljc b/src/cljc/cljc/reader.cljc
index 85bc81c..ee87a78 100644
--- a/src/cljc/cljc/reader.cljc
+++ b/src/cljc/cljc/reader.cljc
@@ -7,7 +7,6 @@
 ;   You must not remove this notice, or any other, from this software.
 
 (ns cljc.reader
-  (:require [cljc.string :as string])
   #_(:require [goog.string :as gstring]))
 
 
@@ -43,8 +42,8 @@ nil if the end of stream has been reached")
 (defn- ^boolean whitespace?
   "Checks whether a given character is whitespace"
   [ch]
-  (string/blank-char? ch)
-  #_(or #_(gstring/isBreakingWhitespace ch)
+  (cljc.string/blank-char? ch)
+  #_(or #_(gcljc.string/isBreakingWhitespace ch)
       (= " " ch)
       (= \n ch)
       (= \r ch)
@@ -141,15 +140,15 @@ nil if the end of stream has been reached")
                (nth groups 3) (array (nth groups 3) 10)
                (nth groups 4) (array (nth groups 4) 16)
                (nth groups 5) (array (nth groups 5) 8)
-               (nth groups 7) (array (nth groups 7) (string/parse-integer (nth groups 7)))
+               (nth groups 7) (array (nth groups 7) (cljc.string/parse-integer (nth groups 7)))
                :default (array nil nil))
             n (nth a 0)
             radix (nth a 1)]
         (if (nil? n)
           nil
                                         ; TODO radix
-          #_(* negate (string/parse-integer n radix))
-          (* negate (string/parse-integer n)))))))
+          #_(* negate (cljc.string/parse-integer n radix))
+          (* negate (cljc.string/parse-integer n)))))))
 
 
  (defn- match-ratio
@@ -157,7 +156,7 @@ nil if the end of stream has been reached")
    (let [groups (re-find* ratio-pattern s)
          numinator (nth groups 1)
          denominator (nth groups 2)]
-     (/ (string/parse-integer numinator) (string/parse-integer denominator))))
+     (/ (cljc.string/parse-integer numinator) (cljc.string/parse-integer denominator))))
 
  (defn- match-float
    ; TODO possibly need extension of underlying strtod
@@ -166,7 +165,7 @@ nil if the end of stream has been reached")
          group1 (nth groups 0)]
     (if-not (or (nil? group1)
             (< (count group1) 1))
-      (string/parse-float s)))
+      (cljc.string/parse-float s)))
    #_(js/parseFloat s))
 
  (defn- re-matches*
@@ -228,7 +227,7 @@ nil if the end of stream has been reached")
 
  (defn make-unicode-char [code-str]
    "TODO UNICODE"
-     #_(let [code (string/parse-integer code-str 16)]
+     #_(let [code (cljc.string/parse-integer code-str 16)]
        (.fromCharCode js/String code)))
 
  (defn escape-char
@@ -334,7 +333,7 @@ nil if the end of stream has been reached")
 
  (defn read-string*
    [reader _]
-   (loop [buffer (sb-make "") #_(gstring/StringBuffer.)
+   (loop [buffer (sb-make "") #_(gcljc.string/StringBuffer.)
           ch (read-char reader)]
      (cond
       (nil? ch) (reader-error reader "EOF while reading")
@@ -351,14 +350,14 @@ nil if the end of stream has been reached")
     :else not-found))
 
  (defn- contains
-   ([s t] (not (nil? (string/index-of s t)))))
+   ([s t] (not (nil? (cljc.string/index-of s t)))))
 
  (defn read-symbol
    [reader initch]
    (let [token (read-token reader initch)]
      (if (contains token "/")
-       (symbol (subs token 0 (string/index-of token "/"))
-               (subs token (inc (string/index-of token "/")) (count token)))
+       (symbol (subs token 0 (cljc.string/index-of token "/"))
+               (subs token (inc (cljc.string/index-of token "/")) (count token)))
        (special-symbols token (symbol token)))))
 
  (defn read-keyword
@@ -371,10 +370,10 @@ nil if the end of stream has been reached")
      (if (or (and (not (empty? ns)) ; was js undefined?
                   (= (subs ns (- (count ns) 2) (count ns)) ":/"))
              (= (nth name (dec (count name))) ":")
-             (not (nil? (string/index-of token "::" 1))))
+             (not (nil? (cljc.string/index-of token "::" 1))))
        (reader-error reader "Invalid token: " token)
        (if (and (not (empty? ns)) (> (count ns) 0))
-         (keyword (subs ns 0 (string/index-of ns "/")) name)
+         (keyword (subs ns 0 (cljc.string/index-of ns "/")) name)
          (keyword token)))))
 
  (defn desugar-meta
@@ -507,8 +506,8 @@ nil if the end of stream has been reached")
  (def ^:private timestamp-regex #"(\d\d\d\d)(?:-(\d\d)(?:-(\d\d)(?:[T](\d\d)(?::(\d\d)(?::(\d\d)(?:[.](\d+))?)?)?)?)?)?(?:[Z]|([-+])(\d\d):(\d\d))?")
 
  (defn ^:private parse-int [s]
-   (string/parse-integer s)
-   #_(let [n (string/parse-integer s)]
+   (cljc.string/parse-integer s)
+   #_(let [n (cljc.string/parse-integer s)]
     (if-not (js/isNaN n)
       n)))
 

From 0f32aa8c2650f767d3558d85a10f510f964bae1a Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian_weilbach@web.de>
Date: Tue, 1 Oct 2013 18:57:36 +0200
Subject: [PATCH 8/8] Intern symbols and keywords again.

Make cljc.string/index-of function return -1 instead of nil for
"not-found" similar to Java and JavaScript. Analyzing of quoted
expressions seems to work basically.
---
 samples/metacircular.cljc |  8 ++++++--
 src/c/cljc.h              |  2 --
 src/c/runtime.c           | 16 +++++++++-------
 src/cljc/cljc/core.cljc   | 32 ++++++++++++++++----------------
 src/cljc/cljc/reader.cljc |  8 +++-----
 5 files changed, 34 insertions(+), 32 deletions(-)

diff --git a/samples/metacircular.cljc b/samples/metacircular.cljc
index 272818b..4538a2f 100644
--- a/samples/metacircular.cljc
+++ b/samples/metacircular.cljc
@@ -71,8 +71,12 @@
 (defn self-evaluating? [exp]
   (cond (number? exp) true
         (string? exp) true
-        (vector? exp) true ; TODO remove after
-        (map? exp) true ; analyzer testing
+        ; TODO remove after analyzer testing
+        (vector? exp) true
+        (map? exp) true
+        (set? exp) true
+        (keyword? exp) true
+        (satisfies? IPattern exp) true
         :else false))
 
 (defn quoted? [exp]
diff --git a/src/c/cljc.h b/src/c/cljc.h
index 064f5ce..57b0a8a 100644
--- a/src/c/cljc.h
+++ b/src/c/cljc.h
@@ -285,12 +285,10 @@ extern value_t* make_string_from_unichar (cljc_unichar_t c);
 extern value_t* make_string_from_buf (const char *start, const char *end);
 extern const char* string_get_utf8 (value_t *v);
 extern uint32_t string_hash_code (const char *utf8);
-extern value_t* make_symbol (const char *utf8);
 extern value_t* intern_symbol (const char *utf8, bool copy);
 extern const char* symbol_get_utf8 (value_t *v);
 extern value_t* symbol_get_name (value_t *v);
 extern value_t* symbol_get_namespace (value_t *v);
-extern value_t* make_keyword (const char *utf8);
 extern value_t* intern_keyword (const char *utf8, bool copy);
 extern const char* keyword_get_utf8 (value_t *v);
 extern value_t* keyword_get_name (value_t *v);
diff --git a/src/c/runtime.c b/src/c/runtime.c
index 22117c4..5eff615 100644
--- a/src/c/runtime.c
+++ b/src/c/runtime.c
@@ -580,12 +580,12 @@ string_hash_code (const char *utf8)
         return hashmurmur3_32(utf8, len);
 }
 
-value_t* // was static symbol_t*
+static symbol_t*
 make_symbol (const char *utf8)
 {
 	symbol_t *sym = (symbol_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Symbol), sizeof (symbol_t));
 	sym->utf8 = strdup( utf8 );
-	return &sym->val;
+	return sym;
 }
 
 KHASH_MAP_INIT_STR (SYMBOLS, symbol_t*);
@@ -620,12 +620,12 @@ symbol_get_utf8 (value_t *v)
 	return s->utf8;
 }
 
-value_t*
+static keyword_t*
 make_keyword (const char *utf8)
 {
 	keyword_t *kw = (keyword_t*)alloc_value_retired (PTABLE_NAME (cljc_DOT_core_SLASH_Keyword), sizeof (keyword_t));
 	kw->utf8 = utf8;
-	return &kw->val;
+	return kw;
 }
 
 KHASH_MAP_INIT_STR (KEYWORDS, keyword_t*);
@@ -950,8 +950,10 @@ string_index_of (value_t *haystack, value_t *needle, value_t *offset)
 {
 	// FIXME: adjust for string length caching when available.
 	long long c_off = integer_get (offset);
+        value_t* not_found = make_integer( -1 );
+
 	if (c_off > LONG_MAX)
-		return value_nil;
+		return not_found;
 	if (c_off < 0)
 		c_off = 0;
 
@@ -972,7 +974,7 @@ string_index_of (value_t *haystack, value_t *needle, value_t *offset)
 			if (g_utf8_strlen (c_needle, -1) == 0)
 				return make_integer (hay_len);
 			else
-				return value_nil;
+				return not_found;
 		}
 		// FIXME: step backwards if c_off is in the last 1/4 of string.
 		start = g_utf8_offset_to_pointer (c_hay, c_off);
@@ -988,7 +990,7 @@ string_index_of (value_t *haystack, value_t *needle, value_t *offset)
 	if (g_utf8_strlen (c_needle, -1) == 0)
 		return make_integer (hay_len);
 	else
-		return value_nil;
+		return not_found;
 }
 
 ////////////////////////////////////////////////////////////
diff --git a/src/cljc/cljc/core.cljc b/src/cljc/cljc/core.cljc
index 0abaa1b..9f7ac2c 100644
--- a/src/cljc/cljc/core.cljc
+++ b/src/cljc/cljc/core.cljc
@@ -896,19 +896,18 @@ reduces them without incurring seq initialization"
   (has-type? s Symbol))
 
 (declare str)
+(declare println)
 (defn keyword
   "Returns a Keyword with the given namespace and name.  Do not use :
   in the keyword strings, it will be added automatically."
-  ([name] (c* "make_keyword( string_get_utf8(~{}) )" (if (symbol? name)
-                                                       (name name)
-                                                       name))
-     #_(cond ; TODO
-      (keyword? name) (Keyword. nil name name nil)
-      (symbol? name) (Keyword. nil (name name) (name name) nil)
-      :else (Keyword. nil name name nil)))
-  ([ns name] (c* "make_keyword( string_get_utf8(~{}) )" (str ns "/" name))
-     #_(Keyword. ns name (str (when ns (str ns "/")) name) nil)))
-
+  ([name]
+     (if (keyword? name)
+       name
+       (let [name (str name)]
+         (c* "intern_keyword( string_get_utf8(~{}), true )" name))))
+  ([ns name]
+     (println "creating keyword: " name " with ns: " ns)
+     (c* "intern_keyword( string_get_utf8(~{}), true )" (str (when ns (str ns "/")) name))))
 
 
 
@@ -918,10 +917,10 @@ reduces them without incurring seq initialization"
        name
        (symbol nil name)))
   ([ns name]
-     (let [sym-str (if-not (nil? ns)
+     (let [sym-str (if-not (or (nil? ns) (empty? ns))
                      (str ns "/" name)
                      name)]
-       (c* "make_symbol( string_get_utf8( ~{} ))" sym-str))))
+       (c* "intern_symbol( string_get_utf8(~{}), true )" sym-str))))
 
 
 
@@ -5674,7 +5673,7 @@ reduces them without incurring seq initialization"
   (if-objc
    (let [num-groups (§ re :numberOfCaptureGroups)
          string-length (§ s :length)
-         tcr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))
+         ecr (§ re :firstMatchInString s :options 0 :range (UIKit/NSMakeRange 0 string-length))
          matched (and tcr (c* "make_boolean ([objc_object_get (~{}) range].location != NSNotFound)" tcr))]
      (when matched
        (let [match-location (c* "make_integer ([objc_object_get (~{}) range].location)" tcr)
@@ -6976,7 +6975,7 @@ separated by an optional separator."
 
 
 (defn index-of
-  "Returns the first index of needle in haystack, or nil.  A negative
+  "Returns the first index of needle in haystack, or -1.  A negative
    offset is treated as zero, and an offset greater than the string
    length is treated as the string length."
   ([haystack needle offset]
@@ -6990,8 +6989,9 @@ separated by an optional separator."
                                   :options UIKit/NSLiteralSearch
                                   :range (UIKit/NSMakeRange offset len))
                 found-offset (c* "make_integer (((NSRange*)compound_get_data_ptr (~{}))->location)" range)]
-            (when (not= found-offset UIKit/NSNotFound)
-              found-offset))))
+            (if (not= found-offset UIKit/NSNotFound)
+              found-offset
+              -1))))
       (c* "string_index_of (~{}, ~{}, ~{})" haystack needle offset)))
   ([haystack needle]
      (index-of haystack needle 0)))
diff --git a/src/cljc/cljc/reader.cljc b/src/cljc/cljc/reader.cljc
index e28a8de..2b3ca6e 100644
--- a/src/cljc/cljc/reader.cljc
+++ b/src/cljc/cljc/reader.cljc
@@ -170,10 +170,8 @@ nil if the end of stream has been reached")
 
  (defn- re-matches*
    [re s]
-   (println "re: " re " " s)
-   (let [dirt-matches (re-seq re s)
-         [matches] dirt-matches]
-;     (println "matches: " dirt-matches)
+   ; why are the matches in a double seq?
+   (let [[matches] (re-seq re s)]
      (when (and (not (nil? matches))
                 (= (nth matches 0) s))
        (if (== (count matches) 1)
@@ -371,7 +369,7 @@ nil if the end of stream has been reached")
      (if (or (and (not (empty? ns)) ; was js undefined?
                   (= (subs ns (- (count ns) 2) (count ns)) ":/"))
              (= (nth name (dec (count name))) ":")
-             (not (nil? (cljc.string/index-of token "::" 1))))
+             (not (neg? (cljc.string/index-of token "::" 1))))
        (reader-error reader "Invalid token: " token)
        (if (and (not (empty? ns)) (> (count ns) 0))
          (keyword (subs ns 0 (cljc.string/index-of ns "/")) name)