Implement `let` writer.

Implement `let` writer.

(ns wisp.backend.escodegen.writer
  (:require [wisp.reader :refer [read-from-string]]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj reverse reduce vec last map
                                   filter take concat partition interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [escodegen :refer [generate]]))

(defn translate-identifier
  "Translates references from clojure convention to JS:

  **macros**      __macros__
  list->vector    listToVector
  set!            set
  foo_bar         foo_bar
  number?         isNumber
  create-server   createServer"
  [form]
  (def id (name form))
  (set! id (cond (identical? id  "*") "multiply"
                 (identical? id "/") "divide"
                 (identical? id "+") "sum"
                 (identical? id "-") "subtract"
                 (identical? id "=") "equal?"
                 (identical? id "==") "strict-equal?"
                 (identical? id "<=") "not-greater-than"
                 (identical? id ">=") "not-less-than"
                 (identical? id ">") "greater-than"
                 (identical? id "<") "less-than"
                 :else id))

  ;; **macros** ->  __macros__
  (set! id (join "_" (split id "*")))
  ;; list->vector ->  listToVector
  (set! id (join "-to-" (split id "->")))
  ;; set! ->  set
  (set! id (join (split id "!")))
  (set! id (join "$" (split id "%")))
  ;; foo= -> fooEqual
  ;(set! id (join "-equal-" (split id "="))
  ;; foo+bar -> fooPlusBar
  (set! id (join "-plus-" (split id "+")))
  (set! id (join "-and-" (split id "&")))
  ;; number? -> isNumber
  (set! id (if (identical? (last id) "?")
             (str "is-" (subs id 0 (dec (count id))))
             id))
  ;; create-server -> createServer
  (set! id (reduce
            (fn [result key]
              (str result
                   (if (and (not (empty? result))
                            (not (empty? key)))
                     (str (upper-case (get key 0)) (subs key 1))
                     key)))
            ""
            (split id "-")))
  id)

;; Operators that compile to binary expressions

(defn make-binary-expression
  [operator left right]
  {:type :BinaryExpression
   :operator operator
   :left left
   :right right})

(defmacro def-binary-operator
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-binary-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-binary-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

(defn verify-one
  [operator]
  (error (str operator "form requires at least one operand")))

(defn verify-two
  [operator]
  (error (str operator "form requires at least two operands")))

;; Arithmetic operators

;(def-binary-operator :+ :+ 0 identity)
;(def-binary-operator :- :- 'NaN identity)
;(def-binary-operator :* :* 1 identity)
;(def-binary-operator (keyword "/") (keyword "/") verify-two verify-two)
;(def-binary-operator :mod (keyword "%") verify-two verify-two)

;; Comparison operators

;(def-binary-operator :not= :!= verify-one false)
;(def-binary-operator :== :=== verify-one true)
;(def-binary-operator :identical? '=== verify-two verify-two)
;(def-binary-operator :> :> verify-one true)
;(def-binary-operator :>= :>= verify-one true)
;(def-binary-operator :< :< verify-one true)
;(def-binary-operator :<= :<= verify-one true)

;; Bitwise Operators

;(def-binary-operator :bit-and :& verify-two verify-two)
;(def-binary-operator :bit-or :| verify-two verify-two)
;(def-binary-operator :bit-xor (keyword "^") verify-two verify-two)
;(def-binary-operator :bit-not (keyword "~") verify-two verify-two)
;(def-binary-operator :bit-shift-left :<< verify-two verify-two)
;(def-binary-operator :bit-shift-right :>> verify-two verify-two)
;(def-binary-operator :bit-shift-right-zero-fil :>>> verify-two verify-two)

;; Logical operators

(defn make-logical-expression
  [operator left right]
  {:type :LogicalExpression
   :operator operator
   :left left
   :right right})

(defmacro def-logical-expression
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-logical-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-logical-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

;(def-logical-expression :and :&& 'true identity)
;(def-logical-expression :and :|| 'nil identity)

(defn write-method-call
  [form]
  {:type :CallExpression
   :callee {:type :MemberExpression
            :computed false
            :object (write (first form))
            :property (write (second form))}
   :arguments (map write (vec (rest (rest params))))})

(defn write-instance?
  [form]
  {:type :BinaryExpression
   :operator :instanceof
   :left (write (second form))
   :right (write (first form))})

(defn write-not
  [form]
  {:type :UnaryExpression
   :operator :!
   :argument (write (second form))})

(defn write-location
  [form]
  (let [data (meta form)
        start (:start form)
        end (:end form)]
    (if (not (nil? start))
      {:start {:line (inc (:line start))
               :column (:column start)}
       :end {:line (inc (:line end))
             :column (inc (:column end))}})))

(def **writers** {})
(defn install-writer!
  [op writer]
  (set! (get **writers** op) writer))

(defn write-op
  [op form]
  (let [writer (get **writers** op)]
    (assert writer (str "Unsupported operation: " op))
    (writer form)))

(defn write-nil
  [form]
  {:type :UnaryExpression
   :operator :void
   :argument {:type :Literal
              :value 0}
   :prefix true
   :loc (write-location form)})
(install-writer! :nil write-nil)

(defn write-literal
  [form]
  {:type :Literal
   :value (:form form)
   :loc (write-location form)})
(install-writer! :number write-literal)
(install-writer! :string write-literal)
(install-writer! :boolean write-literal)
(install-writer! :re-pattern write-literal)

(defn write-constant
  [form]
  (let [type (:type form)]
    (cond (= type :list)
          (write-invoke (conj form {:op :invoke
                                    :callee {:op :var
                                             :form 'list}
                                    :params []}))
          :else (write-op type form))))
(install-writer! :constant write-constant)

(defn write-keyword
  [form]
  {:type :Literal
   :value (name (:form form))
   :loc (write-location form)})
(install-writer! :keyword write-keyword)

(defn write-var
  [form]
  {:type :Identifier
   :name (translate-identifier (:form form))
   :loc (write-location form)})
(install-writer! :var write-var)

(defn write-invoke
  [form]
  {:type :CallExpression
   :callee (write (:callee form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :invoke write-invoke)

(defn write-vector
  [form]
  {:type :ArrayExpression
   :elements (map write (:items form))
   :loc (write-location form)})
(install-writer! :vector write-vector)

(defn write-dictionary
  [form]
  (let [properties (partition 2 (interleave (:keys form)
                                            (:values form)))]
    {:type :ObjectExpression
     :properties (map (fn [pair]
                        {:kind :init
                         :type :Property
                         :key (write (first pair))
                         :value (write (second pair))})
                      properties)
     :loc (write-location form)}))
(install-writer! :dictionary write-dictionary)

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :declarations [{:type :VariableDeclarator
                   :id (write-var (:var form))
                   :init (if (nil? (:init form))
                           (write-nil {})
                           (write (:init form)))}]
   :loc (write-location form)})
(install-writer! :def write-def)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw form))
                 :loc (write-location form)}))
(install-writer! :throw write-throw)

(defn write-new
  [form]
  {:type :NewExpression
   :callee (write (:constructor form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :new write-new)

(defn write-set!
  [form]
  {:type :AssignmentExpression
   :operator :=
   :left (write (:target form))
   :right (write (:value form))
   :loc (write-location form)})
(install-writer! :set! write-set!)

(defn write-aget
  [form]
  {:type :MemberExpression
   :computed (:computed form)
   :object (write (:target form))
   :property (write (:property form))
   :loc (write-location form)})
(install-writer! :member-expression write-aget)

(defn write-statement
  [form]
  (let [op (:op form)]
    (if (or (= op :def)
            (= op :throw)
            (= op :try))
      (write form)
      {:type :ExpressionStatement
       :expression (write form)
       :loc (write-location form)})))

(defn write-body
  "Takes form that may contain `:statements` vector
  or `:result` form  and returns vector expression
  nodes that can be used in any block. If `:result`
  is present it will be a last in vector and of a
  `:ReturnStatement` type.
  Examples:

  (write-body {:statements nil
               :result {:op :constant
                        :type :number
                        :form 3}})
  ;; =>
  [{:type :ReturnStatement
    :argument {:type :Literal :value 3}}]

  (write-body {:statements [{:op :set!
                             :target {:op :var :form 'x}
                             :value {:op :var :form 'y}}]
               :result {:op :var :form 'x}})
  ;; =>
  [{:type :ExpressionStatement
    :expression {:type :AssignmentExpression
                 :operator :=
                 :left {:type :Identifier :name :x}
                 :right {:type :Identifier :name :y}}}
   {:type :ReturnStatement
    :argument {:type :Identifier :name :x}}]"
  [form]
  (let [statements (map write-statement
                        (or (:statements form) []))

        result (if (:result form)
                 {:type :ReturnStatement
                  :argument (write (:result form))})]

    (if result
      (conj statements result)
      statements)))

(defn ->block
  [body]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee {:type :SequenceExpression
            :expressions [{:type :FunctionExpression
                           :id nil
                           :params []
                           :defaults []
                           :expression false
                           :generator false
                           :rest nil
                           :body (->block body)}]}})

(defn write-do
  [form]
  (->expression (write-body form)))
(install-writer! :do write-do)

(defn write-if
  [form]
  {:type :ConditionalExpression
   :test (write (:test form))
   :consequent (write (:consequent form))
   :alternate (write (:alternate form))
   :loc (write-location form)})
(install-writer! :if write-if)

(defn write-try
  [form]
  (->expression {:type :TryStatement
                 :guardedHandlers []
                 :block (->block (write-body (:body form)))
                 :handlers (if (:handler form)
                             [{:type :CatchClause
                               :param (write (:name (:handler form)))
                               :body (->block (write-body (:handler form)))}]
                             [])
                 :finalizer (if (:finalizer form)
                              (->block (write-body (:finalizer form))))
                 :loc (write-location form)}))
(install-writer! :try write-try)

(defn- write-binding-value
  [form]
  (write (:init form)))

(defn- write-binding-param
  [form]
  (write-var {:form (:name form)}))

(defn write-let
  [form]
  {:type :CallExpression
   :arguments (map write-binding-value (:bindings form))
   :callee {:type :SequenceExpression
            :expressions [{:type :FunctionExpression
                           :id nil
                           :params (map write-binding-param
                                        (:bindings form))
                           :defaults []
                           :expression false
                           :generator false
                           :rest nil
                           :body (->block (write-body form))}]}})
(install-writer! :let write-let)
(defn write
  [form]
  (write-op (:op form) form))

(defn compile
  [form options]
  (generate (write form) options))

(ns wisp.backend.escodegen.writer
  (:require [wisp.reader :refer [read-from-string]]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj reverse reduce vec last map
                                   filter take concat partition interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [escodegen :refer [generate]]))

(defn translate-identifier
  "Translates references from clojure convention to JS:

  **macros**      __macros__
  list->vector    listToVector
  set!            set
  foo_bar         foo_bar
  number?         isNumber
  create-server   createServer"
  [form]
  (def id (name form))
  (set! id (cond (identical? id  "*") "multiply"
                 (identical? id "/") "divide"
                 (identical? id "+") "sum"
                 (identical? id "-") "subtract"
                 (identical? id "=") "equal?"
                 (identical? id "==") "strict-equal?"
                 (identical? id "<=") "not-greater-than"
                 (identical? id ">=") "not-less-than"
                 (identical? id ">") "greater-than"
                 (identical? id "<") "less-than"
                 :else id))

  ;; **macros** ->  __macros__
  (set! id (join "_" (split id "*")))
  ;; list->vector ->  listToVector
  (set! id (join "-to-" (split id "->")))
  ;; set! ->  set
  (set! id (join (split id "!")))
  (set! id (join "$" (split id "%")))
  ;; foo= -> fooEqual
  ;(set! id (join "-equal-" (split id "="))
  ;; foo+bar -> fooPlusBar
  (set! id (join "-plus-" (split id "+")))
  (set! id (join "-and-" (split id "&")))
  ;; number? -> isNumber
  (set! id (if (identical? (last id) "?")
             (str "is-" (subs id 0 (dec (count id))))
             id))
  ;; create-server -> createServer
  (set! id (reduce
            (fn [result key]
              (str result
                   (if (and (not (empty? result))
                            (not (empty? key)))
                     (str (upper-case (get key 0)) (subs key 1))
                     key)))
            ""
            (split id "-")))
  id)

;; Operators that compile to binary expressions

(defn make-binary-expression
  [operator left right]
  {:type :BinaryExpression
   :operator operator
   :left left
   :right right})

(defmacro def-binary-operator
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-binary-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-binary-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

(defn verify-one
  [operator]
  (error (str operator "form requires at least one operand")))

(defn verify-two
  [operator]
  (error (str operator "form requires at least two operands")))

;; Arithmetic operators

;(def-binary-operator :+ :+ 0 identity)
;(def-binary-operator :- :- 'NaN identity)
;(def-binary-operator :* :* 1 identity)
;(def-binary-operator (keyword "/") (keyword "/") verify-two verify-two)
;(def-binary-operator :mod (keyword "%") verify-two verify-two)

;; Comparison operators

;(def-binary-operator :not= :!= verify-one false)
;(def-binary-operator :== :=== verify-one true)
;(def-binary-operator :identical? '=== verify-two verify-two)
;(def-binary-operator :> :> verify-one true)
;(def-binary-operator :>= :>= verify-one true)
;(def-binary-operator :< :< verify-one true)
;(def-binary-operator :<= :<= verify-one true)

;; Bitwise Operators

;(def-binary-operator :bit-and :& verify-two verify-two)
;(def-binary-operator :bit-or :| verify-two verify-two)
;(def-binary-operator :bit-xor (keyword "^") verify-two verify-two)
;(def-binary-operator :bit-not (keyword "~") verify-two verify-two)
;(def-binary-operator :bit-shift-left :<< verify-two verify-two)
;(def-binary-operator :bit-shift-right :>> verify-two verify-two)
;(def-binary-operator :bit-shift-right-zero-fil :>>> verify-two verify-two)

;; Logical operators

(defn make-logical-expression
  [operator left right]
  {:type :LogicalExpression
   :operator operator
   :left left
   :right right})

(defmacro def-logical-expression
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-logical-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-logical-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

;(def-logical-expression :and :&& 'true identity)
;(def-logical-expression :and :|| 'nil identity)

(defn write-method-call
  [form]
  {:type :CallExpression
   :callee {:type :MemberExpression
            :computed false
            :object (write (first form))
            :property (write (second form))}
   :arguments (map write (vec (rest (rest params))))})

(defn write-instance?
  [form]
  {:type :BinaryExpression
   :operator :instanceof
   :left (write (second form))
   :right (write (first form))})

(defn write-not
  [form]
  {:type :UnaryExpression
   :operator :!
   :argument (write (second form))})

(defn write-location
  [form]
  (let [data (meta form)
        start (:start form)
        end (:end form)]
    (if (not (nil? start))
      {:start {:line (inc (:line start))
               :column (:column start)}
       :end {:line (inc (:line end))
             :column (inc (:column end))}})))

(def **writers** {})
(defn install-writer!
  [op writer]
  (set! (get **writers** op) writer))

(defn write-op
  [op form]
  (let [writer (get **writers** op)]
    (assert writer (str "Unsupported operation: " op))
    (writer form)))

(defn write-nil
  [form]
  {:type :UnaryExpression
   :operator :void
   :argument {:type :Literal
              :value 0}
   :prefix true
   :loc (write-location form)})
(install-writer! :nil write-nil)

(defn write-literal
  [form]
  {:type :Literal
   :value (:form form)
   :loc (write-location form)})
(install-writer! :number write-literal)
(install-writer! :string write-literal)
(install-writer! :boolean write-literal)
(install-writer! :re-pattern write-literal)

(defn write-constant
  [form]
  (let [type (:type form)]
    (cond (= type :list)
          (write-invoke (conj form {:op :invoke
                                    :callee {:op :var
                                             :form 'list}
                                    :params []}))
          :else (write-op type form))))
(install-writer! :constant write-constant)

(defn write-keyword
  [form]
  {:type :Literal
   :value (name (:form form))
   :loc (write-location form)})
(install-writer! :keyword write-keyword)

(defn write-var
  [form]
  {:type :Identifier
   :name (translate-identifier (:form form))
   :loc (write-location form)})
(install-writer! :var write-var)

(defn write-invoke
  [form]
  {:type :CallExpression
   :callee (write (:callee form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :invoke write-invoke)

(defn write-vector
  [form]
  {:type :ArrayExpression
   :elements (map write (:items form))
   :loc (write-location form)})
(install-writer! :vector write-vector)

(defn write-dictionary
  [form]
  (let [properties (partition 2 (interleave (:keys form)
                                            (:values form)))]
    {:type :ObjectExpression
     :properties (map (fn [pair]
                        {:kind :init
                         :type :Property
                         :key (write (first pair))
                         :value (write (second pair))})
                      properties)
     :loc (write-location form)}))
(install-writer! :dictionary write-dictionary)

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :declarations [{:type :VariableDeclarator
                   :id (write-var (:var form))
                   :init (if (nil? (:init form))
                           (write-nil {})
                           (write (:init form)))}]
   :loc (write-location form)})
(install-writer! :def write-def)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw form))
                 :loc (write-location form)}))
(install-writer! :throw write-throw)

(defn write-new
  [form]
  {:type :NewExpression
   :callee (write (:constructor form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :new write-new)

(defn write-set!
  [form]
  {:type :AssignmentExpression
   :operator :=
   :left (write (:target form))
   :right (write (:value form))
   :loc (write-location form)})
(install-writer! :set! write-set!)

(defn write-aget
  [form]
  {:type :MemberExpression
   :computed (:computed form)
   :object (write (:target form))
   :property (write (:property form))
   :loc (write-location form)})
(install-writer! :member-expression write-aget)

(defn write-statement
  [form]
  (let [op (:op form)]
    (if (or (= op :def)
            (= op :throw)
            (= op :try))
      (write form)
      {:type :ExpressionStatement
       :expression (write form)
       :loc (write-location form)})))

(defn write-body
  "Takes form that may contain `:statements` vector
  or `:result` form  and returns vector expression
  nodes that can be used in any block. If `:result`
  is present it will be a last in vector and of a
  `:ReturnStatement` type.
  Examples:

  (write-body {:statements nil
               :result {:op :constant
                        :type :number
                        :form 3}})
  ;; =>
  [{:type :ReturnStatement
    :argument {:type :Literal :value 3}}]

  (write-body {:statements [{:op :set!
                             :target {:op :var :form 'x}
                             :value {:op :var :form 'y}}]
               :result {:op :var :form 'x}})
  ;; =>
  [{:type :ExpressionStatement
    :expression {:type :AssignmentExpression
                 :operator :=
                 :left {:type :Identifier :name :x}
                 :right {:type :Identifier :name :y}}}
   {:type :ReturnStatement
    :argument {:type :Identifier :name :x}}]"
  [form]
  (let [statements (map write-statement
                        (or (:statements form) []))

        result (if (:result form)
                 {:type :ReturnStatement
                  :argument (write (:result form))})]

    (if result
      (conj statements result)
      statements)))

(defn ->block
  [body]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee {:type :SequenceExpression
            :expressions [{:type :FunctionExpression
                           :id nil
                           :params []
                           :defaults []
                           :expression false
                           :generator false
                           :rest nil
                           :body (->block body)}]}})

(defn write-do
  [form]
  (->expression (write-body form)))
(install-writer! :do write-do)

(defn write-if
  [form]
  {:type :ConditionalExpression
   :test (write (:test form))
   :consequent (write (:consequent form))
   :alternate (write (:alternate form))
   :loc (write-location form)})
(install-writer! :if write-if)

(defn write-try
  [form]
  (->expression {:type :TryStatement
                 :guardedHandlers []
                 :block (->block (write-body (:body form)))
                 :handlers (if (:handler form)
                             [{:type :CatchClause
                               :param (write (:name (:handler form)))
                               :body (->block (write-body (:handler form)))}]
                             [])
                 :finalizer (if (:finalizer form)
                              (->block (write-body (:finalizer form))))
                 :loc (write-location form)}))
(install-writer! :try write-try)

(defn write
  [form]
  (write-op (:op form) form))

(defn compile
  [form options]
  (generate (write form) options))


Enhance `write-body` so that it can take forms that contain either :result :statements or both.

(ns wisp.backend.escodegen.writer
  (:require [wisp.reader :refer [read-from-string]]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj reverse reduce vec last map
                                   filter take concat partition interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [escodegen :refer [generate]]))

(defn translate-identifier
  "Translates references from clojure convention to JS:

  **macros**      __macros__
  list->vector    listToVector
  set!            set
  foo_bar         foo_bar
  number?         isNumber
  create-server   createServer"
  [form]
  (def id (name form))
  (set! id (cond (identical? id  "*") "multiply"
                 (identical? id "/") "divide"
                 (identical? id "+") "sum"
                 (identical? id "-") "subtract"
                 (identical? id "=") "equal?"
                 (identical? id "==") "strict-equal?"
                 (identical? id "<=") "not-greater-than"
                 (identical? id ">=") "not-less-than"
                 (identical? id ">") "greater-than"
                 (identical? id "<") "less-than"
                 :else id))

  ;; **macros** ->  __macros__
  (set! id (join "_" (split id "*")))
  ;; list->vector ->  listToVector
  (set! id (join "-to-" (split id "->")))
  ;; set! ->  set
  (set! id (join (split id "!")))
  (set! id (join "$" (split id "%")))
  ;; foo= -> fooEqual
  ;(set! id (join "-equal-" (split id "="))
  ;; foo+bar -> fooPlusBar
  (set! id (join "-plus-" (split id "+")))
  (set! id (join "-and-" (split id "&")))
  ;; number? -> isNumber
  (set! id (if (identical? (last id) "?")
             (str "is-" (subs id 0 (dec (count id))))
             id))
  ;; create-server -> createServer
  (set! id (reduce
            (fn [result key]
              (str result
                   (if (and (not (empty? result))
                            (not (empty? key)))
                     (str (upper-case (get key 0)) (subs key 1))
                     key)))
            ""
            (split id "-")))
  id)

;; Operators that compile to binary expressions

(defn make-binary-expression
  [operator left right]
  {:type :BinaryExpression
   :operator operator
   :left left
   :right right})

(defmacro def-binary-operator
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-binary-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-binary-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

(defn verify-one
  [operator]
  (error (str operator "form requires at least one operand")))

(defn verify-two
  [operator]
  (error (str operator "form requires at least two operands")))

;; Arithmetic operators

;(def-binary-operator :+ :+ 0 identity)
;(def-binary-operator :- :- 'NaN identity)
;(def-binary-operator :* :* 1 identity)
;(def-binary-operator (keyword "/") (keyword "/") verify-two verify-two)
;(def-binary-operator :mod (keyword "%") verify-two verify-two)

;; Comparison operators

;(def-binary-operator :not= :!= verify-one false)
;(def-binary-operator :== :=== verify-one true)
;(def-binary-operator :identical? '=== verify-two verify-two)
;(def-binary-operator :> :> verify-one true)
;(def-binary-operator :>= :>= verify-one true)
;(def-binary-operator :< :< verify-one true)
;(def-binary-operator :<= :<= verify-one true)

;; Bitwise Operators

;(def-binary-operator :bit-and :& verify-two verify-two)
;(def-binary-operator :bit-or :| verify-two verify-two)
;(def-binary-operator :bit-xor (keyword "^") verify-two verify-two)
;(def-binary-operator :bit-not (keyword "~") verify-two verify-two)
;(def-binary-operator :bit-shift-left :<< verify-two verify-two)
;(def-binary-operator :bit-shift-right :>> verify-two verify-two)
;(def-binary-operator :bit-shift-right-zero-fil :>>> verify-two verify-two)

;; Logical operators

(defn make-logical-expression
  [operator left right]
  {:type :LogicalExpression
   :operator operator
   :left left
   :right right})

(defmacro def-logical-expression
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-logical-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-logical-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

;(def-logical-expression :and :&& 'true identity)
;(def-logical-expression :and :|| 'nil identity)

(defn write-method-call
  [form]
  {:type :CallExpression
   :callee {:type :MemberExpression
            :computed false
            :object (write (first form))
            :property (write (second form))}
   :arguments (map write (vec (rest (rest params))))})

(defn write-instance?
  [form]
  {:type :BinaryExpression
   :operator :instanceof
   :left (write (second form))
   :right (write (first form))})

(defn write-not
  [form]
  {:type :UnaryExpression
   :operator :!
   :argument (write (second form))})

(defn write-location
  [form]
  (let [data (meta form)
        start (:start form)
        end (:end form)]
    (if (not (nil? start))
      {:start {:line (inc (:line start))
               :column (:column start)}
       :end {:line (inc (:line end))
             :column (inc (:column end))}})))

(def **writers** {})
(defn install-writer!
  [op writer]
  (set! (get **writers** op) writer))

(defn write-op
  [op form]
  (let [writer (get **writers** op)]
    (assert writer (str "Unsupported operation: " op))
    (writer form)))

(defn write-nil
  [form]
  {:type :UnaryExpression
   :operator :void
   :argument {:type :Literal
              :value 0}
   :prefix true
   :loc (write-location form)})
(install-writer! :nil write-nil)

(defn write-literal
  [form]
  {:type :Literal
   :value (:form form)
   :loc (write-location form)})
(install-writer! :number write-literal)
(install-writer! :string write-literal)
(install-writer! :boolean write-literal)
(install-writer! :re-pattern write-literal)

(defn write-constant
  [form]
  (let [type (:type form)]
    (cond (= type :list)
          (write-invoke (conj form {:op :invoke
                                    :callee {:op :var
                                             :form 'list}
                                    :params []}))
          :else (write-op type form))))
(install-writer! :constant write-constant)

(defn write-keyword
  [form]
  {:type :Literal
   :value (name (:form form))
   :loc (write-location form)})
(install-writer! :keyword write-keyword)

(defn write-var
  [form]
  {:type :Identifier
   :name (translate-identifier (:form form))
   :loc (write-location form)})
(install-writer! :var write-var)

(defn write-invoke
  [form]
  {:type :CallExpression
   :callee (write (:callee form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :invoke write-invoke)

(defn write-vector
  [form]
  {:type :ArrayExpression
   :elements (map write (:items form))
   :loc (write-location form)})
(install-writer! :vector write-vector)

(defn write-dictionary
  [form]
  (let [properties (partition 2 (interleave (:keys form)
                                            (:values form)))]
    {:type :ObjectExpression
     :properties (map (fn [pair]
                        {:kind :init
                         :type :Property
                         :key (write (first pair))
                         :value (write (second pair))})
                      properties)
     :loc (write-location form)}))
(install-writer! :dictionary write-dictionary)

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :declarations [{:type :VariableDeclarator
                   :id (write-var (:var form))
                   :init (if (nil? (:init form))
                           (write-nil {})
                           (write (:init form)))}]
   :loc (write-location form)})
(install-writer! :def write-def)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw form))
                 :loc (write-location form)}))
(install-writer! :throw write-throw)

(defn write-new
  [form]
  {:type :NewExpression
   :callee (write (:constructor form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :new write-new)

(defn write-set!
  [form]
  {:type :AssignmentExpression
   :operator :=
   :left (write (:target form))
   :right (write (:value form))
   :loc (write-location form)})
(install-writer! :set! write-set!)

(defn write-aget
  [form]
  {:type :MemberExpression
   :computed (:computed form)
   :object (write (:target form))
   :property (write (:property form))
   :loc (write-location form)})
(install-writer! :member-expression write-aget)

(defn write-statement
  [form]
  (let [op (:op form)]
    (if (or (= op :def)
            (= op :throw)
            (= op :try))
      (write form)
      {:type :ExpressionStatement
       :expression (write form)
       :loc (write-location form)})))

(defn write-body
  "Takes form that may contain `:statements` vector
  or `:result` form  and returns vector expression
  nodes that can be used in any block. If `:result`
  is present it will be a last in vector and of a
  `:ReturnStatement` type.
  Examples:

  (write-body {:statements nil
               :result {:op :constant
                        :type :number
                        :form 3}})
  ;; =>
  [{:type :ReturnStatement
    :argument {:type :Literal :value 3}}]

  (write-body {:statements [{:op :set!
                             :target {:op :var :form 'x}
                             :value {:op :var :form 'y}}]
               :result {:op :var :form 'x}})
  ;; =>
  [{:type :ExpressionStatement
    :expression {:type :AssignmentExpression
                 :operator :=
                 :left {:type :Identifier :name :x}
                 :right {:type :Identifier :name :y}}}
   {:type :ReturnStatement
    :argument {:type :Identifier :name :x}}]"
  [form]
  (let [statements (map write-statement
                        (or (:statements form) []))

        result (if (:result form)
                 {:type :ReturnStatement
                  :argument (write (:result form))})]

    (if result
      (conj statements result)
      statements)))

(defn ->block
  [body]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee {:type :SequenceExpression
            :expressions [{:type :FunctionExpression
                           :id nil
                           :params []
                           :defaults []
                           :expression false
                           :generator false
                           :rest nil
                           :body (->block body)}]}})

(defn write-do
  [form]
  (->expression (write-body form)))
(install-writer! :do write-do)

(defn write-if
  [form]
  {:type :ConditionalExpression
   :test (write (:test form))
   :consequent (write (:consequent form))
   :alternate (write (:alternate form))
   :loc (write-location form)})
(install-writer! :if write-if)

(defn write-try
  [form]
  (->expression {:type :TryStatement
                 :guardedHandlers []
                 :block (->block (write-body (:body form)))
                 :handlers (if (:handler form)
                             [{:type :CatchClause
                               :param (write (:name (:handler form)))
                               :body (->block (write-body (:handler form)))}]
                             [])
                 :finalizer (if (:finalizer form)
                              (->block (write-body (:finalizer form))))
                 :loc (write-location form)}))
(install-writer! :try write-try)

(defn write
  [form]
  (write-op (:op form) form))

(defn compile
  [form options]
  (generate (write form) options))

(ns wisp.backend.escodegen.writer
  (:require [wisp.reader :refer [read-from-string]]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj reverse reduce vec last map
                                   filter take concat partition interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [escodegen :refer [generate]]))

(defn translate-identifier
  "Translates references from clojure convention to JS:

  **macros**      __macros__
  list->vector    listToVector
  set!            set
  foo_bar         foo_bar
  number?         isNumber
  create-server   createServer"
  [form]
  (def id (name form))
  (set! id (cond (identical? id  "*") "multiply"
                 (identical? id "/") "divide"
                 (identical? id "+") "sum"
                 (identical? id "-") "subtract"
                 (identical? id "=") "equal?"
                 (identical? id "==") "strict-equal?"
                 (identical? id "<=") "not-greater-than"
                 (identical? id ">=") "not-less-than"
                 (identical? id ">") "greater-than"
                 (identical? id "<") "less-than"
                 :else id))

  ;; **macros** ->  __macros__
  (set! id (join "_" (split id "*")))
  ;; list->vector ->  listToVector
  (set! id (join "-to-" (split id "->")))
  ;; set! ->  set
  (set! id (join (split id "!")))
  (set! id (join "$" (split id "%")))
  ;; foo= -> fooEqual
  ;(set! id (join "-equal-" (split id "="))
  ;; foo+bar -> fooPlusBar
  (set! id (join "-plus-" (split id "+")))
  (set! id (join "-and-" (split id "&")))
  ;; number? -> isNumber
  (set! id (if (identical? (last id) "?")
             (str "is-" (subs id 0 (dec (count id))))
             id))
  ;; create-server -> createServer
  (set! id (reduce
            (fn [result key]
              (str result
                   (if (and (not (empty? result))
                            (not (empty? key)))
                     (str (upper-case (get key 0)) (subs key 1))
                     key)))
            ""
            (split id "-")))
  id)

;; Operators that compile to binary expressions

(defn make-binary-expression
  [operator left right]
  {:type :BinaryExpression
   :operator operator
   :left left
   :right right})

(defmacro def-binary-operator
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-binary-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-binary-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

(defn verify-one
  [operator]
  (error (str operator "form requires at least one operand")))

(defn verify-two
  [operator]
  (error (str operator "form requires at least two operands")))

;; Arithmetic operators

;(def-binary-operator :+ :+ 0 identity)
;(def-binary-operator :- :- 'NaN identity)
;(def-binary-operator :* :* 1 identity)
;(def-binary-operator (keyword "/") (keyword "/") verify-two verify-two)
;(def-binary-operator :mod (keyword "%") verify-two verify-two)

;; Comparison operators

;(def-binary-operator :not= :!= verify-one false)
;(def-binary-operator :== :=== verify-one true)
;(def-binary-operator :identical? '=== verify-two verify-two)
;(def-binary-operator :> :> verify-one true)
;(def-binary-operator :>= :>= verify-one true)
;(def-binary-operator :< :< verify-one true)
;(def-binary-operator :<= :<= verify-one true)

;; Bitwise Operators

;(def-binary-operator :bit-and :& verify-two verify-two)
;(def-binary-operator :bit-or :| verify-two verify-two)
;(def-binary-operator :bit-xor (keyword "^") verify-two verify-two)
;(def-binary-operator :bit-not (keyword "~") verify-two verify-two)
;(def-binary-operator :bit-shift-left :<< verify-two verify-two)
;(def-binary-operator :bit-shift-right :>> verify-two verify-two)
;(def-binary-operator :bit-shift-right-zero-fil :>>> verify-two verify-two)

;; Logical operators

(defn make-logical-expression
  [operator left right]
  {:type :LogicalExpression
   :operator operator
   :left left
   :right right})

(defmacro def-logical-expression
  [id operator default-operand make-operand]
  `(set-operator! (name ~id)
                  (fn make-expression
                    ([] (write ~default-operand))
                    ([operand] (write (~make-operand operand)))
                    ([left right] (make-logical-expression ~operator
                                                          (write left)
                                                          (write right)))
                    ([left & more] (make-logical-expression ~operator
                                                          (write left)
                                                          (apply make-expression right))))))

;(def-logical-expression :and :&& 'true identity)
;(def-logical-expression :and :|| 'nil identity)

(defn write-method-call
  [form]
  {:type :CallExpression
   :callee {:type :MemberExpression
            :computed false
            :object (write (first form))
            :property (write (second form))}
   :arguments (map write (vec (rest (rest params))))})

(defn write-instance?
  [form]
  {:type :BinaryExpression
   :operator :instanceof
   :left (write (second form))
   :right (write (first form))})

(defn write-not
  [form]
  {:type :UnaryExpression
   :operator :!
   :argument (write (second form))})

(defn write-location
  [form]
  (let [data (meta form)
        start (:start form)
        end (:end form)]
    (if (not (nil? start))
      {:start {:line (inc (:line start))
               :column (:column start)}
       :end {:line (inc (:line end))
             :column (inc (:column end))}})))

(def **writers** {})
(defn install-writer!
  [op writer]
  (set! (get **writers** op) writer))

(defn write-op
  [op form]
  (let [writer (get **writers** op)]
    (assert writer (str "Unsupported operation: " op))
    (writer form)))

(defn write-nil
  [form]
  {:type :UnaryExpression
   :operator :void
   :argument {:type :Literal
              :value 0}
   :prefix true
   :loc (write-location form)})
(install-writer! :nil write-nil)

(defn write-literal
  [form]
  {:type :Literal
   :value (:form form)
   :loc (write-location form)})
(install-writer! :number write-literal)
(install-writer! :string write-literal)
(install-writer! :boolean write-literal)
(install-writer! :re-pattern write-literal)

(defn write-constant
  [form]
  (let [type (:type form)]
    (cond (= type :list)
          (write-invoke (conj form {:op :invoke
                                    :callee {:op :var
                                             :form 'list}
                                    :params []}))
          :else (write-op type form))))
(install-writer! :constant write-constant)

(defn write-keyword
  [form]
  {:type :Literal
   :value (name (:form form))
   :loc (write-location form)})
(install-writer! :keyword write-keyword)

(defn write-var
  [form]
  {:type :Identifier
   :name (translate-identifier (:form form))
   :loc (write-location form)})
(install-writer! :var write-var)

(defn write-invoke
  [form]
  {:type :CallExpression
   :callee (write (:callee form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :invoke write-invoke)

(defn write-vector
  [form]
  {:type :ArrayExpression
   :elements (map write (:items form))
   :loc (write-location form)})
(install-writer! :vector write-vector)

(defn write-dictionary
  [form]
  (let [properties (partition 2 (interleave (:keys form)
                                            (:values form)))]
    {:type :ObjectExpression
     :properties (map (fn [pair]
                        {:kind :init
                         :type :Property
                         :key (write (first pair))
                         :value (write (second pair))})
                      properties)
     :loc (write-location form)}))
(install-writer! :dictionary write-dictionary)

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :declarations [{:type :VariableDeclarator
                   :id (write-var (:var form))
                   :init (if (nil? (:init form))
                           (write-nil {})
                           (write (:init form)))}]
   :loc (write-location form)})
(install-writer! :def write-def)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw form))
                 :loc (write-location form)}))
(install-writer! :throw write-throw)

(defn write-new
  [form]
  {:type :NewExpression
   :callee (write (:constructor form))
   :arguments (map write (:params form))
   :loc (write-location form)})
(install-writer! :new write-new)

(defn write-set!
  [form]
  {:type :AssignmentExpression
   :operator :=
   :left (write (:target form))
   :right (write (:value form))
   :loc (write-location form)})
(install-writer! :set! write-set!)

(defn write-aget
  [form]
  {:type :MemberExpression
   :computed (:computed form)
   :object (write (:target form))
   :property (write (:property form))
   :loc (write-location form)})
(install-writer! :member-expression write-aget)

(defn write-statement
  [form]
  (let [op (:op form)]
    (if (or (= op :def)
            (= op :throw)
            (= op :try))
      (write form)
      {:type :ExpressionStatement
       :expression (write form)
       :loc (write-location form)})))

(defn write-body
  [form]
  (let [statements (or (:statements form) [])
        result (:result form)]
    (conj (map write-statement statements)
          (if result
            {:type :ReturnStatement
             :argument (write (:result form))}))))

(defn ->block
  [body]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee {:type :SequenceExpression
            :expressions [{:type :FunctionExpression
                           :id nil
                           :params []
                           :defaults []
                           :expression false
                           :generator false
                           :rest nil
                           :body (->block body)}]}})

(defn write-do
  [form]
  (->expression (write-body form)))
(install-writer! :do write-do)

(defn write-if
  [form]
  {:type :ConditionalExpression
   :test (write (:test form))
   :consequent (write (:consequent form))
   :alternate (write (:alternate form))
   :loc (write-location form)})
(install-writer! :if write-if)

(defn write-try
  [form]
  (->expression {:type :TryStatement
                 :guardedHandlers []
                 :block (->block (write-body (:body form)))
                 :handlers (if (:handler form)
                             [{:type :CatchClause
                               :param (write (:name (:handler form)))
                               :body (->block (write-body (:handler form)))}]
                             [])
                 :finalizer (if (:finalizer form)
                              (->block (write-body (:finalizer form))))
                 :loc (write-location form)}))
(install-writer! :try write-try)

(defn write
  [form]
  (write-op (:op form) form))

(defn compile
  [form options]
  (generate (write form) options))


Use `conj` instead of `.concat`.

Use `conj` instead of `.concat`.

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

(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]
 (or (identical? ch " ")
     (identical? ch "\t")
     (identical? ch "\n")
     (identical? ch "\r")))

(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]
 (or (identical? ch \0)
     (identical? ch \1)
     (identical? ch \2)
     (identical? ch \3)
     (identical? ch \4)
     (identical? ch \5)
     (identical? ch \6)
     (identical? ch \7)
     (identical? ch \8)
     (identical? ch \9)))

(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 (str 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)]
    (char 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)
        (char 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
                       (conj a mret))))
            (do
              (unread-char reader ch)
              (let [o (read reader true nil recursive?)]
                (recur (if (identical? o reader)
                         a
                         (conj 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? (count 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)
        parts (split token "/")
        has-ns (> (count parts) 1)]
    (if has-ns
      (symbol (first parts) (join "/" (rest parts)))
      (special-symbols token (symbol token)))))

(defn read-keyword
  [reader initch]
  (let [token (read-token reader (read-char reader))
        parts (split token "/")
        name (last parts)
        ns (if (> (count parts) 1) (join "/" (butlast parts)))
        issue (cond
               (identical? (last ns) \:) "namespace can't ends with \":\""
               (identical? (last name) \:) "name can't end with \":\""
               (identical? (last name) \/) "name can't end with \"/\""
               (> (count (split token "::")) 1) "name can't contain \"::\"")]
    (if issue
      (reader-error reader "Invalid token (" issue "): " token)
      (if (and (not ns) (identical? (first name) \:))
        (keyword ;*ns-sym*
          (rest name)) ;; namespaced keyword using default
        (keyword ns name)))))

(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 _]
  (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 concat last butlast] "./sequence")
(import [odd? dictionary keys nil? inc dec vector? string? object?
         re-pattern re-matches re-find str subs char] "./runtime")
(import [symbol? symbol keyword? keyword meta with-meta name] "./ast")
(import [split join] "./string")

(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]
 (or (identical? ch " ")
     (identical? ch "\t")
     (identical? ch "\n")
     (identical? ch "\r")))

(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]
 (or (identical? ch \0)
     (identical? ch \1)
     (identical? ch \2)
     (identical? ch \3)
     (identical? ch \4)
     (identical? ch \5)
     (identical? ch \6)
     (identical? ch \7)
     (identical? ch \8)
     (identical? ch \9)))

(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 (str 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)]
    (char 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)
        (char 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? (count 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)
        parts (split token "/")
        has-ns (> (count parts) 1)]
    (if has-ns
      (symbol (first parts) (join "/" (rest parts)))
      (special-symbols token (symbol token)))))

(defn read-keyword
  [reader initch]
  (let [token (read-token reader (read-char reader))
        parts (split token "/")
        name (last parts)
        ns (if (> (count parts) 1) (join "/" (butlast parts)))
        issue (cond
               (identical? (last ns) \:) "namespace can't ends with \":\""
               (identical? (last name) \:) "name can't end with \":\""
               (identical? (last name) \/) "name can't end with \"/\""
               (> (count (split token "::")) 1) "name can't contain \"::\"")]
    (if issue
      (reader-error reader "Invalid token (" issue "): " token)
      (if (and (not ns) (identical? (first name) \:))
        (keyword ;*ns-sym*
          (rest name)) ;; namespaced keyword using default
        (keyword ns name)))))

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


Remove dependencies on JS specific code.

(import [list? first count] "./sequence")
(import [nil? vector? number? string? boolean? object? str subs] "./runtime")

(defn with-meta
  "Returns identical value with given metadata associated to it."
  [value metadata]
  (set! value.metadata metadata)
  value)

(defn meta
  "Returns the metadata of the given value or nil if there is no metadata."
  [value]
  (if (object? value) (.-metadata value)))

(defn symbol
  "Returns a Symbol with the given namespace and name."
  [ns id]
  (cond
   (symbol? ns) ns
   (keyword? ns) (str "\uFEFF" (name ns))
   :else (if (nil? id)
           (str "\uFEFF" ns)
           (str "\uFEFF" ns "/" id))))

(defn ^boolean symbol? [x]
  (and (string? x)
       (> (count x) 1)
       (identical? (first x) "\uFEFF")))

(defn ^boolean keyword? [x]
  (and (string? x)
       (> (count x) 1)
       (identical? (first x) "\uA789")))

(defn keyword
  "Returns a Keyword with the given namespace and name. Do not use :
  in the keyword strings, it will be added automatically."
  [ns id]
  (cond
   (keyword? ns) ns
   (symbol? ns) (str "\uA789" (name ns))
   (nil? id) (str "\uA789" ns)
   (nil? ns) (str "\uA789" id)
   :else (str "\uA789" ns "/" id)))

(defn name
  "Returns the name String of a string, symbol or keyword."
  [value]
  (cond
    (or (keyword? value)
        (symbol? value)) (if (and (> (count value) 2)
                                  (>= (.index-of value "/") 0))
                          (.substr value (+ (.index-of value "/") 1))
                          (subs value 1))

    ;; Needs to be after keyword? and symbol? because keywords and
    ;; symbols are strings.
    (string? value) value
    :else (throw (TypeError. (str "Doesn't support name: " value)))))

(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__'."
  [prefix]
  (symbol (str (if (nil? prefix) "G__" prefix)
               (set! gensym.base (+ gensym.base 1)))))
(set! gensym.base 0)

(defn ^boolean unquote?
  "Returns true if it's unquote form: ~foo"
  [form]
  (and (list? form) (identical? (first form) 'unquote)))

(defn ^boolean unquote-splicing?
  "Returns true if it's unquote-splicing form: ~@foo"
  [form]
  (and (list? form) (identical? (first form) 'unquote-splicing)))

(defn ^boolean quote?
  "Returns true if it's quote form: 'foo '(foo)"
  [form]
  (and (list? form) (identical? (first form) 'quote)))

(defn ^boolean syntax-quote?
  "Returns true if it's syntax quote form: `foo `(foo)"
  [form]
  (and (list? form) (identical? (first form) 'syntax-quote)))

(export meta with-meta
        symbol? symbol
        keyword? keyword
        gensym name
        unquote?
        unquote-splicing?
        quote?
        syntax-quote?)

(import [list? first count] "./sequence")
(import [nil? vector? number? string? boolean? object? str] "./runtime")

(defn with-meta
  "Returns identical value with given metadata associated to it."
  [value metadata]
  (set! value.metadata metadata)
  value)

(defn meta
  "Returns the metadata of the given value or nil if there is no metadata."
  [value]
  (if (object? value) (.-metadata value)))

(defn symbol
  "Returns a Symbol with the given namespace and name."
  [ns id]
  (cond
   (symbol? ns) ns
   (keyword? ns) (.concat "\uFEFF" (name ns))
   :else (if (nil? id)
           (.concat "\uFEFF" ns)
           (.concat "\uFEFF" ns "/" id))))

(defn ^boolean symbol? [x]
  (and (string? x)
       (> (count x) 1)
       (identical? (.char-at x 0) "\uFEFF")))

(defn ^boolean keyword? [x]
  (and (string? x)
       (> (count x) 1)
       (identical? (.char-at x 0) "\uA789")))

(defn keyword
  "Returns a Keyword with the given namespace and name. Do not use :
  in the keyword strings, it will be added automatically."
  [ns id]
  (cond
   (keyword? ns) ns
   (symbol? ns) (.concat "\uA789" (name ns))
   :else (if (nil? id)
           (.concat "\uA789" ns)
           (.concat "\uA789" ns "/" id))))

(defn name
  "Returns the name String of a string, symbol or keyword."
  [value]
  (cond
    (or (keyword? value) (symbol? value))
      (if (and (> (.-length value) 2)
               (>= (.index-of value "/") 0))
        (.substr value (+ (.index-of value "/") 1))
        (.substr value 1))
    (string? value) value))

(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__'."
  [prefix]
  (symbol (str (if (nil? prefix) "G__" prefix)
               (set! gensym.base (+ gensym.base 1)))))
(set! gensym.base 0)

(defn ^boolean unquote?
  "Returns true if it's unquote form: ~foo"
  [form]
  (and (list? form) (identical? (first form) 'unquote)))

(defn ^boolean unquote-splicing?
  "Returns true if it's unquote-splicing form: ~@foo"
  [form]
  (and (list? form) (identical? (first form) 'unquote-splicing)))

(defn ^boolean quote?
  "Returns true if it's quote form: 'foo '(foo)"
  [form]
  (and (list? form) (identical? (first form) 'quote)))

(defn ^boolean syntax-quote?
  "Returns true if it's syntax quote form: `foo `(foo)"
  [form]
  (and (list? form) (identical? (first form) 'syntax-quote)))

(export meta with-meta
        symbol? symbol
        keyword? keyword
        gensym name
        unquote?
        unquote-splicing?
        quote?
        syntax-quote?)


No longer include encoding into generated source-map uri.

(ns wisp.backend.escodegen.compiler
  (:require [wisp.reader :refer [read-from-string read*]
                         :rename {read-from-string read-string}]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj butlast reverse reduce vec
                                   last map filter take concat partition
                                   repeat interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [wisp.expander :refer [install-macro!]]
            [wisp.analyzer :refer [empty-env analyze analyze*]]
            [wisp.backend.escodegen.writer :refer [write compile write*]]

            [escodegen :refer [generate] :rename {generate generate*}]
            [base64-encode :as btoa]
            [fs :refer [read-file-sync write-file-sync]]
            [path :refer [basename dirname join]
                  :rename {join join-path}]))

(defn generate
  [options & nodes]
  (let [ast (apply write* nodes)

        output (generate* ast {:file (:output-uri options)
                               :sourceContent (:source options)
                               :sourceMap (:source-uri options)
                               :sourceMapRoot (:source-root options)
                               :sourceMapWithCode true})]

    ;; Workaround the fact that escodegen does not yet includes source
    (.setSourceContent (:map output)
                       (:source-uri options)
                       (:source options))

    {:code (str (:code output)
                "\n//# sourceMappingURL="
                "data:application/json;base64,"
                (btoa (str (:map output)))
                "\n")
     :source-map (:map output)
     :ast-js (if (:include-js-ast options) ast)}))

(defn expand-defmacro
  "Like defn, but the resulting function name is declared as a
  macro and will be used as a macro by the compiler when it is
  called."
  [&form id & body]
  (let [fn (with-meta `(defn ~id ~@body) (meta &form))
        form `(do ~fn ~id)
        ast (analyze form)
        code (compile ast)
        macro (eval code)]
    (install-macro! id macro)
    nil))
(install-macro! 'defmacro (with-meta expand-defmacro {:implicit [:&form]}))

(ns wisp.backend.escodegen.compiler
  (:require [wisp.reader :refer [read-from-string read*]
                         :rename {read-from-string read-string}]
            [wisp.ast :refer [meta with-meta symbol? symbol keyword? keyword
                              namespace unquote? unquote-splicing? quote?
                              syntax-quote? name gensym pr-str]]
            [wisp.sequence :refer [empty? count list? list first second third
                                   rest cons conj butlast reverse reduce vec
                                   last map filter take concat partition
                                   repeat interleave]]
            [wisp.runtime :refer [odd? dictionary? dictionary merge keys vals
                                  contains-vector? map-dictionary string?
                                  number? vector? boolean? subs re-find true?
                                  false? nil? re-pattern? inc dec str char
                                  int = ==]]
            [wisp.string :refer [split join upper-case replace]]
            [wisp.expander :refer [install-macro!]]
            [wisp.analyzer :refer [empty-env analyze analyze*]]
            [wisp.backend.escodegen.writer :refer [write compile write*]]

            [escodegen :refer [generate] :rename {generate generate*}]
            [base64-encode :as btoa]
            [fs :refer [read-file-sync write-file-sync]]
            [path :refer [basename dirname join]
                  :rename {join join-path}]))

(defn generate
  [options & nodes]
  (let [ast (apply write* nodes)

        output (generate* ast {:file (:output-uri options)
                               :sourceContent (:source options)
                               :sourceMap (:source-uri options)
                               :sourceMapRoot (:source-root options)
                               :sourceMapWithCode true})]

    ;; Workaround the fact that escodegen does not yet includes source
    (.setSourceContent (:map output)
                       (:source-uri options)
                       (:source options))

    {:code (str (:code output)
                "\n//# sourceMappingURL="
                "data:application/json;charset=utf-8;base64,"
                (btoa (str (:map output)))
                "\n")
     :source-map (:map output)
     :ast-js (if (:include-js-ast options) ast)}))

(defn expand-defmacro
  "Like defn, but the resulting function name is declared as a
  macro and will be used as a macro by the compiler when it is
  called."
  [&form id & body]
  (let [fn (with-meta `(defn ~id ~@body) (meta &form))
        form `(do ~fn ~id)
        ast (analyze form)
        code (compile ast)
        macro (eval code)]
    (install-macro! id macro)
    nil))
(install-macro! 'defmacro (with-meta expand-defmacro {:implicit [:&form]}))