Add one more test for conditionals.

Add one more test for conditionals.

(import [symbol] "../src/ast")
(import [list] "../src/sequence")
(import [self-evaluating? compile macroexpand] "../src/compiler")

(defn transpile
  [form]
  (compile (macroexpand form)))

(.log console "self evaluating forms")
(assert (self-evaluating? 1) "number is self evaluating")
(assert (self-evaluating? "string") "string is self evaluating")
(assert (self-evaluating? true) "true is boolean => self evaluating")
(assert (self-evaluating? false) "false is boolean => self evaluating")
(assert (self-evaluating?) "no args is nil => self evaluating")
(assert (self-evaluating? nil) "nil is self evaluating")
(assert (self-evaluating? :keyword) "keyword is self evaluating")
(assert (not (self-evaluating? ':keyword)) "quoted keyword not self evaluating")
(assert (not (self-evaluating? (list))) "list is not self evaluating")
(assert (not (self-evaluating? self-evaluating?)) "fn is not self evaluating")
(assert (not (self-evaluating? (symbol "symbol"))) "symbol is not self evaluating")

(.log console "compile primitive forms")

(assert (= (transpile '(def x)) "var x = void(0)")
        "def compiles properly")
(assert (= (transpile '(def y 1)) "var y = 1")
        "def with two args compiled properly")
(assert (= (transpile ''(def x 1)) "list(\"\uFEFFdef\", \"\uFEFFx\", 1)")
        "quotes preserve lists")

(.log console "compile invoke forms")
(assert (identical? (transpile '(foo)) "foo()")
        "function calls compile")
(assert (identical? (transpile '(foo bar)) "foo(bar)")
        "function calls with single arg compile")
(assert (identical? (transpile '(foo bar baz)) "foo(bar, baz)")
        "function calls with multi arg compile")
(assert (identical? (transpile '(foo ((bar baz) beep)))
                    "foo((bar(baz))(beep))")
        "nested function calls compile")

(.log console "compile functions")

(assert (identical? (transpile '(fn [x] x))
                    "function(x) {\n  return x;\n}")
        "function compiles")
(assert (identical? (transpile '(fn [x] (def y 1) (foo x y)))
                    "function(x) {\n  var y = 1;\n  return foo(x, y);\n}")
        "function with multiple statements compiles")
(assert (identical? (transpile '(fn identity [x] x))
                    "function identity(x) {\n  return x;\n}")
        "named function compiles")
(assert (identical? (transpile '(fn a "docs docs" [x] x))
                    "function a(x) {\n  return x;\n}")
        "fn docs are supported")
(assert (identical? (transpile '(fn "docs docs" [x] x))
                    "function(x) {\n  return x;\n}")
        "fn docs for anonymous functions are supported")

(assert (identical? (transpile '(fn foo? ^boolean [x] true))
                    "function isFoo(x) {\n  return true;\n}")
        "metadata is supported")

(assert (identical? (transpile '(fn [a & b] a))
"function(a) {
  var b = Array.prototype.slice.call(arguments, 1);
  return a;
}") "function with variadic arguments")

(assert (identical? (transpile '(fn [& a] a))
"function() {
  var a = Array.prototype.slice.call(arguments, 0);
  return a;
}") "function with all variadic arguments")

(assert (identical? (transpile '(fn
                                  ([] 0)
                                  ([x] x)))
"function(x) {
  switch (arguments.length) {
    case 0:
      return 0;
    case 1:
      return x;

    default:
      (function() { throw Error(\"Invalid arity\"); })()
  };
  return void(0);
}") "function with overloads")

(assert (identical? (transpile
'(fn sum
  "doc"
  {:version "1.0"}
  ([] 0)
  ([x] x)
  ([x y] (+ x y))
  ([x & rest] (reduce rest sum x))))

"function sum(x, y) {
  switch (arguments.length) {
    case 0:
      return 0;
    case 1:
      return x;
    case 2:
      return x + y;

    default:
      var rest = Array.prototype.slice.call(arguments, 1);
      return reduce(rest, sum, x);
  };
  return void(0);
}") "function with overloads docs & metadata")

(.log console "compile if special form")

(assert (identical? (transpile '(if foo (bar)))
                    "foo ?\n  bar() :\n  void(0)")
        "if compiles")

(assert (identical? (transpile '(if foo (bar) baz))
                    "foo ?\n  bar() :\n  baz")
        "if-else compiles")

(assert (identical? (transpile '(if monday? (.log console "monday")))
                    "isMonday ?\n  console.log(\"monday\") :\n  void(0)")
        "macros inside blocks expand properly")

(.log console "compile do special form")

(assert (identical? (transpile '(do (foo bar) bar))
                    "(function() {\n  foo(bar);\n  return bar;\n})()")
        "do compiles")
(assert (identical? (transpile '(do))
                    "(function() {\n  return void(0);\n})()")
        "empty do compiles")

(.log console "compile let special form")

(assert (identical? (transpile '(let [] x))
                    "(function() {\n  return x;\n})()")
        "let bindings compiles properly")
(assert (identical?
         (transpile '(let [x 1 y 2] x))
         "(function() {\n  var x = 1;\n  var y = 2;\n  return x;\n})()")
        "let with bindings compiles properly")

(.log console "compile throw special form")

(assert (identical? (transpile '(throw error))
                    "(function() { throw error; })()")
        "throw reference compiles")

(assert (identical? (transpile '(throw (Error message)))
                    "(function() { throw Error(message); })()")
        "throw expression compiles")

(assert (identical? (transpile '(throw "boom"))
                    "(function() { throw \"boom\"; })()")
        "throw string compile")

(.log console "compile set! special form")

(assert (identical? (transpile '(set! x 1))
                    "x = 1")
        "set! compiles")

(assert (identical? (transpile '(set! x (foo bar 2)))
                    "x = foo(bar, 2)")
        "set! with value expression compiles")

(assert (identical? (transpile '(set! x (.m o)))
                    "x = o.m()")
        "set! expands macros")

(.log console "compile vectors")

(assert (identical? (transpile '[a b]) "[a, b]")
        "vector compiles")

(assert (identical? (transpile '[a (b c)]) "[a, b(c)]")
        "vector of expressions compiles")

(assert (identical? (transpile '[]) "[]")
        "empty vector compiles")

(.log console "compiles try special form")

(assert (identical?
         (transpile '(try (m 1 0) (catch e e)))
         "(function() {\ntry {\n  return m(1, 0);\n} catch (e) {\n  return e;\n}})()")
        "try / catch compiles")

(assert (identical?
         (transpile '(try (m 1 0) (finally 0)))
         "(function() {\ntry {\n  return m(1, 0);\n} finally {\n  return 0;\n}})()")
        "try / finally compiles")

(assert (identical?
         (transpile '(try (m 1 0) (catch e e) (finally 0)))
         "(function() {\ntry {\n  return m(1, 0);\n} catch (e) {\n  return e;\n} finally {\n  return 0;\n}})()")
        "try / catch / finally compiles")

(.log console "compile property / method access / call special forms")

(assert (identical? (transpile '(.log console message))
                    "console.log(message)")
        "method call compiles correctly")
(assert (identical? (transpile '(.-location window))
                    "window.location")
        "property access compiles correctly")
(assert (identical? (transpile '(.-foo? bar))
                    "bar.isFoo")
        "property access compiles naming conventions")
(assert (identical? (transpile '(.-location (.open window url)))
                    "(window.open(url)).location")
        "compound property access and method call")
(assert (identical? (transpile '(.slice (.splice arr 0)))
                    "arr.splice(0).slice()")
        "(.slice (.splice arr 0)) => arr.splice(0).slice()")
(assert (identical? (transpile '(.a (.b "/")))
                    "\"/\".b().a()")
        "(.a (.b \"/\")) => \"/\".b().a()")

(.log console "compile unquote-splicing forms")

(assert (identical? (transpile '`(1 ~@'(2 3)))
                    "concat(list(1), list(2, 3))")
        "list unquote-splicing compiles")
(assert (identical? (transpile '`())
                    "list()")
         "empty list unquotes to empty list")

(assert (identical? (transpile '`[1 ~@[2 3]])
                    "vec(concat([1], [2, 3]))")
        "vector unquote-splicing compiles")

(assert (identical? (transpile '`[])
                    "[]")
        "syntax-quoted empty vector compiles to empty vector")

(.log console "compile references")

(assert (identical? (transpile '(set! **macros** []))
                    "__macros__ = []")
        "**macros** => __macros__")
(assert (identical?
         (transpile '(fn vector->list [v] (make list v)))
         "function vectorToList(v) {\n  return make(list, v);\n}")
        "list->vector => listToVector")
(assert (identical? (transpile '(swap! foo bar))
                    "swap(foo, bar)")
        "set! => set")

;(assert (identical? (transpile '(let [raw% foo-bar] raw%))
;                     "swap(foo, bar)")
;          "set! => set")

(assert (identical? (transpile '(def under_dog))
                    "var under_dog = void(0)")
        "foo_bar => foo_bar")
(assert (identical? (transpile '(digit? 0))
                    "isDigit(0)")
        "number? => isNumber")

(assert (identical? (transpile '(create-server options))
                    "createServer(options)")
        "create-server => createServer")

(assert (identical? (transpile '(.create-server http options))
                    "http.createServer(options)")
        "http.create-server => http.createServer")

(.log console "compiles new special form")

(assert (identical? (transpile '(new Foo)) "new Foo()")
        "(new Foo) => new Foo()")
(assert (identical? (transpile '(Foo.)) "new Foo()")
        "(Foo.) => new Foo()")
(assert (identical? (transpile '(new Foo a b)) "new Foo(a, b)")
        "(new Foo a b) => new Foo(a, b)")
(assert (identical? (transpile '(Foo. a b)) "new Foo(a, b)")
        "(Foo. a b) => new Foo(a, b)")

(.log console "compiles native special forms: and or + * - / not")

(assert (identical? (transpile '(and a b)) "a && b")
        "(and a b) => a && b")
(assert (identical? (transpile '(and a b c)) "a && b && c")
        "(and a b c) => a && b && c")
(assert (identical? (transpile '(and a (or b c))) "a && (b || c)")
        "(and a (or b c)) => a && (b || c)")
(assert (identical?
        "(a > b) && (c > d) ?\n  x :\n  y"
        (transpile '(if (and (> a b) (> c d)) x y))))

(assert (identical?
         (transpile '(and a (or b (or c d)))) "a && (b || (c || d))")
        "(and a (or b (or c d))) => a && (b || (c || d))")
(assert (identical? (transpile '(not x)) "!(x)")
        "(not x) => !(x)")
(assert (identical? (transpile '(not (or x y))) "!(x || y)")
        "(not x) => !(x)")

(.log console "compiles = == >= <= special forms")

(assert (identical? (transpile '(= a b)) "a == b")
        "(= a b) => a == b")
(assert (identical? (transpile '(= a b c)) "a == b && b == c")
        "(= a b c) => a == b && b == c")
(assert (identical? (transpile '(< a b c)) "a < b && b < c")
        "(< a b c) => a < b && b < c")
(assert (identical? (transpile '(identical? a b c)) "a === b && b === c")
        "(identical? a b c) => a === b && b === c")
(assert (identical? (transpile '(>= (.index-of arr el) 0))
                    "arr.indexOf(el) >= 0")
        "(>= (.index-of arr el) 0) => arr.indexOf(el) >= 0")

(.log console "compiles dictionaries to js objects")

(assert (identical? (transpile '{}) "{}")
        "empty hash compiles to empty object")
(assert (identical? (transpile '{ :foo 1 }) "{\n  \"foo\": 1\n}")
        "compile dictionaries to js objects")

(assert (identical?
         (transpile '{:foo 1 :bar (a b) :bz (fn [x] x) :bla { :sub 2 }})
"{
  \"foo\": 1,
  \"bar\": a(b),
  \"bz\": function(x) {
    return x;
  },
  \"bla\": {
    \"sub\": 2
  }
}") "compile nested dictionaries")

(.log console "compiles compound accessor")

(assert (identical? (transpile '(get a b)) "a[b]")
        "(get a b) => a[b]")
(assert (identical? (transpile '(aget arguments 1)) "arguments[1]")
        "(aget arguments 1) => arguments[1]")
(assert (identical? (transpile '(get (a b) (get c d)))
                    "a(b)[c[d]]")
        "(get (a b) (get c d)) => a(b)[c[d]]")

(.log console "compiles instance?")

(assert (identical? (transpile '(instance? Object a))
                    "a instanceof Object")
        "(instance? Object a) => a instanceof Object")
(assert (identical? (transpile '(instance? (C D) (a b)))
                    "a(b) instanceof C(D)")
        "(instance? (C D) (a b)) => a(b) instanceof C(D)")

(.log console "compile loop")
(assert (identical? (transpile '(loop [x 7] (if (f x) x (recur (b x)))))
"(function loop(x) {
  var recur = loop;
  while (recur === loop) {
    recur = f(x) ?
    x :
    (x = b(x), loop);
  };
  return recur;
})(7)") "single binding loops compile")

(assert (identical? (transpile '(loop [] (if (m?) m (recur))))
"(function loop() {
  var recur = loop;
  while (recur === loop) {
    recur = isM() ?
    m :
    (loop);
  };
  return recur;
})()") "zero bindings loops compile")

(assert
 (identical?
  (transpile '(loop [x 3 y 5] (if (> x y) x (recur (+ x 1) (- y 1)))))
"(function loop(x, y) {
  var recur = loop;
  while (recur === loop) {
    recur = x > y ?
    x :
    (x = x + 1, y = y - 1, loop);
  };
  return recur;
})(3, 5)") "multi bindings loops compile")

(import [symbol] "../src/ast")
(import [list] "../src/sequence")
(import [self-evaluating? compile macroexpand] "../src/compiler")

(defn transpile
  [form]
  (compile (macroexpand form)))

(.log console "self evaluating forms")
(assert (self-evaluating? 1) "number is self evaluating")
(assert (self-evaluating? "string") "string is self evaluating")
(assert (self-evaluating? true) "true is boolean => self evaluating")
(assert (self-evaluating? false) "false is boolean => self evaluating")
(assert (self-evaluating?) "no args is nil => self evaluating")
(assert (self-evaluating? nil) "nil is self evaluating")
(assert (self-evaluating? :keyword) "keyword is self evaluating")
(assert (not (self-evaluating? ':keyword)) "quoted keyword not self evaluating")
(assert (not (self-evaluating? (list))) "list is not self evaluating")
(assert (not (self-evaluating? self-evaluating?)) "fn is not self evaluating")
(assert (not (self-evaluating? (symbol "symbol"))) "symbol is not self evaluating")

(.log console "compile primitive forms")

(assert (= (transpile '(def x)) "var x = void(0)")
        "def compiles properly")
(assert (= (transpile '(def y 1)) "var y = 1")
        "def with two args compiled properly")
(assert (= (transpile ''(def x 1)) "list(\"\uFEFFdef\", \"\uFEFFx\", 1)")
        "quotes preserve lists")

(.log console "compile invoke forms")
(assert (identical? (transpile '(foo)) "foo()")
        "function calls compile")
(assert (identical? (transpile '(foo bar)) "foo(bar)")
        "function calls with single arg compile")
(assert (identical? (transpile '(foo bar baz)) "foo(bar, baz)")
        "function calls with multi arg compile")
(assert (identical? (transpile '(foo ((bar baz) beep)))
                    "foo((bar(baz))(beep))")
        "nested function calls compile")

(.log console "compile functions")

(assert (identical? (transpile '(fn [x] x))
                    "function(x) {\n  return x;\n}")
        "function compiles")
(assert (identical? (transpile '(fn [x] (def y 1) (foo x y)))
                    "function(x) {\n  var y = 1;\n  return foo(x, y);\n}")
        "function with multiple statements compiles")
(assert (identical? (transpile '(fn identity [x] x))
                    "function identity(x) {\n  return x;\n}")
        "named function compiles")
(assert (identical? (transpile '(fn a "docs docs" [x] x))
                    "function a(x) {\n  return x;\n}")
        "fn docs are supported")
(assert (identical? (transpile '(fn "docs docs" [x] x))
                    "function(x) {\n  return x;\n}")
        "fn docs for anonymous functions are supported")

(assert (identical? (transpile '(fn foo? ^boolean [x] true))
                    "function isFoo(x) {\n  return true;\n}")
        "metadata is supported")

(assert (identical? (transpile '(fn [a & b] a))
"function(a) {
  var b = Array.prototype.slice.call(arguments, 1);
  return a;
}") "function with variadic arguments")

(assert (identical? (transpile '(fn [& a] a))
"function() {
  var a = Array.prototype.slice.call(arguments, 0);
  return a;
}") "function with all variadic arguments")

(assert (identical? (transpile '(fn
                                  ([] 0)
                                  ([x] x)))
"function(x) {
  switch (arguments.length) {
    case 0:
      return 0;
    case 1:
      return x;

    default:
      (function() { throw Error(\"Invalid arity\"); })()
  };
  return void(0);
}") "function with overloads")

(assert (identical? (transpile
'(fn sum
  "doc"
  {:version "1.0"}
  ([] 0)
  ([x] x)
  ([x y] (+ x y))
  ([x & rest] (reduce rest sum x))))

"function sum(x, y) {
  switch (arguments.length) {
    case 0:
      return 0;
    case 1:
      return x;
    case 2:
      return x + y;

    default:
      var rest = Array.prototype.slice.call(arguments, 1);
      return reduce(rest, sum, x);
  };
  return void(0);
}") "function with overloads docs & metadata")

(.log console "compile if special form")

(assert (identical? (transpile '(if foo (bar)))
                    "foo ?\n  bar() :\n  void(0)")
        "if compiles")

(assert (identical? (transpile '(if foo (bar) baz))
                    "foo ?\n  bar() :\n  baz")
        "if-else compiles")

(assert (identical? (transpile '(if monday? (.log console "monday")))
                    "isMonday ?\n  console.log(\"monday\") :\n  void(0)")
        "macros inside blocks expand properly")

(.log console "compile do special form")

(assert (identical? (transpile '(do (foo bar) bar))
                    "(function() {\n  foo(bar);\n  return bar;\n})()")
        "do compiles")
(assert (identical? (transpile '(do))
                    "(function() {\n  return void(0);\n})()")
        "empty do compiles")

(.log console "compile let special form")

(assert (identical? (transpile '(let [] x))
                    "(function() {\n  return x;\n})()")
        "let bindings compiles properly")
(assert (identical?
         (transpile '(let [x 1 y 2] x))
         "(function() {\n  var x = 1;\n  var y = 2;\n  return x;\n})()")
        "let with bindings compiles properly")

(.log console "compile throw special form")

(assert (identical? (transpile '(throw error))
                    "(function() { throw error; })()")
        "throw reference compiles")

(assert (identical? (transpile '(throw (Error message)))
                    "(function() { throw Error(message); })()")
        "throw expression compiles")

(assert (identical? (transpile '(throw "boom"))
                    "(function() { throw \"boom\"; })()")
        "throw string compile")

(.log console "compile set! special form")

(assert (identical? (transpile '(set! x 1))
                    "x = 1")
        "set! compiles")

(assert (identical? (transpile '(set! x (foo bar 2)))
                    "x = foo(bar, 2)")
        "set! with value expression compiles")

(assert (identical? (transpile '(set! x (.m o)))
                    "x = o.m()")
        "set! expands macros")

(.log console "compile vectors")

(assert (identical? (transpile '[a b]) "[a, b]")
        "vector compiles")

(assert (identical? (transpile '[a (b c)]) "[a, b(c)]")
        "vector of expressions compiles")

(assert (identical? (transpile '[]) "[]")
        "empty vector compiles")

(.log console "compiles try special form")

(assert (identical?
         (transpile '(try (m 1 0) (catch e e)))
         "(function() {\ntry {\n  return m(1, 0);\n} catch (e) {\n  return e;\n}})()")
        "try / catch compiles")

(assert (identical?
         (transpile '(try (m 1 0) (finally 0)))
         "(function() {\ntry {\n  return m(1, 0);\n} finally {\n  return 0;\n}})()")
        "try / finally compiles")

(assert (identical?
         (transpile '(try (m 1 0) (catch e e) (finally 0)))
         "(function() {\ntry {\n  return m(1, 0);\n} catch (e) {\n  return e;\n} finally {\n  return 0;\n}})()")
        "try / catch / finally compiles")

(.log console "compile property / method access / call special forms")

(assert (identical? (transpile '(.log console message))
                    "console.log(message)")
        "method call compiles correctly")
(assert (identical? (transpile '(.-location window))
                    "window.location")
        "property access compiles correctly")
(assert (identical? (transpile '(.-foo? bar))
                    "bar.isFoo")
        "property access compiles naming conventions")
(assert (identical? (transpile '(.-location (.open window url)))
                    "(window.open(url)).location")
        "compound property access and method call")
(assert (identical? (transpile '(.slice (.splice arr 0)))
                    "arr.splice(0).slice()")
        "(.slice (.splice arr 0)) => arr.splice(0).slice()")
(assert (identical? (transpile '(.a (.b "/")))
                    "\"/\".b().a()")
        "(.a (.b \"/\")) => \"/\".b().a()")

(.log console "compile unquote-splicing forms")

(assert (identical? (transpile '`(1 ~@'(2 3)))
                    "concat(list(1), list(2, 3))")
        "list unquote-splicing compiles")
(assert (identical? (transpile '`())
                    "list()")
         "empty list unquotes to empty list")

(assert (identical? (transpile '`[1 ~@[2 3]])
                    "vec(concat([1], [2, 3]))")
        "vector unquote-splicing compiles")

(assert (identical? (transpile '`[])
                    "[]")
        "syntax-quoted empty vector compiles to empty vector")

(.log console "compile references")

(assert (identical? (transpile '(set! **macros** []))
                    "__macros__ = []")
        "**macros** => __macros__")
(assert (identical?
         (transpile '(fn vector->list [v] (make list v)))
         "function vectorToList(v) {\n  return make(list, v);\n}")
        "list->vector => listToVector")
(assert (identical? (transpile '(swap! foo bar))
                    "swap(foo, bar)")
        "set! => set")

;(assert (identical? (transpile '(let [raw% foo-bar] raw%))
;                     "swap(foo, bar)")
;          "set! => set")

(assert (identical? (transpile '(def under_dog))
                    "var under_dog = void(0)")
        "foo_bar => foo_bar")
(assert (identical? (transpile '(digit? 0))
                    "isDigit(0)")
        "number? => isNumber")

(assert (identical? (transpile '(create-server options))
                    "createServer(options)")
        "create-server => createServer")

(assert (identical? (transpile '(.create-server http options))
                    "http.createServer(options)")
        "http.create-server => http.createServer")

(.log console "compiles new special form")

(assert (identical? (transpile '(new Foo)) "new Foo()")
        "(new Foo) => new Foo()")
(assert (identical? (transpile '(Foo.)) "new Foo()")
        "(Foo.) => new Foo()")
(assert (identical? (transpile '(new Foo a b)) "new Foo(a, b)")
        "(new Foo a b) => new Foo(a, b)")
(assert (identical? (transpile '(Foo. a b)) "new Foo(a, b)")
        "(Foo. a b) => new Foo(a, b)")

(.log console "compiles native special forms: and or + * - / not")

(assert (identical? (transpile '(and a b)) "a && b")
        "(and a b) => a && b")
(assert (identical? (transpile '(and a b c)) "a && b && c")
        "(and a b c) => a && b && c")
(assert (identical? (transpile '(and a (or b c))) "a && (b || c)")
        "(and a (or b c)) => a && (b || c)")

(assert (identical?
         (transpile '(and a (or b (or c d)))) "a && (b || (c || d))")
        "(and a (or b (or c d))) => a && (b || (c || d))")
(assert (identical? (transpile '(not x)) "!(x)")
        "(not x) => !(x)")
(assert (identical? (transpile '(not (or x y))) "!(x || y)")
        "(not x) => !(x)")

(.log console "compiles = == >= <= special forms")

(assert (identical? (transpile '(= a b)) "a == b")
        "(= a b) => a == b")
(assert (identical? (transpile '(= a b c)) "a == b && b == c")
        "(= a b c) => a == b && b == c")
(assert (identical? (transpile '(< a b c)) "a < b && b < c")
        "(< a b c) => a < b && b < c")
(assert (identical? (transpile '(identical? a b c)) "a === b && b === c")
        "(identical? a b c) => a === b && b === c")
(assert (identical? (transpile '(>= (.index-of arr el) 0))
                    "arr.indexOf(el) >= 0")
        "(>= (.index-of arr el) 0) => arr.indexOf(el) >= 0")

(.log console "compiles dictionaries to js objects")

(assert (identical? (transpile '{}) "{}")
        "empty hash compiles to empty object")
(assert (identical? (transpile '{ :foo 1 }) "{\n  \"foo\": 1\n}")
        "compile dictionaries to js objects")

(assert (identical?
         (transpile '{:foo 1 :bar (a b) :bz (fn [x] x) :bla { :sub 2 }})
"{
  \"foo\": 1,
  \"bar\": a(b),
  \"bz\": function(x) {
    return x;
  },
  \"bla\": {
    \"sub\": 2
  }
}") "compile nested dictionaries")

(.log console "compiles compound accessor")

(assert (identical? (transpile '(get a b)) "a[b]")
        "(get a b) => a[b]")
(assert (identical? (transpile '(aget arguments 1)) "arguments[1]")
        "(aget arguments 1) => arguments[1]")
(assert (identical? (transpile '(get (a b) (get c d)))
                    "a(b)[c[d]]")
        "(get (a b) (get c d)) => a(b)[c[d]]")

(.log console "compiles instance?")

(assert (identical? (transpile '(instance? Object a))
                    "a instanceof Object")
        "(instance? Object a) => a instanceof Object")
(assert (identical? (transpile '(instance? (C D) (a b)))
                    "a(b) instanceof C(D)")
        "(instance? (C D) (a b)) => a(b) instanceof C(D)")

(.log console "compile loop")
(assert (identical? (transpile '(loop [x 7] (if (f x) x (recur (b x)))))
"(function loop(x) {
  var recur = loop;
  while (recur === loop) {
    recur = f(x) ?
    x :
    (x = b(x), loop);
  };
  return recur;
})(7)") "single binding loops compile")

(assert (identical? (transpile '(loop [] (if (m?) m (recur))))
"(function loop() {
  var recur = loop;
  while (recur === loop) {
    recur = isM() ?
    m :
    (loop);
  };
  return recur;
})()") "zero bindings loops compile")

(assert
 (identical?
  (transpile '(loop [x 3 y 5] (if (> x y) x (recur (+ x 1) (- y 1)))))
"(function loop(x, y) {
  var recur = loop;
  while (recur === loop) {
    recur = x > y ?
    x :
    (x = x + 1, y = y - 1, loop);
  };
  return recur;
})(3, 5)") "multi bindings loops compile")


Add regressed `--source-uri` and `--output-uri` params.

(ns wisp.wisp
  "Wisp program that reads wisp code from stdin and prints
  compiled javascript code into stdout"
  (:require [fs :refer [createReadStream]]
            [path :refer [basename dirname join resolve]]
            [module :refer [Module]]
            [commander]
            [wisp.package :refer [version]]

            [wisp.string :refer [split join upper-case replace]]
            [wisp.sequence :refer [first second last count reduce rest
                                   conj partition assoc drop empty?]]

            [wisp.repl :refer [start] :rename {start start-repl}]
            [wisp.engine.node]
            [wisp.runtime :refer [str subs = nil?]]
            [wisp.ast :refer [pr-str name]]
            [wisp.compiler :refer [compile]]))

(defn compile-stdin
  [options]
  (with-stream-content process.stdin
                       compile-string
                       (conj {} options)))
;; (conj {:source-uri options}) causes segfault for some reason

(defn compile-file
  [path options]
  (with-stream-content (createReadStream path)
                       compile-string
                       (conj {:source-uri path} options)))

(defn compile-string
  [source options]
  (let [channel (or (:print options) :code)
        output (compile source options)
        content (cond
                  (= channel :code) (:code output)
                  (= channel :expansion) (:expansion output)
                  :else (JSON.stringify (get output channel) 2 2))]
      (.write process.stdout (or content "nil"))
    (if (:error output) (throw (.-error output)))))

(defn with-stream-content
  [input resume options]
  (let [content ""]
    (.setEncoding input "utf8")
    (.resume input)
    (.on input "data" #(set! content (str content %)))
    (.once input "end" (fn [] (resume content options)))))

(defn run
  [path]
  ;; Loading module as main one, same way as nodejs does it:
  ;; https://github.com/joyent/node/blob/master/lib/module.js#L489-493
  (Module._load (resolve path) null true))

(defmacro ->
  [& operations]
  (reduce
   (fn [form operation]
     (cons (first operation)
           (cons form (rest operation))))
   (first operations)
   (rest operations)))

(defn parse-params
  [params]
  (let [options (-> commander
                    (.version version)
                    (.usage "[options] <file ...>")
                    (.option "-r, --run"
                             "compile and execute the file (same as wisp path/to/file.wisp)")
                    (.option "-c, --compile"
                             "compile given file and prints to stdout")
                    (.option "-i, --interactive"
                             "run an interactive wisp REPL (same as wisp with no params)")
                    (.option "--print <format>"
                             "use custom print output `expansion`,`forms`, `ast`, `js-ast` or (default) `code`"
                             (fn [x _] (str x))
                             "code")
                    (.option "--no-map"
                             "disable source map generation")
                    (.option "--source-uri <uri>"
                             "uri input will be associated with in source maps")
                    (.option "--output-uri <uri>"
                             "uri output will be associated with in source maps")
                    (.parse params))]
    (conj {:no-map (not (:map options))}
          options)))

(defn main
  []
  (let [options (parse-params process.argv)
        path (aget options.args 0)]
    (cond options.run (run path)
          (not process.stdin.isTTY) (compile-stdin options)
          options.interactive (start-repl)
          options.compile (compile-file path options)
          path (run path)
          :else (start-repl))))

(ns wisp.wisp
  "Wisp program that reads wisp code from stdin and prints
  compiled javascript code into stdout"
  (:require [fs :refer [createReadStream]]
            [path :refer [basename dirname join resolve]]
            [module :refer [Module]]
            [commander]
            [wisp.package :refer [version]]

            [wisp.string :refer [split join upper-case replace]]
            [wisp.sequence :refer [first second last count reduce rest
                                   conj partition assoc drop empty?]]

            [wisp.repl :refer [start] :rename {start start-repl}]
            [wisp.engine.node]
            [wisp.runtime :refer [str subs = nil?]]
            [wisp.ast :refer [pr-str name]]
            [wisp.compiler :refer [compile]]))

(defn compile-stdin
  [options]
  (with-stream-content process.stdin
                       compile-string
                       (conj {} options)))
;; (conj {:source-uri options}) causes segfault for some reason

(defn compile-file
  [path options]
  (with-stream-content (createReadStream path)
                       compile-string
                       (conj {:source-uri path} options)))

(defn compile-string
  [source options]
  (let [channel (or (:print options) :code)
        output (compile source options)
        content (cond
                  (= channel :code) (:code output)
                  (= channel :expansion) (:expansion output)
                  :else (JSON.stringify (get output channel) 2 2))]
      (.write process.stdout (or content "nil"))
    (if (:error output) (throw (.-error output)))))

(defn with-stream-content
  [input resume options]
  (let [content ""]
    (.setEncoding input "utf8")
    (.resume input)
    (.on input "data" #(set! content (str content %)))
    (.once input "end" (fn [] (resume content options)))))

(defn run
  [path]
  ;; Loading module as main one, same way as nodejs does it:
  ;; https://github.com/joyent/node/blob/master/lib/module.js#L489-493
  (Module._load (resolve path) null true))

(defmacro ->
  [& operations]
  (reduce
   (fn [form operation]
     (cons (first operation)
           (cons form (rest operation))))
   (first operations)
   (rest operations)))

(defn parse-params
  [params]
  (let [options (-> commander
                    (.version version)
                    (.usage "[options] <file ...>")
                    (.option "-r, --run"
                             "compile and execute the file (same as wisp path/to/file.wisp)")
                    (.option "-c, --compile"
                             "compile given file and prints to stdout")
                    (.option "-i, --interactive"
                             "run an interactive wisp REPL (same as wisp with no params)")
                    (.option "--print <format>"
                             "use custom print output `expansion`,`forms`, `ast`, `js-ast` or (default) `code`"
                             (fn [x _] (str x))
                             "code")
                    (.option "--no-map"
                             "disable source map generation")
                    (.parse params))]
    (conj {:no-map (not (:map options))}
          options)))

(defn main
  []
  (let [options (parse-params process.argv)
        path (aget options.args 0)]
    (cond options.run (run path)
          (not process.stdin.isTTY) (compile-stdin options)
          options.interactive (start-repl)
          options.compile (compile-file path options)
          path (run path)
          :else (start-repl))))


Make use of standard apply instead of .apply method.

(import [nil? vector? number? string? str] "./runtime")

(defn List
  "List type"
  [head tail]
  (set! this.head head)
  (set! this.tail tail)
  (set! this.length (+ (.-length tail) 1))
  this)

(set! List.prototype.length 0)
(set! List.prototype.tail (Object.create List.prototype))
(set! List.prototype.to-string
      (fn []
        (loop [result ""
               list this]
          (if (empty? list)
            (str "(" (.substr result 1) ")")
            (recur
             (str result
                  " "
                  (if (vector? (first list))
                    (str "[" (.join (first list) " ") "]")
                    (if (nil? (first list))
                      "nil"
                      (if (string? (first list))
                        (.stringify JSON (first list))
                        (if (number? (first list))
                          (.stringify JSON (first list))
                          (first list))))))
             (rest list))))))

(defn list?
  "Returns true if list"
  [value]
  (.prototype-of? List.prototype value))

(defn count
  "Returns number of elements in list"
  [sequence]
  (.-length sequence))

(defn empty?
  "Returns true if list is empty"
  [sequence]
  (= (count sequence) 0))

(defn first
  "Return first item in a list"
  [sequence]
  (if (list? sequence)
    (.-head sequence)
    (get sequence 0)))

(defn second
  "Returns second item of the list"
  [sequence]
  (if (list? sequence)
    (first (rest sequence))
    (get sequence 1)))

(defn third
  "Returns third item of the list"
  [sequence]
  (if (list? sequence)
    (first (rest (rest sequence)))
    (get sequence 2)))

(defn rest
  "Returns list of all items except first one"
  [sequence]
  (if (list? sequence)
    (.-tail sequence)
    (.slice sequence 1)))

(defn cons
  "Creates list with `head` as first item and `tail` as rest"
  [head tail]
  (if (list? tail)
    (new List head tail)
    (apply list (.concat [head] tail))))

(defn list
  "Creates list of the given items"
  []
  (if (= (.-length arguments) 0)
    (Object.create List.prototype)
    (.reduce-right (.call Array.prototype.slice arguments)
                   (fn [tail head] (cons head tail))
                   (list))))

(defn reverse
  "Reverse order of items in the list"
  [sequence]
  (if (list? sequence)
    (loop [items []
           source sequence]
      (if (empty? source)
        (apply list items)
        (recur (.concat [(first source)] items)
               (rest source))))
    (.reverse sequence)))

(defn map-list
  "Maps list by applying `f` to each item"
  [source f]
  (if (empty? source) source
      (cons (f (first source))
            (map-list (rest source) f))))

(defn reduce-list
  [form f initial]
  (loop [result (if (nil? initial) (first form) initial)
         items (if (nil? initial) (rest form) form)]
    (if (empty? items)
      result
      (recur (f result (first items)) (rest items)))))

(defn concat-list
  "Returns list representing the concatenation of the elements in the
  supplied lists."
  [left right]
  (loop [result (if (list? right) right (apply list right))
         prefix (reverse left)]
    (if (empty? prefix)
      result
      (recur (cons (first prefix) result)
             (rest prefix)))))

(defn list-to-vector [source]
  (loop [result []
         list source]
    (if (empty? list)
      result
      (recur
        (do (.push result (first list)) result)
        (rest list)))))

(defn sort-list
  "Returns a sorted sequence of the items in coll.
  If no comparator is supplied, uses compare."
  [items f]
  (apply
   list
   (.sort (list-to-vector items)
          (if (nil? f)
            f
            (fn [a b] (if (f a b) 0 1))))))

(export empty? count list? first second third
        rest cons list reverse reduce-list
        map-list list-to-vector concat-list
        sort-list)

(import [nil? vector? number? string? str] "./runtime")

(defn List
  "List type"
  [head tail]
  (set! this.head head)
  (set! this.tail tail)
  (set! this.length (+ (.-length tail) 1))
  this)

(set! List.prototype.length 0)
(set! List.prototype.tail (Object.create List.prototype))
(set! List.prototype.to-string
      (fn []
        (loop [result ""
               list this]
          (if (empty? list)
            (str "(" (.substr result 1) ")")
            (recur
             (str result
                  " "
                  (if (vector? (first list))
                    (str "[" (.join (first list) " ") "]")
                    (if (nil? (first list))
                      "nil"
                      (if (string? (first list))
                        (.stringify JSON (first list))
                        (if (number? (first list))
                          (.stringify JSON (first list))
                          (first list))))))
             (rest list))))))

(defn list?
  "Returns true if list"
  [value]
  (.prototype-of? List.prototype value))

(defn count
  "Returns number of elements in list"
  [sequence]
  (.-length sequence))

(defn empty?
  "Returns true if list is empty"
  [sequence]
  (= (count sequence) 0))

(defn first
  "Return first item in a list"
  [sequence]
  (if (list? sequence)
    (.-head sequence)
    (get sequence 0)))

(defn second
  "Returns second item of the list"
  [sequence]
  (if (list? sequence)
    (first (rest sequence))
    (get sequence 1)))

(defn third
  "Returns third item of the list"
  [sequence]
  (if (list? sequence)
    (first (rest (rest sequence)))
    (get sequence 2)))

(defn rest
  "Returns list of all items except first one"
  [sequence]
  (if (list? sequence)
    (.-tail sequence)
    (.slice sequence 1)))

(defn cons
  "Creates list with `head` as first item and `tail` as rest"
  [head tail]
  (if (list? tail)
    (new List head tail)
    (apply list (.concat [head] tail))))

(defn list
  "Creates list of the given items"
  []
  (if (= (.-length arguments) 0)
    (Object.create List.prototype)
    (.reduce-right (.call Array.prototype.slice arguments)
                   (fn [tail head] (cons head tail))
                   (list))))

(defn reverse
  "Reverse order of items in the list"
  [sequence]
  (if (list? sequence)
    (loop [items []
           source sequence]
      (if (empty? source)
        (.apply list list items)
        (recur (.concat [(first source)] items)
               (rest source))))
    (.reverse sequence)))

(defn map-list
  "Maps list by applying `f` to each item"
  [source f]
  (if (empty? source) source
      (cons (f (first source))
            (map-list (rest source) f))))

(defn reduce-list
  [form f initial]
  (loop [result (if (nil? initial) (first form) initial)
         items (if (nil? initial) (rest form) form)]
    (if (empty? items)
      result
      (recur (f result (first items)) (rest items)))))

(defn concat-list
  "Returns list representing the concatenation of the elements in the
  supplied lists."
  [left right]
  (loop [result (if (list? right) right (apply list right))
         prefix (reverse left)]
    (if (empty? prefix)
      result
      (recur (cons (first prefix) result)
             (rest prefix)))))

(defn list-to-vector [source]
  (loop [result []
         list source]
    (if (empty? list)
      result
      (recur
        (do (.push result (first list)) result)
        (rest list)))))

(defn sort-list
  "Returns a sorted sequence of the items in coll.
  If no comparator is supplied, uses compare."
  [items f]
  (apply
   list
   (.sort (list-to-vector items)
          (if (nil? f)
            f
            (fn [a b] (if (f a b) 0 1))))))

(export empty? count list? first second third
        rest cons list reverse reduce-list
        map-list list-to-vector concat-list
        sort-list)


Print success message at the end of all tests.

(import "./sequence")
(import "./ast")
(import "./runtime")
(import "./string")
(import "./reader")
(import "./compiler")

(.log console "\n\nAll tests passed!")


added some tests for replace

added some tests for replace

(ns wisp.test.string
  (:require [wisp.test.util :refer [is thrown?]]
            [wisp.src.string :refer [join split replace]]
            [wisp.src.sequence :refer [list]]
            [wisp.src.runtime :refer [str =]]))

(is (= "" (join nil)))
(is (= "" (join "-" nil)))

(is (= "" (join "")))
(is (= "" (join "-" "")))
(is (= "h" (join "-" "h")))
(is (= "hello" (join "hello")))
(is (= "h-e-l-l-o" (join "-" "hello")))

(is (= "" (join [])))
(is (= "" (join "-" [])))
(is (= "1" (join "-" [1])))
(is (= "1-2-3" (join "-" [1 2 3])))

(is (= "" (join '())))
(is (= "" (join "-" '())))
(is (= "1" (join "-" '(1))))
(is (= "1-2-3" (join "-" '(1 2 3))))

(is (= "" (join {})))
(is (= (str [:a 1]) (join {:a 1})))
(is (= (str [:a 1]) (join "," {:a 1})))
(is (= (str [:a 1] [:b 2]) (join {:a 1 :b 2})))
(is (= (str [:a 1] "," [:b 2]) (join "," {:a 1 :b 2})))

(is (= [""] (split "" #"\s")))
(is (= ["hello"] (split "hello" #"world")))
(is (= ["q" "w" "e" "r" "t" "y" "u" "i" "o" "p"]
       (split "q1w2e3r4t5y6u7i8o9p" #"\d+")))

(is (= ["q" "w" "e" "r" "t"]
       ; TODO: In clojure => ["q" "w" "e" "r" "t5y6u7i8o9p0"]
       (split "q1w2e3r4t5y6u7i8o9p0" #"\d+" 5)))

(is (= ["Some" "words" "to" "split"]
       (split "Some words to split" " ")))

; replace tests
; basic test
(is (= "wtring" (replace "string" "s" "w")))
; testing 'g' flag for replace
(is (= "hewwo" (replace "string" "l" "w")))
; basic regex
(is (= "tenten" (replace "10ten" #"[0-9]+" "ten")))
; g flag on basic regex
(is (= "tententen" (replace "19ten10" #"[0-9]+" "ten")))


Export `push-back-reader` from reader module.

(import [list list? count empty? first second third rest cons conj rest] "./sequence")
(import [odd? dictionary keys nil? inc dec vector? string? object?
         re-pattern re-matches re-find str] "./runtime")
(import [symbol? symbol keyword? keyword meta with-meta name] "./ast")

(defn PushbackReader
  "StringPushbackReader"
  [source uri index buffer]
  (set! this.source source)
  (set! this.uri uri)
  (set! this.index-atom index)
  (set! this.buffer-atom buffer)
  (set! this.column-atom 1)
  (set! this.line-atom 1)
  this)

(defn push-back-reader
  "Creates a StringPushbackReader from a given string"
  [source uri]
  (new PushbackReader source uri 0 ""))

(defn line
  "Return current line of the reader"
  [reader]
  (.-line-atom reader))

(defn column
  "Return current column of the reader"
  [reader]
  (.-column-atom reader))

(defn next-char
  "Returns next char from the Reader without reading it.
  nil if the end of stream has being reached."
  [reader]
  (if (empty? reader.buffer-atom)
    (aget reader.source reader.index-atom)
    (aget reader.buffer-atom 0)))

(defn read-char
  "Returns the next char from the Reader, nil if the end
  of stream has been reached"
  [reader]
  ;; Update line column depending on what has being read.
  (if (identical? (next-char reader) "\n")
    (do (set! reader.line-atom (+ (line reader) 1))
        (set! reader.column-atom 1))
    (set! reader.column-atom (+ (column reader) 1)))

  (if (empty? reader.buffer-atom)
    (let [index reader.index-atom]
      (set! reader.index-atom (+ index 1))
      (aget reader.source index))
    (let [buffer reader.buffer-atom]
      (set! reader.buffer-atom (.substr buffer 1))
      (aget buffer 0))))

(defn unread-char
  "Push back a single character on to the stream"
  [reader ch]
  (if ch
    (do
      (if (identical? ch "\n")
        (set! reader.line-atom (- reader.line-atom 1))
        (set! reader.column-atom (- reader.column-atom 1)))
      (set! reader.buffer-atom (str ch reader.buffer-atom)))))

;; Predicates

(defn ^boolean breaking-whitespace?
 "Checks if a string is all breaking whitespace."
 [ch]
 (>= (.index-of "\t\n\r " ch) 0))

(defn ^boolean whitespace?
  "Checks whether a given character is whitespace"
  [ch]
  (or (breaking-whitespace? ch) (identical? "," ch)))

(defn ^boolean numeric?
 "Checks whether a given character is numeric"
 [ch]
 (>= (.index-of "01234567890" ch) 0))

(defn ^boolean comment-prefix?
  "Checks whether the character begins a comment."
  [ch]
  (identical? ";" ch))

(defn ^boolean number-literal?
  "Checks whether the reader is at the start of a number literal"
  [reader initch]
  (or (numeric? initch)
      (and (or (identical? \+ initch)
               (identical? \- initch))
           (numeric? (next-char reader)))))

;; read helpers

(defn reader-error
  [reader message]
  (let [error (SyntaxError (str message
               "\n" "line:" (line reader)
               "\n" "column:" (column reader)))]
    (set! error.line (line reader))
    (set! error.column (column reader))
    (set! error.uri (get reader :uri))
    (throw error)))

(defn ^boolean macro-terminating? [ch]
  (and (not (identical? ch "#"))
       (not (identical? ch "'"))
       (not (identical? ch ":"))
       (macros ch)))

(defn read-token
  "Reads out next token from the reader stream"
  [reader initch]
  (loop [buffer initch
         ch (read-char reader)]

    (if (or (nil? ch)
            (whitespace? ch)
            (macro-terminating? ch))
      (do (unread-char reader ch) buffer)
      (recur (.concat buffer ch)
             (read-char reader)))))

(defn skip-line
  "Advances the reader to the end of a line. Returns the reader"
  [reader _]
  (loop []
    (let [ch (read-char reader)]
      (if (or (identical? ch "\n")
              (identical? 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 match-int
  [s]
  (let [groups (re-find int-pattern s)
        group3 (aget groups 2)]
    (if (not (or (nil? group3)
                 (< (count group3) 1)))
      0
      (let [negate (if (identical? "-" (aget groups 1)) -1 1)
            a (cond
               (aget groups 3) [(aget groups 3) 10]
               (aget groups 4) [(aget groups 4) 16]
               (aget groups 5) [(aget groups 5) 8]
               (aget groups 7) [(aget groups 7) (parse-int (aget groups 7))]
               :default [nil nil])
            n (aget a 0)
            radix (aget a 1)]
        (if (nil? n)
          nil
          (* negate (parse-int n radix)))))))

(defn match-ratio
  [s]
  (let [groups (re-find ratio-pattern s)
        numinator (aget groups 1)
        denominator (aget groups 2)]
    (/ (parse-int numinator) (parse-int denominator))))

(defn match-float
  [s]
  (parse-float s))

(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
   (identical? c \t) "\t"
   (identical? c \r) "\r"
   (identical? c \n) "\n"
   (identical? c \\) \\
   (identical? c "\"") "\""
   (identical? c \b) "\b"
   (identical? c \f) "\f"
   :else nil))

;; unicode

(defn read-2-chars [reader]
  (str (read-char reader)
       (read-char reader)))

(defn read-4-chars [reader]
  (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
  "Validates unicode escape"
  [unicode-pattern reader escape-char unicode-str]
  (if (re-matches unicode-pattern unicode-str)
    unicode-str
    (reader-error
     reader
     (str "Unexpected unicode escape " \\ escape-char unicode-str))))

(defn make-unicode-char [code-str]
  (let [code (parseInt code-str 16)]
    (.from-char-code String code)))

(defn escape-char
  "escape char"
  [buffer reader]
  (let [ch (read-char reader)
        mapresult (escape-char-map ch)]
    (if mapresult
      mapresult
      (cond
        (identical? ch \x)
        (make-unicode-char
         (validate-unicode-escape
          unicode-2-pattern
          reader
          ch
          (read-2-chars reader)))
        (identical? ch \u)
        (make-unicode-char
          (validate-unicode-escape
           unicode-4-pattern
           reader
           ch
           (read-4-chars reader)))
        (numeric? ch)
        (.fromCharCode String ch)

        :else
        (reader-error
         reader
         (str "Unexpected unicode escape " \\ ch ))))))

(defn read-past
  "Read until first character that doesn't match pred, returning
  char."
  [predicate reader]
  (loop [ch (read-char reader)]
    (if (predicate ch)
      (recur (read-char reader))
      ch)))

;; TODO: Complete implementation
(defn read-delimited-list
  "Reads out delimited list"
  [delim reader recursive?]
  (loop [a []]
    (let [ch (read-past whitespace? reader)]
      (if (not ch) (reader-error reader "EOF"))
      (if (identical? delim ch)
        a
        (let [macrofn (macros ch)]
          (if macrofn
            (let [mret (macrofn reader ch)]
              (recur (if (identical? mret reader)
                       a
                       (.concat a [mret]))))
            (do
              (unread-char reader ch)
              (let [o (read reader true nil recursive?)]
                (recur (if (identical? o reader)
                         a
                         (.concat a [o])))))))))))

;; data structure readers

(defn not-implemented
  [reader ch]
  (reader-error reader
                (str "Reader for " ch " not implemented yet")))

(defn read-dispatch
  [reader _]
  (let [ch (read-char reader)
        dm (dispatch-macros ch)]
    (if dm
      (dm reader _)
      (let [object (maybe-read-tagged-type reader ch)]
        (if object
          object
          (reader-error reader "No dispatch macro for " ch))))))

(defn read-unmatched-delimiter
  [rdr ch]
  (reader-error rdr "Unmached delimiter " ch))

(defn read-list
  [reader]
  (apply list (read-delimited-list ")" reader true)))

(def read-comment skip-line)

(defn read-vector
  [reader]
  (read-delimited-list "]" reader true))

(defn read-map
  [reader]
  (let [items (read-delimited-list "}" reader true)]
    (if (odd? (.-length items))
      (reader-error
       reader
       "Map literal must contain an even number of forms"))
    (apply dictionary items)))

(defn read-number
  [reader initch]
  (loop [buffer initch
         ch (read-char reader)]

    (if (or (nil? ch)
            (whitespace? ch)
            (macros ch))
      (do
        (unread-char reader ch)
        (def match (match-number buffer))
        (if (nil? match)
            (reader-error reader "Invalid number format [" buffer "]")
            match))
      (recur (str buffer ch)
             (read-char reader)))))

(defn read-string
  [reader]
  (loop [buffer ""
         ch (read-char reader)]

    (cond
     (nil? ch)
      (reader-error reader "EOF while reading string")
     (identical? \\ ch)
      (recur (str buffer (escape-char buffer reader))
             (read-char reader))
     (identical? "\"" ch)
      buffer
     :default
      (recur (str buffer ch) (read-char reader)))))

(defn read-unquote
  "Reads unquote form ~form or ~(foo bar)"
  [reader]
  (let [ch (read-char reader)]
    (if (not ch)
      (reader-error reader "EOF while reading character")
      (if (identical? ch "@")
        (list 'unquote-splicing (read reader true nil true))
        (do
          (unread-char reader ch)
          (list 'unquote (read reader true nil true)))))))

(defn special-symbols [text not-found]
  (cond
   (identical? text "nil") nil
   (identical? text "true") true
   (identical? text "false") false
   :else not-found))

(defn read-symbol
  [reader initch]
  (let [token (read-token reader initch)]
    (if (>= (.index-of token "/") 0)
      (symbol (.substr token 0 (.index-of token "/"))
              (.substr token (inc (.index-of token "/"))
                       (.-length 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 (aget a 0)
        ns (aget a 1)
        name (aget a 2)]
    (if (or
         (and (not (nil? ns))
              (identical? (.substring ns
                                      (- (.-length ns) 2)
                                      (.-length ns)) ":/"))

         (identical? (aget name (dec (.-length name))) ":")
         (not (== (.index-of token "::" 1) -1)))
      (reader-error reader "Invalid token: " token)
      (if (and (not (nil? ns)) (> (.-length ns) 0))
        (keyword (.substring ns 0 (.index-of ns "/")) name)
        (keyword token)))))

(defn desugar-meta
  [f]
  (cond
   (symbol? f) {:tag f}
   (string? f) {:tag f}
   (keyword? f) (dictionary (name f) true)
   :else f))

(defn wrapping-reader
  [prefix]
  (fn [reader]
    (list prefix (read reader true nil true))))

(defn throwing-reader
  [msg]
  (fn [reader]
    (reader-error reader msg)))

(defn read-meta
  [reader _]
  (let [m (desugar-meta (read reader true nil true))]
    (if (not (object? m))
      (reader-error
       reader "Metadata must be Symbol, Keyword, String or Map"))
    (let [o (read reader true nil true)]
      (if (object? o)
        (with-meta o (conj m (meta o)))
        ;(reader-error
        ; reader "Metadata can only be applied to IWithMetas")

        o ; For now we don't throw errors as we can't apply metadata to
          ; symbols, so we just ignore it.
        ))))

(defn read-set
  [reader _]
  (apply list (.concat ['set]
                       (read-delimited-list "}" reader true))))

(defn read-regex
  [reader]
  (loop [buffer ""
         ch (read-char reader)]

    (cond
     (nil? ch) (reader-error reader "EOF while reading string")
     (identical? \\ ch) (recur (str buffer ch (read-char reader))
                               (read-char reader))
     (identical? "\"" ch) (re-pattern (.join (.split buffer "/") "\\/"))
     :default (recur (str buffer ch) (read-char reader)))))

(defn read-discard
  "Discards next form"
  [reader _]
  (read reader true nil true)
  reader)

(defn macros [c]
  (cond
   (identical? c "\"") read-string
   (identical? c \:) read-keyword
   (identical? c ";") read-comment
   (identical? c "'") (wrapping-reader 'quote)
   (identical? c \@) (wrapping-reader 'deref)
   (identical? c \^) read-meta
   (identical? c "`") (wrapping-reader 'syntax-quote)
   (identical? c "~") read-unquote
   (identical? c "(") read-list
   (identical? c ")") read-unmatched-delimiter
   (identical? c "[") read-vector
   (identical? c "]") read-unmatched-delimiter
   (identical? c "{") read-map
   (identical? c "}") read-unmatched-delimiter
   (identical? c \\) read-char
   (identical? c \%) not-implemented
   (identical? c "#") read-dispatch
   :else nil))

(defn dispatch-macros [s]
  (cond
   (identical? s "{") read-set
   (identical? s "<") (throwing-reader "Unreadable form")
   (identical? s "\"") read-regex
   (identical? s "!") read-comment
   (identical? 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]
  (loop []
    (let [ch (read-char reader)]
      (cond
       (nil? ch) (if eof-is-error (reader-error reader "EOF") sentinel)
       (whitespace? ch) (recur)
       (comment-prefix? ch) (read (read-comment reader ch)
                                  eof-is-error
                                  sentinel
                                  is-recursive)
       :else (let [f (macros ch)
                   form (cond
                        f (f reader ch)
                        (number-literal? reader ch) (read-number reader ch)
                        :else (read-symbol reader ch))]
               (if (identical? form reader)
                 (recur)
                 form))))))

(defn read-from-string
  "Reads one object from the string s"
  [source uri]
  (let [reader (push-back-reader source uri)]
    (read reader true nil false)))

(defn ^:private read-uuid
  [uuid]
  (if (string? uuid)
    `(UUID. ~uuid)
    (reader-error
     nil "UUID literal expects a string as its representation.")))

(defn ^:private read-queue
  [items]
  (if (vector? items)
    `(PersistentQueue. ~items)
    (reader-error
     nil "Queue literal expects a vector for its elements.")))

(def __tag-table__
  (dictionary :uuid read-uuid
              :queue read-queue))

(defn maybe-read-tagged-type
  [reader initch]
  (let [tag (read-symbol reader initch)
        pfn (get __tag-table__ (name tag))]
    (if pfn
      (pfn (read reader true nil false))
      (reader-error reader
                    (str "Could not find tag parser for "
                         (name tag)
                         " in "
                         (str (keys __tag-table__)))))))

(export read read-from-string push-back-reader)

(import [list list? count empty? first second third rest cons conj rest] "./sequence")
(import [odd? dictionary keys nil? inc dec vector? string? object?
         re-pattern re-matches re-find str] "./runtime")
(import [symbol? symbol keyword? keyword meta with-meta name] "./ast")

(defn PushbackReader
  "StringPushbackReader"
  [source uri index buffer]
  (set! this.source source)
  (set! this.uri uri)
  (set! this.index-atom index)
  (set! this.buffer-atom buffer)
  (set! this.column-atom 1)
  (set! this.line-atom 1)
  this)

(defn push-back-reader
  "Creates a StringPushbackReader from a given string"
  [source uri]
  (new PushbackReader source uri 0 ""))

(defn line
  "Return current line of the reader"
  [reader]
  (.-line-atom reader))

(defn column
  "Return current column of the reader"
  [reader]
  (.-column-atom reader))

(defn next-char
  "Returns next char from the Reader without reading it.
  nil if the end of stream has being reached."
  [reader]
  (if (empty? reader.buffer-atom)
    (aget reader.source reader.index-atom)
    (aget reader.buffer-atom 0)))

(defn read-char
  "Returns the next char from the Reader, nil if the end
  of stream has been reached"
  [reader]
  ;; Update line column depending on what has being read.
  (if (identical? (next-char reader) "\n")
    (do (set! reader.line-atom (+ (line reader) 1))
        (set! reader.column-atom 1))
    (set! reader.column-atom (+ (column reader) 1)))

  (if (empty? reader.buffer-atom)
    (let [index reader.index-atom]
      (set! reader.index-atom (+ index 1))
      (aget reader.source index))
    (let [buffer reader.buffer-atom]
      (set! reader.buffer-atom (.substr buffer 1))
      (aget buffer 0))))

(defn unread-char
  "Push back a single character on to the stream"
  [reader ch]
  (if ch
    (do
      (if (identical? ch "\n")
        (set! reader.line-atom (- reader.line-atom 1))
        (set! reader.column-atom (- reader.column-atom 1)))
      (set! reader.buffer-atom (str ch reader.buffer-atom)))))

;; Predicates

(defn ^boolean breaking-whitespace?
 "Checks if a string is all breaking whitespace."
 [ch]
 (>= (.index-of "\t\n\r " ch) 0))

(defn ^boolean whitespace?
  "Checks whether a given character is whitespace"
  [ch]
  (or (breaking-whitespace? ch) (identical? "," ch)))

(defn ^boolean numeric?
 "Checks whether a given character is numeric"
 [ch]
 (>= (.index-of "01234567890" ch) 0))

(defn ^boolean comment-prefix?
  "Checks whether the character begins a comment."
  [ch]
  (identical? ";" ch))

(defn ^boolean number-literal?
  "Checks whether the reader is at the start of a number literal"
  [reader initch]
  (or (numeric? initch)
      (and (or (identical? \+ initch)
               (identical? \- initch))
           (numeric? (next-char reader)))))

;; read helpers

(defn reader-error
  [reader message]
  (let [error (SyntaxError (str message
               "\n" "line:" (line reader)
               "\n" "column:" (column reader)))]
    (set! error.line (line reader))
    (set! error.column (column reader))
    (set! error.uri (get reader :uri))
    (throw error)))

(defn ^boolean macro-terminating? [ch]
  (and (not (identical? ch "#"))
       (not (identical? ch "'"))
       (not (identical? ch ":"))
       (macros ch)))

(defn read-token
  "Reads out next token from the reader stream"
  [reader initch]
  (loop [buffer initch
         ch (read-char reader)]

    (if (or (nil? ch)
            (whitespace? ch)
            (macro-terminating? ch))
      (do (unread-char reader ch) buffer)
      (recur (.concat buffer ch)
             (read-char reader)))))

(defn skip-line
  "Advances the reader to the end of a line. Returns the reader"
  [reader _]
  (loop []
    (let [ch (read-char reader)]
      (if (or (identical? ch "\n")
              (identical? 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 match-int
  [s]
  (let [groups (re-find int-pattern s)
        group3 (aget groups 2)]
    (if (not (or (nil? group3)
                 (< (count group3) 1)))
      0
      (let [negate (if (identical? "-" (aget groups 1)) -1 1)
            a (cond
               (aget groups 3) [(aget groups 3) 10]
               (aget groups 4) [(aget groups 4) 16]
               (aget groups 5) [(aget groups 5) 8]
               (aget groups 7) [(aget groups 7) (parse-int (aget groups 7))]
               :default [nil nil])
            n (aget a 0)
            radix (aget a 1)]
        (if (nil? n)
          nil
          (* negate (parse-int n radix)))))))

(defn match-ratio
  [s]
  (let [groups (re-find ratio-pattern s)
        numinator (aget groups 1)
        denominator (aget groups 2)]
    (/ (parse-int numinator) (parse-int denominator))))

(defn match-float
  [s]
  (parse-float s))

(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
   (identical? c \t) "\t"
   (identical? c \r) "\r"
   (identical? c \n) "\n"
   (identical? c \\) \\
   (identical? c "\"") "\""
   (identical? c \b) "\b"
   (identical? c \f) "\f"
   :else nil))

;; unicode

(defn read-2-chars [reader]
  (str (read-char reader)
       (read-char reader)))

(defn read-4-chars [reader]
  (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
  "Validates unicode escape"
  [unicode-pattern reader escape-char unicode-str]
  (if (re-matches unicode-pattern unicode-str)
    unicode-str
    (reader-error
     reader
     (str "Unexpected unicode escape " \\ escape-char unicode-str))))

(defn make-unicode-char [code-str]
  (let [code (parseInt code-str 16)]
    (.from-char-code String code)))

(defn escape-char
  "escape char"
  [buffer reader]
  (let [ch (read-char reader)
        mapresult (escape-char-map ch)]
    (if mapresult
      mapresult
      (cond
        (identical? ch \x)
        (make-unicode-char
         (validate-unicode-escape
          unicode-2-pattern
          reader
          ch
          (read-2-chars reader)))
        (identical? ch \u)
        (make-unicode-char
          (validate-unicode-escape
           unicode-4-pattern
           reader
           ch
           (read-4-chars reader)))
        (numeric? ch)
        (.fromCharCode String ch)

        :else
        (reader-error
         reader
         (str "Unexpected unicode escape " \\ ch ))))))

(defn read-past
  "Read until first character that doesn't match pred, returning
  char."
  [predicate reader]
  (loop [ch (read-char reader)]
    (if (predicate ch)
      (recur (read-char reader))
      ch)))

;; TODO: Complete implementation
(defn read-delimited-list
  "Reads out delimited list"
  [delim reader recursive?]
  (loop [a []]
    (let [ch (read-past whitespace? reader)]
      (if (not ch) (reader-error reader "EOF"))
      (if (identical? delim ch)
        a
        (let [macrofn (macros ch)]
          (if macrofn
            (let [mret (macrofn reader ch)]
              (recur (if (identical? mret reader)
                       a
                       (.concat a [mret]))))
            (do
              (unread-char reader ch)
              (let [o (read reader true nil recursive?)]
                (recur (if (identical? o reader)
                         a
                         (.concat a [o])))))))))))

;; data structure readers

(defn not-implemented
  [reader ch]
  (reader-error reader
                (str "Reader for " ch " not implemented yet")))

(defn read-dispatch
  [reader _]
  (let [ch (read-char reader)
        dm (dispatch-macros ch)]
    (if dm
      (dm reader _)
      (let [object (maybe-read-tagged-type reader ch)]
        (if object
          object
          (reader-error reader "No dispatch macro for " ch))))))

(defn read-unmatched-delimiter
  [rdr ch]
  (reader-error rdr "Unmached delimiter " ch))

(defn read-list
  [reader]
  (apply list (read-delimited-list ")" reader true)))

(def read-comment skip-line)

(defn read-vector
  [reader]
  (read-delimited-list "]" reader true))

(defn read-map
  [reader]
  (let [items (read-delimited-list "}" reader true)]
    (if (odd? (.-length items))
      (reader-error
       reader
       "Map literal must contain an even number of forms"))
    (apply dictionary items)))

(defn read-number
  [reader initch]
  (loop [buffer initch
         ch (read-char reader)]

    (if (or (nil? ch)
            (whitespace? ch)
            (macros ch))
      (do
        (unread-char reader ch)
        (def match (match-number buffer))
        (if (nil? match)
            (reader-error reader "Invalid number format [" buffer "]")
            match))
      (recur (str buffer ch)
             (read-char reader)))))

(defn read-string
  [reader]
  (loop [buffer ""
         ch (read-char reader)]

    (cond
     (nil? ch)
      (reader-error reader "EOF while reading string")
     (identical? \\ ch)
      (recur (str buffer (escape-char buffer reader))
             (read-char reader))
     (identical? "\"" ch)
      buffer
     :default
      (recur (str buffer ch) (read-char reader)))))

(defn read-unquote
  "Reads unquote form ~form or ~(foo bar)"
  [reader]
  (let [ch (read-char reader)]
    (if (not ch)
      (reader-error reader "EOF while reading character")
      (if (identical? ch "@")
        (list 'unquote-splicing (read reader true nil true))
        (do
          (unread-char reader ch)
          (list 'unquote (read reader true nil true)))))))

(defn special-symbols [text not-found]
  (cond
   (identical? text "nil") nil
   (identical? text "true") true
   (identical? text "false") false
   :else not-found))

(defn read-symbol
  [reader initch]
  (let [token (read-token reader initch)]
    (if (>= (.index-of token "/") 0)
      (symbol (.substr token 0 (.index-of token "/"))
              (.substr token (inc (.index-of token "/"))
                       (.-length 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 (aget a 0)
        ns (aget a 1)
        name (aget a 2)]
    (if (or
         (and (not (nil? ns))
              (identical? (.substring ns
                                      (- (.-length ns) 2)
                                      (.-length ns)) ":/"))

         (identical? (aget name (dec (.-length name))) ":")
         (not (== (.index-of token "::" 1) -1)))
      (reader-error reader "Invalid token: " token)
      (if (and (not (nil? ns)) (> (.-length ns) 0))
        (keyword (.substring ns 0 (.index-of ns "/")) name)
        (keyword token)))))

(defn desugar-meta
  [f]
  (cond
   (symbol? f) {:tag f}
   (string? f) {:tag f}
   (keyword? f) (dictionary (name f) true)
   :else f))

(defn wrapping-reader
  [prefix]
  (fn [reader]
    (list prefix (read reader true nil true))))

(defn throwing-reader
  [msg]
  (fn [reader]
    (reader-error reader msg)))

(defn read-meta
  [reader _]
  (let [m (desugar-meta (read reader true nil true))]
    (if (not (object? m))
      (reader-error
       reader "Metadata must be Symbol, Keyword, String or Map"))
    (let [o (read reader true nil true)]
      (if (object? o)
        (with-meta o (conj m (meta o)))
        ;(reader-error
        ; reader "Metadata can only be applied to IWithMetas")

        o ; For now we don't throw errors as we can't apply metadata to
          ; symbols, so we just ignore it.
        ))))

(defn read-set
  [reader _]
  (apply list (.concat ['set]
                       (read-delimited-list "}" reader true))))

(defn read-regex
  [reader]
  (loop [buffer ""
         ch (read-char reader)]

    (cond
     (nil? ch) (reader-error reader "EOF while reading string")
     (identical? \\ ch) (recur (str buffer ch (read-char reader))
                               (read-char reader))
     (identical? "\"" ch) (re-pattern (.join (.split buffer "/") "\\/"))
     :default (recur (str buffer ch) (read-char reader)))))

(defn read-discard
  "Discards next form"
  [reader _]
  (read reader true nil true)
  reader)

(defn macros [c]
  (cond
   (identical? c "\"") read-string
   (identical? c \:) read-keyword
   (identical? c ";") read-comment
   (identical? c "'") (wrapping-reader 'quote)
   (identical? c \@) (wrapping-reader 'deref)
   (identical? c \^) read-meta
   (identical? c "`") (wrapping-reader 'syntax-quote)
   (identical? c "~") read-unquote
   (identical? c "(") read-list
   (identical? c ")") read-unmatched-delimiter
   (identical? c "[") read-vector
   (identical? c "]") read-unmatched-delimiter
   (identical? c "{") read-map
   (identical? c "}") read-unmatched-delimiter
   (identical? c \\) read-char
   (identical? c \%) not-implemented
   (identical? c "#") read-dispatch
   :else nil))

(defn dispatch-macros [s]
  (cond
   (identical? s "{") read-set
   (identical? s "<") (throwing-reader "Unreadable form")
   (identical? s "\"") read-regex
   (identical? s "!") read-comment
   (identical? 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]
  (loop []
    (let [ch (read-char reader)]
      (cond
       (nil? ch) (if eof-is-error (reader-error reader "EOF") sentinel)
       (whitespace? ch) (recur)
       (comment-prefix? ch) (read (read-comment reader ch)
                                  eof-is-error
                                  sentinel
                                  is-recursive)
       :else (let [f (macros ch)
                   form (cond
                        f (f reader ch)
                        (number-literal? reader ch) (read-number reader ch)
                        :else (read-symbol reader ch))]
               (if (identical? form reader)
                 (recur)
                 form))))))

(defn read-from-string
  "Reads one object from the string s"
  [source uri]
  (let [reader (push-back-reader source uri)]
    (read reader true nil false)))

(defn ^:private read-uuid
  [uuid]
  (if (string? uuid)
    `(UUID. ~uuid)
    (reader-error
     nil "UUID literal expects a string as its representation.")))

(defn ^:private read-queue
  [items]
  (if (vector? items)
    `(PersistentQueue. ~items)
    (reader-error
     nil "Queue literal expects a vector for its elements.")))

(def __tag-table__
  (dictionary :uuid read-uuid
              :queue read-queue))

(defn maybe-read-tagged-type
  [reader initch]
  (let [tag (read-symbol reader initch)
        pfn (get __tag-table__ (name tag))]
    (if pfn
      (pfn (read reader true nil false))
      (reader-error reader
                    (str "Could not find tag parser for "
                         (name tag)
                         " in "
                         (str (keys __tag-table__)))))))

(export read read-from-string)