(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 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!]]
            [escodegen :refer [generate]]))


;; Define character that is valid JS identifier that will
;; be used in generated symbols to avoid conflicts
;; http://www.fileformat.info/info/unicode/char/f8/index.htm
(def **unique-char** "\u00F8")

(defn ->camel-join
  [prefix key]
  (str prefix
       (if (and (not (empty? prefix))
                (not (empty? key)))
         (str (upper-case (get key 0)) (subs key 1))
         key)))

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

  **macros**      __macros__
  list->vector    listToVector
  set!            set
  foo_bar         foo_bar
  number?         isNumber
  red=            redEqual
  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 "%")))
  (set! id (join "-equal-" (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 ->camel-join "" (split id "-")))
  id)

(defn translate-identifier
  [form]
  (join \. (map translate-identifier-word (split (name form) \.))))

(defn error-arg-count
  [callee n]
  (throw (SyntaxError (str "Wrong number of arguments (" n ") passed to: " callee))))

(defn inherit-location
  [body]
  (let [start (:start (:loc (first body)))
        end (:end (:loc (last body)))]
    (if (not (or (nil? start) (nil? end)))
      {:start start :end end})))


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

(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))
    (conj (write-location (:form form) (:original-form form))
          (writer form))))

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

(defn write-special
  [writer form]
  (conj (write-location (:form form) (:original-form form))
        (apply writer (:params form))))


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

(defn write-literal
  [form]
  {:type :Literal
   :value form})

(defn write-list
  [form]
  {:type :CallExpression
   :callee (write {:op :var
                   :form 'list})
   :arguments (map write (:items form))})
(install-writer! :list write-list)

(defn write-symbol
  [form]
  {:type :CallExpression
   :callee (write {:op :var
                   :form 'symbol})
   :arguments [(write-constant (:namespace form))
               (write-constant (:name form))]})
(install-writer! :symbol write-symbol)

(defn write-constant
  [form]
  (cond (nil? form) (write-nil form)
        (keyword? form) (write-literal (name form))
        (number? form) (write-number (.valueOf form))
        (string? form) (write-string form)
        :else (write-literal form)))
(install-writer! :constant #(write-constant (:form %)))

(defn write-string
  [form]
  {:type :Literal
   :value (str form)})

(defn write-number
  [form]
  (if (< form 0)
    {:type :UnaryExpression
     :operator :-
     :prefix true
     :argument (write-number (* form -1))}
    (write-literal form)))

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

(defn ->identifier
  [form]
  {:type :Identifier
   :name (translate-identifier form)})

(defn write-binding-var
  [form]
  (let [id (name (:id form))]
    ;; If identifiers binding shadows other binding rename it according
    ;; to shadowing depth. This allows bindings initializer safely
    ;; access binding before shadowing it.
    (conj (->identifier (if (:shadow form)
                          (str (translate-identifier id)
                               **unique-char**
                               (:depth form))
                          id))
          (write-location (:id form)))))

(defn write-var
  "handler for {:op :var} type forms. Such forms may
  represent references in which case they have :info
  pointing to a declaration :var which way be either
  function parameter (has :param true) or local
  binding declaration (has :binding true) like ones defined
  by let and loop forms in later case form will also have
  :shadow pointing to a declaration node it shadows and
  :depth property with a depth of shadowing, that is used
  to for renaming logic to avoid name collisions in forms
  like let that allow same named bindings."
  [node]
  (if (= :binding (:type (:binding node)))
    (conj (write-binding-var (:binding node))
          (write-location (:form node)))
    (conj (write-location (:form node))
          (->identifier (name (:form node))))))
(install-writer! :var write-var)
(install-writer! :param write-var)

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

(defn write-vector
  [form]
  {:type :ArrayExpression
   :elements (map write (:items 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]
                        (let [key (first pair)
                              value (second pair)]
                          {:kind :init
                           :type :Property
                           :key (if (= :symbol (:op key))
                                  (write-constant (str (:form key)))
                                  (write key))
                           :value (write value)}))
                      properties)}))
(install-writer! :dictionary write-dictionary)

(defn write-export
  [form]
  (write {:op :set!
          :target {:op :member-expression
                   :computed false
                   :target {:op :var
                            :form (with-meta 'exports (meta (:form (:id form))))}
                   :property (:id form)
                   :form (:form (:id form))}
          :value (:init form)
          :form (:form (:id form))}))

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

(defn write-binding
  [form]
  (let [id (write-binding-var form)
        init (write (:init form))]
    {:type :VariableDeclaration
     :kind :var
     :loc (inherit-location [id init])
     :declarations [{:type :VariableDeclarator
                     :id id
                     :init init}]}))
(install-writer! :binding write-binding)

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

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

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

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

;; Map of statement AST node that are generated
;; by a writer. Used to decet weather node is
;; statement or expression.
(def **statements** {:EmptyStatement true :BlockStatement true
                     :ExpressionStatement true :IfStatement true
                     :LabeledStatement true :BreakStatement true
                     :ContinueStatement true :SwitchStatement true
                     :ReturnStatement true :ThrowStatement true
                     :TryStatement true :WhileStatement true
                     :DoWhileStatement true :ForStatement true
                     :ForInStatement true :ForOfStatement true
                     :LetStatement true :VariableDeclaration true
                     :FunctionDeclaration true})

(defn write-statement
  "Wraps expression that can't be in a block statement
  body into :ExpressionStatement otherwise returns back
  expression."
  [form]
  (->statement (write form)))

(defn ->statement
  [node]
  (if (get **statements** (:type node))
    node
    {:type :ExpressionStatement
     :expression node
     :loc (:loc node)
     }))

(defn ->return
  [form]
  (conj {:type :ReturnStatement
         :argument (write form)}
        (write-location (:form form) (:original-form 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)
                 (->return (:result form)))]

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

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

(defn ->expression
  [& body]
  {:type :CallExpression
   :arguments []
   :loc (inherit-location body)
   :callee (->sequence [{:type :FunctionExpression
                         :id nil
                         :params []
                         :defaults []
                         :expression false
                         :generator false
                         :rest nil
                         :body (->block body)}])})

(defn write-do
  [form]
  (apply ->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))})
(install-writer! :if write-if)

(defn write-try
  [form]
  (let [handler (:handler form)
        finalizer (:finalizer form)]
    (->expression (conj {:type :TryStatement
                         :guardedHandlers []
                         :block (->block (write-body (:body form)))
                         :handlers (if handler
                                     [{:type :CatchClause
                                       :param (write (:name handler))
                                       :body (->block (write-body handler))}]
                                     [])
                         :finalizer (cond finalizer (->block (write-body finalizer))
                                          (not handler) (->block [])
                                          :else nil)}
                        (write-location (:form form) (:original-form 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-binding
  [form]
  (write {:op :def
          :var form
          :init (:init form)
          :form form}))

(defn write-let
  [form]
  (let [body (conj form
                   {:statements (vec (concat
                                      (:bindings form)
                                      (:statements form)))})]
    (->iife (->block (write-body body)))))
(install-writer! :let write-let)

(defn ->rebind
  [form]
  (loop [result []
         bindings (:bindings form)]
    (if (empty? bindings)
      result
      (recur (conj result
                   {:type :AssignmentExpression
                    :operator :=
                    :left (write-binding-var (first bindings))
                    :right {:type :MemberExpression
                            :computed true
                            :object {:type :Identifier
                                     :name :loop}
                            :property {:type :Literal
                                       :value (count result)}}})
             (rest bindings)))))

(defn ->sequence
  [expressions]
  {:type :SequenceExpression
   :expressions expressions})

(defn ->iife
  [body id]
  {:type :CallExpression
   :arguments [{:type :ThisExpression}]
   :callee {:type :MemberExpression
            :computed false
            :object {:type :FunctionExpression
                     :id id
                     :params []
                     :defaults []
                     :expression false
                     :generator false
                     :rest nil
                     :body body}
            :property {:type :Identifier
                       :name :call}}})

(defn ->loop-init
  []
  {:type :VariableDeclaration
   :kind :var
   :declarations [{:type :VariableDeclarator
                   :id {:type :Identifier
                        :name :recur}
                   :init {:type :Identifier
                          :name :loop}}]})

(defn ->do-while
 [body test]
 {:type :DoWhileStatement
  :body body
  :test test})

(defn ->set!-recur
  [form]
  {:type :AssignmentExpression
   :operator :=
   :left {:type :Identifier :name :recur}
   :right (write form)})

(defn ->loop
  [form]
  (->sequence (conj (->rebind form)
                    {:type :BinaryExpression
                     :operator :===
                     :left {:type :Identifier
                            :name :recur}
                     :right {:type :Identifier
                             :name :loop}})))


(defn write-loop
  [form]
  (let [statements (:statements form)
        result (:result form)
        bindings (:bindings form)

        loop-body (conj (map write-statement statements)
                        (->statement (->set!-recur result)))
        body (concat [(
                       ->loop-init)]
                     (map write bindings)
                     [(->do-while (->block (vec loop-body))
                                  (->loop form))]
                     [{:type :ReturnStatement
                       :argument {:type :Identifier
                                  :name :recur}}])]
    (->iife (->block (vec body)) 'loop)))
(install-writer! :loop write-loop)

(defn ->recur
  [form]
  (loop [result []
         params (:params form)]
    (if (empty? params)
      result
      (recur (conj result
                   {:type :AssignmentExpression
                    :operator :=
                    :right (write (first params))
                    :left {:type :MemberExpression
                           :computed true
                           :object {:type :Identifier
                                    :name :loop}
                           :property {:type :Literal
                                      :value (count result)}}})
             (rest params)))))

(defn write-recur
  [form]
  (->sequence (conj (->recur form)
                    {:type :Identifier
                     :name :loop})))
(install-writer! :recur write-recur)

(defn fallback-overload
  []
  {:type :SwitchCase
   :test nil
   :consequent [{:type :ThrowStatement
                 :argument {:type :CallExpression
                            :callee {:type :Identifier
                                     :name :RangeError}
                            :arguments [{:type :Literal
                                         :value "Wrong number of arguments passed"}]}}]})

(defn splice-binding
  [form]
  {:op :def
   :id (last (:params form))
   :init {:op :invoke
          :callee {:op :var
                   :form 'Array.prototype.slice.call}
          :params [{:op :var
                    :form 'arguments}
                   {:op :constant
                    :form (:arity form)
                    :type :number}]}})

(defn write-overloading-params
  [params]
  (reduce (fn [forms param]
            (conj forms {:op :def
                         :id param
                         :init {:op :member-expression
                                :computed true
                                :target {:op :var
                                         :form 'arguments}
                                :property {:op :constant
                                           :type :number
                                           :form (count forms)}}}))
          []
          params))

(defn write-overloading-fn
  [form]
  (let [overloads (map write-fn-overload (:methods form))]
    {:params []
     :body (->block {:type :SwitchStatement
                     :discriminant {:type :MemberExpression
                                    :computed false
                                    :object {:type :Identifier
                                             :name :arguments}
                                    :property {:type :Identifier
                                               :name :length}}
                     :cases (if (:variadic form)
                              overloads
                              (conj overloads (fallback-overload)))})}))

(defn write-fn-overload
  [form]
  (let [params (:params form)
        bindings (if (:variadic form)
                   (conj (write-overloading-params (butlast params))
                         (splice-binding form))
                   (write-overloading-params params))
        statements (vec (concat bindings (:statements form)))]
    {:type :SwitchCase
     :test (if (not (:variadic form))
             {:type :Literal
              :value (:arity form)})
     :consequent (write-body (conj form {:statements statements}))}))

(defn write-simple-fn
  [form]
  (let [method (first (:methods form))
        params (if (:variadic method)
                 (butlast (:params method))
                 (:params method))
        body (if (:variadic method)
               (conj method
                     {:statements (vec (cons (splice-binding method)
                                             (:statements method)))})
               method)]
    {:params (map write-var params)
     :body (->block (write-body body))}))

(defn resolve
  [from to]
  (let [requirer (split (name from) \.)
        requirement (split (name to) \.)
        relative? (and (not (identical? (name from)
                                        (name to)))
                       (identical? (first requirer)
                                   (first requirement)))]
    (if relative?
      (loop [from requirer
             to requirement]
        (if (identical? (first from)
                        (first to))
          (recur (rest from) (rest to))
          (join \/
                (concat [\.]
                        (repeat (dec (count from)) "..")
                        to))))
      (join \/ requirement))))

(defn id->ns
  "Takes namespace identifier symbol and translates to new
  simbol without . special characters
  wisp.core -> wisp*core"
  [id]
  (symbol nil (join \* (split (name id) \.))))


(defn write-require
  [form requirer]
  (let [ns-binding {:op :def
                    :id {:op :var
                         :type :identifier
                         :form (id->ns (:ns form))}
                    :init {:op :invoke
                           :callee {:op :var
                                    :type :identifier
                                    :form 'require}
                           :params [{:op :constant
                                     :form (resolve requirer (:ns form))}]}}
        ns-alias (if (:alias form)
                   {:op :def
                    :id {:op :var
                         :type :identifier
                         :form (id->ns (:alias form))}
                    :init (:id ns-binding)})

        references (reduce (fn [references form]
                             (conj references
                                   {:op :def
                                    :id {:op :var
                                         :type :identifier
                                         :form (or (:rename form)
                                                   (:name form))}
                                    :init {:op :member-expression
                                           :computed false
                                           :target (:id ns-binding)
                                           :property {:op :var
                                                      :type :identifier
                                                      :form (:name form)}}}))
                           []
                           (:refer form))]
    (vec (cons ns-binding
               (if ns-alias
                 (cons ns-alias references)
                 references)))))

(defn write-ns
  [form]
  (let [node (:form form)
        requirer (:name form)
        ns-binding {:op :def
                    :original-form node
                    :id {:op :var
                         :type :identifier
                         :original-form (first node)
                         :form '*ns*}
                    :init {:op :dictionary
                           :form node
                           :keys [{:op :var
                                   :type :identifier
                                   :original-form node
                                   :form 'id}
                                  {:op :var
                                   :type :identifier
                                   :original-form node
                                   :form 'doc}]
                           :values [{:op :constant
                                     :type :identifier
                                     :original-form (:name form)
                                     :form (name (:name form))}
                                    {:op :constant
                                     :original-form node
                                     :form (:doc form)}]}}
        requirements (vec (apply concat (map #(write-require % requirer)
                                             (:require form))))]
    (->block (map write (vec (cons ns-binding requirements))))))
(install-writer! :ns write-ns)

(defn write-fn
  [form]
  (let [base (if (> (count (:methods form)) 1)
               (write-overloading-fn form)
               (write-simple-fn form))]
    (conj base
          {:type :FunctionExpression
           :id (if (:id form) (write-var (:id form)))
           :defaults nil
           :rest nil
           :generator false
           :expression false})))
(install-writer! :fn write-fn)

(defn write
  [form]
  (let [op (:op form)
        writer (and (= :invoke (:op form))
                    (= :var (:op (:callee form)))
                    (get **specials** (name (:form (:callee form)))))]
    (if writer
      (write-special writer form)
      (write-op (:op form) form))))

(defn write*
  [& forms]
  (let [body (map write-statement forms)]
    {:type :Program
     :body body
     :loc (inherit-location body)}))


(defn compile
  ([form] (compile {} form))
  ([options & forms] (generate (apply write* forms) options)))


(defn get-macro
  [target property]
  `(aget (or ~target 0)
         ~property))
(install-macro! :get get-macro)

;; Logical operators

(defn install-logical-operator!
  [callee operator fallback]
  (defn write-logical-operator
    [& operands]
    (let [n (count operands)]
      (cond (= n 0) (write-constant fallback)
            (= n 1) (write (first operands))
            :else (reduce (fn [left right]
                            {:type :LogicalExpression
                             :operator operator
                             :left left
                             :right (write right)})
                          (write (first operands))
                          (rest operands)))))
  (install-special! callee write-logical-operator))
(install-logical-operator! :or :|| nil)
(install-logical-operator! :and :&& true)

(defn install-unary-operator!
  [callee operator prefix?]
  (defn write-unary-operator
    [& params]
    (if (identical? (count params) 1)
      {:type :UnaryExpression
       :operator operator
       :argument (write (first params))
       :prefix prefix?}
      (error-arg-count callee (count params))))
  (install-special! callee write-unary-operator))
(install-unary-operator! :not :!)

;; Bitwise Operators

(install-unary-operator! :bit-not :~)

(defn install-binary-operator!
  [callee operator]
  (defn write-binary-operator
    [& params]
    (if (< (count params) 2)
      (error-arg-count callee (count params))
      (reduce (fn [left right]
                {:type :BinaryExpression
                 :operator operator
                 :left left
                 :right (write right)})
              (write (first params))
              (rest params))))
  (install-special! callee write-binary-operator))
(install-binary-operator! :bit-and :&)
(install-binary-operator! :bit-or :|)
(install-binary-operator! :bit-xor :^)
(install-binary-operator! :bit-shift-left :<<)
(install-binary-operator! :bit-shift-right :>>)
(install-binary-operator! :bit-shift-right-zero-fil :>>>)

;; Arithmetic operators

(defn install-arithmetic-operator!
  [callee operator valid? fallback]

  (defn write-binary-operator
    [left right]
    {:type :BinaryExpression
     :operator (name operator)
     :left left
     :right (write right)})

  (defn write-arithmetic-operator
    [& params]
    (let [n (count params)]
      (cond (and valid? (not (valid? n))) (error-arg-count (name callee) n)
            (== n 0) (write-literal fallback)
            (== n 1) (reduce write-binary-operator
                             (write-literal fallback)
                             params)
            :else (reduce write-binary-operator
                          (write (first params))
                          (rest params)))))


  (install-special! callee write-arithmetic-operator))

(install-arithmetic-operator! :+ :+ nil 0)
(install-arithmetic-operator! :- :- #(>= % 1) 0)
(install-arithmetic-operator! :* :* nil 1)
(install-arithmetic-operator! (keyword \/) (keyword \/) #(>= % 1) 1)
(install-arithmetic-operator! :mod (keyword \%) #(== % 2) 1)


;; Comparison operators

(defn install-comparison-operator!
  "Generates comparison operator writer that given one
  parameter writes `fallback` given two parameters writes
  binary expression and given more parameters writes binary
  expressions joined by logical and."
  [callee operator fallback]

  ;; TODO #54
  ;; Comparison operators must use temporary variable to store
  ;; expression non literal and non-identifiers.
  (defn write-comparison-operator
    ([] (error-arg-count callee 0))
    ([form] (->sequence [(write form)
                         (write-literal fallback)]))
    ([left right]
     {:type :BinaryExpression
      :operator operator
      :left (write left)
      :right (write right)})
    ([left right & more]
     (reduce (fn [left right]
               {:type :LogicalExpression
                :operator :&&
                :left left
                :right {:type :BinaryExpression
                        :operator operator
                        :left (if (= :LogicalExpression (:type left))
                                (:right (:right left))
                                (:right left))
                        :right (write right)}})
             (write-comparison-operator left right)
             more)))

  (install-special! callee write-comparison-operator))

(install-comparison-operator! :== :== true)
(install-comparison-operator! :> :> true)
(install-comparison-operator! :>= :>= true)
(install-comparison-operator! :< :< true)
(install-comparison-operator! :<= :<= true)


(defn write-identical?
  [& params]
  ;; TODO: Submit a bug for clojure to allow variadic
  ;; number of params joined by logical and.
  (if (identical? (count params) 2)
    {:type :BinaryExpression
     :operator :===
     :left (write (first params))
     :right (write (second params))}
    (error-arg-count :identical? (count params))))
(install-special! :identical? write-identical?)

(defn write-instance?
  [& params]
  ;; TODO: Submit a bug for clojure to make sure that
  ;; instance? either accepts only two args or returns
  ;; true only if all the params are instance of the
  ;; given type.

  (let [constructor (first params)
        instance (second params)]
    (if (< (count params) 1)
      (error-arg-count :instance? (count params))
      {:type :BinaryExpression
       :operator :instanceof
       :left (if instance
               (write instance)
               (write-constant instance))
       :right (write constructor)})))
(install-special! :instance? write-instance?)


(defn expand-apply
  [f & params]
  (let [prefix (vec (butlast params))]
    (if (empty? prefix)
      `(.apply ~f nil ~@params)
      `(.apply ~f nil (.concat ~prefix ~(last params))))))
(install-macro! :apply expand-apply)


(defn expand-print
  [&form & more]
  "Prints the object(s) to the output for human consumption."
  (let [op (with-meta 'console.log (meta &form))]
    `(~op ~@more)))
(install-macro! :print (with-meta expand-print {:implicit [:&form]}))

(defn expand-str
  "str inlining and optimization via macros"
  [& forms]
  `(+ "" ~@forms))
(install-macro! :str expand-str)

(defn expand-debug
  []
  'debugger)
(install-macro! :debugger! expand-debug)

(defn expand-assert
  ^{:doc "Evaluates expr and throws an exception if it does not evaluate to
    logical true."}
  ([x] (expand-assert x ""))
  ([x message] (let [form (pr-str x)]
                 `(if (not ~x)
                    (throw (Error (str "Assert failed: "
                                       ~message
                                       ~form)))))))
(install-macro! :assert expand-assert)

