Add more log entries to reader tests.

Add more log entries to reader tests.

(import [symbol quote deref name keyword
         unquote meta dictionary] "../src/ast")
(import [dictionary nil? str] "../src/runtime")
(import [read-from-string] "../src/reader")
(import [list] "../src/sequence")
(import [equivalent?] "./utils")

(def read-string read-from-string)

(.log console "name fn")

(assert (identical? (name (read-string ":foo")) "foo")
        "name of :foo is foo")
(assert (identical? (name (read-string ":foo/bar")) "bar")
        "name of :foo/bar is bar")
(assert (identical? (name (read-string "foo")) "foo")
        "name of foo is foo")
(assert (identical? (name (read-string "foo/bar")) "bar")
        "name of foo/bar is bar")
(assert (identical? (name (read-string "\"foo\"")) "foo")
        "name of \"foo\" is foo")

(.log console "read simple list")

(assert (equivalent?
         (read-string "(foo bar)")
         '(foo bar))
        "(foo bar) -> (foo bar)")

(.log console "read comma is a whitespace")

(assert (equivalent?
         (read-string "(foo, bar)")
         '(foo bar))
        "(foo, bar) -> (foo bar)")

(.log console "read numbers")

(assert (equivalent?
         (read-string "(+ 1 2 0)")
         '(+ 1 2 0))
        "(+ 1 2 0) -> (+ 1 2 0)")

(.log console "read keywords")
(assert (equivalent?
         (read-string "(foo :bar)")
         '(foo :bar))
        "(foo :bar) -> (foo :bar)")

(.log console "read quoted list")
(assert (equivalent?
         (read-string "'(foo bar)")
         '(quote (foo bar)))
        "'(foo bar) -> (quote (foo bar))")

(.log console "read vector")
(assert (equivalent?
         (read-string "(foo [bar :baz 2])")
         '(foo [bar :baz 2]))
        "(foo [bar :baz 2]) -> (foo [bar :baz 2])")

(.log console "read special symbols")
(assert (equivalent?
         (read-string "(true false nil)")
         '(true false nil))
        "(true false nil) -> (true false nil)")

(.log console "read chars")
(assert (equivalent?
         (read-string "(\\x \\y \\z)")
         '("x" "y" "z"))
        "(\\x \\y \\z) -> (\"x\" \"y\" \"z\")")

(.log console "read strings")
(assert (equivalent?
         (read-string "(\"hello world\" \"hi \\n there\")")
         '("hello world" "hi \n there"))
        "strings are read precisely")

(.log console "read deref")
(assert (equivalent?
         (read-string "(+ @foo 2)")
         '(+ (deref foo) 2))
        "(+ @foo 2) -> (+ (deref foo) 2)")

(.log console "read unquote")

(assert (equivalent?
         (read-string "(~foo ~@bar ~(baz))")
         '((unquote foo)
           (unquote-splicing bar)
           (unquote (baz))))
        "(~foo ~@bar ~(baz)) -> ((unquote foo) (unquote-splicing bar) (unquote (baz))")

(assert (equivalent?
         (read-string "(~@(foo bar))")
         '((unquote-splicing (foo bar))))
        "(~@(foo bar)) -> ((unquote-splicing (foo bar)))")

(.log console "read function")

(assert (equivalent?
         (read-string "(defn List
                      \"List type\"
                      [head tail]
                      (set! this.head head)
                      (set! this.tail tail)
                      (set! this.length (+ (.-length tail) 1))
                      this)")
         '(defn List
            "List type"
             [head tail]
             (set! this.head head)
             (set! this.tail tail)
             (set! this.length (+ (.-length tail) 1))
             this))
        "function read correctly")

(.log console "lambda syntax")

(assert (equivalent?
          (read-string "#(apply sum %&)")
          '(fn [& %&] (apply sum %&))))

(assert (equivalent?
          (read-string "(map #(inc %) [1 2 3])")
          '(map (fn [%1] (inc %1)) [1 2 3])))

(assert (equivalent?
          (read-string "#(+ %1 % %& %5 %2)")
          '(fn [%1 %2 %3 %4 %5 & %&] (+ %1 %1 %& %5 %2))))

(.log console "read comments")
(assert (equivalent?
         (read-string "; comment
                      (program)")
         '(program))
        "comments are ignored")

(assert (equivalent?
         (read-string "(hello ;; world\n you)")
         '(hello you)))

(.log console "clojurescript")

(assert (= 1 (reader/read-string "1")))
(assert (= 2 (reader/read-string "#_nope 2")))
(assert (= -1 (reader/read-string "-1")))
(assert (= -1.5 (reader/read-string "-1.5")))
(assert (equivalent? [3 4] (reader/read-string "[3 4]")))
(assert (= "foo" (reader/read-string "\"foo\"")))
(assert (equivalent? ':hello (reader/read-string ":hello")))
(assert (= 'goodbye (reader/read-string "goodbye")))
(assert (equivalent? '#{1 2 3} (reader/read-string "#{1 2 3}")))
(assert (equivalent? '(7 8 9) (reader/read-string "(7 8 9)")))
(assert (equivalent? '(deref foo) (reader/read-string "@foo")))
(assert (equivalent? '(quote bar) (reader/read-string "'bar")))

;; TODO: Implement `namespace` fn and proper namespace support ?
;;(assert (= 'foo/bar (reader/read-string "foo/bar")))
;;(assert (= ':foo/bar (reader/read-string ":foo/bar")))
(assert (= \a (reader/read-string "\\a")))
(assert (equivalent? 'String
                     (:tag (meta (reader/read-string "^String {:a 1}")))))
;; TODO: In quoted sets both keys and values should remain quoted
;; (assert (equivalent? [:a 'b '#{c {:d [:e :f :g]}}]
;;                     (reader/read-string "[:a b #{c {:d [:e :f :g]}}]")))
(assert (= nil (reader/read-string "nil")))
(assert (= true (reader/read-string "true")))
(assert (= false (reader/read-string "false")))
(assert (= "string" (reader/read-string "\"string\"")))
(assert (= "escape chars \t \r \n \\ \" \b \f"
           (reader/read-string "\"escape chars \\t \\r \\n \\\\ \\\" \\b \\f\"")))

(.log console "tagged literals")

;; queue literals
(assert (equivalent? '(PersistentQueue. [])
                     (reader/read-string "#queue []")))
(assert (equivalent? '(PersistentQueue. [1])
                     (reader/read-string "#queue [1]")))
(assert (equivalent? '(PersistentQueue. [1 2])
                     (reader/read-string "#queue [1 2]")))

;; uuid literals
(assert (equivalent? '(UUID. "550e8400-e29b-41d4-a716-446655440000")
                     (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))

(.log console "read unicode")

(let [assets
      ["اختبار" ; arabic
       "ทดสอบ" ; thai
       "こんにちは" ; japanese hiragana
       "你好" ; chinese traditional
       "אַ גוט יאָר" ; yiddish
       "cześć" ; polish
       "привет" ; russian
       "გამარჯობა" ; georgian

       ;; RTL languages skipped below because tricky to insert
       ;; ' and : at the "start"

       'ทดสอบ
       'こんにちは
       '你好
       'cześć
       'привет
       'გამარჯობა

       :ทดสอบ
       :こんにちは
       :你好
       :cześć
       :привет
       :გამარჯობა

       ;compound data
       ;{:привет :ru "你好" :cn} // TODO: Implement serialized function
       ]]
  (.for-each assets
             (fn [unicode]
               (assert (equivalent? unicode
                                    (read-string (str "\"" unicode "\"")))
                       (str "Failed to read-string " unicode)))))

; unicode error cases
(let [unicode-errors
      ["\"abc \\ua\"" ; truncated
       "\"abc \\x0z ...etc\"" ; incorrect code
       "\"abc \\u0g00 ..etc\"" ; incorrect code
       ]]
  (.for-each
   unicode-errors
   (fn [unicode-error]
     (assert
      (= :threw
         (try
           (reader/read-string unicode-error)
           :failed-to-throw
           (catch e :threw)))
      (str "Failed to throw reader error for: " unicode-error)))))

(import [symbol quote deref name keyword
         unquote meta dictionary] "../src/ast")
(import [dictionary nil? str] "../src/runtime")
(import [read-from-string] "../src/reader")
(import [list] "../src/sequence")
(import [equivalent?] "./utils")

(def read-string read-from-string)

(.log console "name fn")

(assert (identical? (name (read-string ":foo")) "foo")
        "name of :foo is foo")
(assert (identical? (name (read-string ":foo/bar")) "bar")
        "name of :foo/bar is bar")
(assert (identical? (name (read-string "foo")) "foo")
        "name of foo is foo")
(assert (identical? (name (read-string "foo/bar")) "bar")
        "name of foo/bar is bar")
(assert (identical? (name (read-string "\"foo\"")) "foo")
        "name of \"foo\" is foo")

(.log console "read simple list")

(assert (equivalent?
         (read-string "(foo bar)")
         '(foo bar))
        "(foo bar) -> (foo bar)")

(.log console "read comma is a whitespace")

(assert (equivalent?
         (read-string "(foo, bar)")
         '(foo bar))
        "(foo, bar) -> (foo bar)")

(.log console "read numbers")

(assert (equivalent?
         (read-string "(+ 1 2 0)")
         '(+ 1 2 0))
        "(+ 1 2 0) -> (+ 1 2 0)")

(.log console "read keywords")
(assert (equivalent?
         (read-string "(foo :bar)")
         '(foo :bar))
        "(foo :bar) -> (foo :bar)")

(.log console "read quoted list")
(assert (equivalent?
         (read-string "'(foo bar)")
         '(quote (foo bar)))
        "'(foo bar) -> (quote (foo bar))")

(.log console "read vector")
(assert (equivalent?
         (read-string "(foo [bar :baz 2])")
         '(foo [bar :baz 2]))
        "(foo [bar :baz 2]) -> (foo [bar :baz 2])")

(.log console "read special symbols")
(assert (equivalent?
         (read-string "(true false nil)")
         '(true false nil))
        "(true false nil) -> (true false nil)")

(.log console "read chars")
(assert (equivalent?
         (read-string "(\\x \\y \\z)")
         '("x" "y" "z"))
        "(\\x \\y \\z) -> (\"x\" \"y\" \"z\")")

(.log console "read strings")
(assert (equivalent?
         (read-string "(\"hello world\" \"hi \\n there\")")
         '("hello world" "hi \n there"))
        "strings are read precisely")

(.log console "read deref")
(assert (equivalent?
         (read-string "(+ @foo 2)")
         '(+ (deref foo) 2))
        "(+ @foo 2) -> (+ (deref foo) 2)")

(.log console "read unquote")

(assert (equivalent?
         (read-string "(~foo ~@bar ~(baz))")
         '((unquote foo)
           (unquote-splicing bar)
           (unquote (baz))))
        "(~foo ~@bar ~(baz)) -> ((unquote foo) (unquote-splicing bar) (unquote (baz))")

(assert (equivalent?
         (read-string "(~@(foo bar))")
         '((unquote-splicing (foo bar))))
        "(~@(foo bar)) -> ((unquote-splicing (foo bar)))")

(.log console "read function")

(assert (equivalent?
         (read-string "(defn List
                      \"List type\"
                      [head tail]
                      (set! this.head head)
                      (set! this.tail tail)
                      (set! this.length (+ (.-length tail) 1))
                      this)")
         '(defn List
            "List type"
             [head tail]
             (set! this.head head)
             (set! this.tail tail)
             (set! this.length (+ (.-length tail) 1))
             this))
        "function read correctly")

(.log console "lambda syntax")

(assert (equivalent?
          (read-string "#(apply sum %&)")
          '(fn [& %&] (apply sum %&))))

(assert (equivalent?
          (read-string "(map #(inc %) [1 2 3])")
          '(map (fn [%1] (inc %1)) [1 2 3])))

(assert (equivalent?
          (read-string "#(+ %1 % %& %5 %2)")
          '(fn [%1 %2 %3 %4 %5 & %&] (+ %1 %1 %& %5 %2))))

(.log console "read comments")
(assert (equivalent?
         (read-string "; comment
                      (program)")
         '(program))
        "comments are ignored")

(assert (equivalent?
         (read-string "(hello ;; world\n you)")
         '(hello you)))

(.log console "clojurescript")

(assert (= 1 (reader/read-string "1")))
(assert (= 2 (reader/read-string "#_nope 2")))
(assert (= -1 (reader/read-string "-1")))
(assert (= -1.5 (reader/read-string "-1.5")))
(assert (equivalent? [3 4] (reader/read-string "[3 4]")))
(assert (= "foo" (reader/read-string "\"foo\"")))
(assert (equivalent? ':hello (reader/read-string ":hello")))
(assert (= 'goodbye (reader/read-string "goodbye")))
(assert (equivalent? '#{1 2 3} (reader/read-string "#{1 2 3}")))
(assert (equivalent? '(7 8 9) (reader/read-string "(7 8 9)")))
(assert (equivalent? '(deref foo) (reader/read-string "@foo")))
(assert (equivalent? '(quote bar) (reader/read-string "'bar")))
;; TODO: Implement `namespace` fn and proper namespace support ?
;;(assert (= 'foo/bar (reader/read-string "foo/bar")))
;;(assert (= ':foo/bar (reader/read-string ":foo/bar")))
(assert (= \a (reader/read-string "\\a")))
(assert (equivalent? 'String
                     (:tag (meta (reader/read-string "^String {:a 1}")))))
;; TODO: In quoted sets both keys and values should remain quoted
;; (assert (equivalent? [:a 'b '#{c {:d [:e :f :g]}}]
;;                     (reader/read-string "[:a b #{c {:d [:e :f :g]}}]")))
(assert (= nil (reader/read-string "nil")))
(assert (= true (reader/read-string "true")))
(assert (= false (reader/read-string "false")))
(assert (= "string" (reader/read-string "\"string\"")))
(assert (= "escape chars \t \r \n \\ \" \b \f"
           (reader/read-string "\"escape chars \\t \\r \\n \\\\ \\\" \\b \\f\"")))

;; queue literals
(assert (equivalent? '(PersistentQueue. [])
                     (reader/read-string "#queue []")))
(assert (equivalent? '(PersistentQueue. [1])
                     (reader/read-string "#queue [1]")))
(assert (equivalent? '(PersistentQueue. [1 2])
                     (reader/read-string "#queue [1 2]")))

;; uuid literals
(assert (equivalent? '(UUID. "550e8400-e29b-41d4-a716-446655440000")
                     (reader/read-string "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))

(let [assets
      ["اختبار" ; arabic
       "ทดสอบ" ; thai
       "こんにちは" ; japanese hiragana
       "你好" ; chinese traditional
       "אַ גוט יאָר" ; yiddish
       "cześć" ; polish
       "привет" ; russian
       "გამარჯობა" ; georgian

       ;; RTL languages skipped below because tricky to insert
       ;; ' and : at the "start"

       'ทดสอบ
       'こんにちは
       '你好
       'cześć
       'привет
       'გამარჯობა

       :ทดสอบ
       :こんにちは
       :你好
       :cześć
       :привет
       :გამარჯობა

       ;compound data
       ;{:привет :ru "你好" :cn} // TODO: Implement serialized function
       ]]
  (.for-each assets
             (fn [unicode]
               (assert (equivalent? unicode
                                    (read-string (str "\"" unicode "\"")))
                       (str "Failed to read-string " unicode)))))

; unicode error cases
(let [unicode-errors
      ["\"abc \\ua\"" ; truncated
       "\"abc \\x0z ...etc\"" ; incorrect code
       "\"abc \\u0g00 ..etc\"" ; incorrect code
       ]]
  (.for-each
   unicode-errors
   (fn [unicode-error]
     (assert
      (= :threw
         (try
           (reader/read-string unicode-error)
           :failed-to-throw
           (catch e :threw)))
      (str "Failed to throw reader error for: " unicode-error)))))


Fix binding identifier translation.

Fix binding identifier translation.

(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 unique character that is valid JS identifier that will
;; be used in generated symbols to avoid conflicts
;; http://www.fileformat.info/info/unicode/char/141d/index.htm
(def **unique-char** "ᐝ")

(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 write-location
  [form]
  (let [data (meta form)
        start (:start data)
        end (:end data)]
    (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))
    (conj {:loc (write-location (:form form))}
          (writer form))))

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

(defn write-special
  [writer form]
  (conj {:loc (write-location (: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-keyword form)
        (number? form) (write-number form)
        :else (write-literal form)))
(install-writer! :constant #(write-constant (: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 (name 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))
          {:loc (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))
          {:loc (write-location (:form node))})
    (conj {:loc (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 'exports}
                   :property (:id form)}
          :value (:init form)}))

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :loc (write-location (:form form))
   :declarations [{:type :VariableDeclarator
                   :id (write (:id form))
                   :loc (write-location (:form (:id form)))
                   :init (conj (if (:export form)
                                 (write-export form)
                                 (write (:init 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 {:start (:start (:loc id))
           :end (:end (:loc init))}
     :declarations [{:type :VariableDeclarator
                     :id id
                     :init init}]}))
(install-writer! :binding write-binding)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw 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}))

(defn ->return
  [form]
  {:type :ReturnStatement
   :loc (write-location (:form form))
   :argument (write 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]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee (->sequence [{: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))})
(install-writer! :if write-if)

(defn write-try
  [form]
  (let [handler (:handler form)
        finalizer (:finalizer form)]
    (->expression {: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)})))
(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)))})]
    (->iffe (->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 ->iffe
  [body id]
  {:type :CallExpression
   :arguments []
   :callee (->sequence [{:type :FunctionExpression
                         :id id
                         :params []
                         :defaults []
                         :expression false
                         :generator false
                         :rest nil
                         :body body}])})

(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 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}}])]
    (->iffe (->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 [requirer (:name form)
        ns-binding {:op :def
                    :id {:op :var
                         :type :identifier
                         :form '*ns*}
                    :init {:op :dictionary
                           :keys [{:op :var
                                   :type :identifier
                                   :form 'id}
                                  {:op :var
                                   :type :identifier
                                   :form 'doc}]
                           :values [{:op :constant
                                     :type :identifier
                                     :form (name (:name form))}
                                    {:op :constant
                                     :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}))

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

(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 unique character that is valid JS identifier that will
;; be used in generated symbols to avoid conflicts
;; http://www.fileformat.info/info/unicode/char/141d/index.htm
(def **unique-char** "ᐝ")

(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 write-location
  [form]
  (let [data (meta form)
        start (:start data)
        end (:end data)]
    (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))
    (conj {:loc (write-location (:form form))}
          (writer form))))

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

(defn write-special
  [writer form]
  (conj {:loc (write-location (: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-keyword form)
        (number? form) (write-number form)
        :else (write-literal form)))
(install-writer! :constant #(write-constant (: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 (name 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 id **unique-char** (:depth form))
                          id))
          {:loc (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))
          {:loc (write-location (:form node))})
    (conj {:loc (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 'exports}
                   :property (:id form)}
          :value (:init form)}))

(defn write-def
  [form]
  {:type :VariableDeclaration
   :kind :var
   :loc (write-location (:form form))
   :declarations [{:type :VariableDeclarator
                   :id (write (:id form))
                   :loc (write-location (:form (:id form)))
                   :init (conj (if (:export form)
                                 (write-export form)
                                 (write (:init 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 {:start (:start (:loc id))
           :end (:end (:loc init))}
     :declarations [{:type :VariableDeclarator
                     :id id
                     :init init}]}))
(install-writer! :binding write-binding)

(defn write-throw
  [form]
  (->expression {:type :ThrowStatement
                 :argument (write (:throw 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}))

(defn ->return
  [form]
  {:type :ReturnStatement
   :loc (write-location (:form form))
   :argument (write 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]
  {:type :BlockStatement
   :body (if (vector? body)
           body
           [body])})

(defn ->expression
  [body]
  {:type :CallExpression
   :arguments []
   :callee (->sequence [{: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))})
(install-writer! :if write-if)

(defn write-try
  [form]
  (let [handler (:handler form)
        finalizer (:finalizer form)]
    (->expression {: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)})))
(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)))})]
    (->iffe (->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 ->iffe
  [body id]
  {:type :CallExpression
   :arguments []
   :callee (->sequence [{:type :FunctionExpression
                         :id id
                         :params []
                         :defaults []
                         :expression false
                         :generator false
                         :rest nil
                         :body body}])})

(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 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}}])]
    (->iffe (->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 [requirer (:name form)
        ns-binding {:op :def
                    :id {:op :var
                         :type :identifier
                         :form '*ns*}
                    :init {:op :dictionary
                           :keys [{:op :var
                                   :type :identifier
                                   :form 'id}
                                  {:op :var
                                   :type :identifier
                                   :form 'doc}]
                           :values [{:op :constant
                                     :type :identifier
                                     :form (name (:name form))}
                                    {:op :constant
                                     :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}))

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


Fix equivalent? utility function.

Fix equivalent? utility function.

(import [object? vector? keys vals dec] "../lib/runtime")

(def to-string Object.prototype.to-string)

(defn ^boolean date?
  "Returns true if x is a date"
  [x]
  (identical? (.call to-string x) "[object Date]"))

(defn ^boolean equivalent?
  [actual expected]
  (or
   (identical? actual expected)
   (and (= actual expected))
   (and (date? actual)
        (date? expected)
        (= (.get-time actual)
           (.get-time expected)))
   (if (and (vector? actual) (vector? expected))
     (and (= (.-length actual)
             (.-length expected))
          (loop [index (dec (.-length actual))]
            (if (< index 0)
              true
              (if (equivalent?
                   (get actual index)
                   (get expected index))
                (recur (dec index))
                false))))
     (and (object? actual)
          (object? expected)
          (equivalent? (keys actual)
                       (keys expected))
          (equivalent? (vals actual)
                       (vals expected))))))

(export equivalent? date?)

(import [object? vector? keys vals dec] "../lib/runtime")

(defn ^boolean date?
  "Returns true if x is a date"
  [x]
  (identical? (.call to-string x) "[object Date]"))

(defn ^boolean equivalent?
  [actual expected]
  (or
   ; 7.1 All identical values are equivalent, as determined by ===.
   (identical? actual expected)
   ; 7.2. If the expected value is a Date object, the actual value is
   ; equivalent if it is also a Date object that refers to the same time.
   (and (date? actual)
        (date? expected)
        (= (.get-time actual)
           (.get-time expected)))
   ; 7.3. Other pairs that do not both pass typeof value == "object",
   ; equivalence is determined by ==.
   (and (not (object? actual))
        (not (object? expected))
        (= actual expected))
   ; 7.4. For all other Object pairs, including Array objects, equivalence is
   ; determined by having the same number of owned properties (as verified
   ; with Object.prototype.hasOwnProperty.call), the same set of keys
   ; (although not necessarily the same order), equivalent values for every
   ; corresponding key, and an identical "prototype" property. Note: this
   ; accounts for both named and indexed properties on Arrays.
   (and (vector? actual)
        (vector? expected)
        (= (.-length actual) (.-length expected))
        (loop [index (.-length actual)]
          (if (< index 0)
            true
            (if (equivalent?
                 (get actual index)
                 (get expected index))
              (recur (dec index))
              false))))
   (and (equivalent? (keys actual)
                     (keys expected))
        (equivalent? (vals actual)
                     (vals expected))
        (equivalent? (.-prototype actual)
                     (.-prototype expected)))))

(export equivalent? date?)