(defn ^boolean self-evaluating?
  "Returns true if form is self evaluating"
  [form]
  (or (number? form)
      (and (string? form)
           (not (symbol? form))
           (not (keyword? form)))
      (boolean? form)
      (nil? form)
      (re-pattern? form)))


;; special forms
;;
;; special forms are like macros for generating source code. It allows the
;; generator to customize how certain forms look in the final output.
;; these could have been macros that expand into basic forms, but we
;; want readable output. Special forms are responsible for integrity
;; checking of the form.

(def **specials** {})

(defn install-special
  "Installs special function"
  [name f validator]
  (set! (get **specials** name)
        (fn [form]
          (if validator (validator form))
          (f (with-meta (rest form) (meta form))))))

(defn special?
  "Returns true if special form"
  [name]
  (and (symbol? name)
       (get **specials** name)
       true))

(defn execute-special
  "Expands special form"
  [name form]
  ((get **specials** name) form))


(defn opt [argument fallback]
  (if (or (nil? argument) (empty? argument)) fallback (first argument)))

;; compiler


(defn compile-object
  ""
  [form quoted?]
  ;; TODO: Add regexp to the list.
  (cond
    (keyword? form) (write-keyword form)
    (symbol? form) (compile-symbol form)
    (number? form) (compile-number form)
    (string? form) (compile-string form)
    (boolean? form) (compile-boolean form)
    (nil? form) (compile-nil form)
    (re-pattern? form) (compile-re-pattern form)
    (vector? form) (compile (apply-form 'vector
                                        (apply list form)
                                        quoted?))
    (list? form) (compile (apply-form 'list
                                      form
                                      quoted?))
    (dictionary? form) (compile-dictionary
                        (if quoted?
                          (map-dictionary form (fn [x] (list 'quote x)))
                          form))))


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

(defn write-keyword-reference
  [form]
  (str "\"" (name form) "\""))





;; backend specific compiler hooks

(defn write-template
  "Compiles given template"
  [& form]
  (let [indent-pattern #"\n *$"
        line-break-patter (RegExp "\n" "g")
        get-indentation (fn [code] (or (re-find indent-pattern code) "\n"))]
    (loop [code ""
           parts (split (first form) "~{}")
           values (rest form)]
      (if (> (count parts) 1)
        (recur
         (str
          code
          (first parts)
          (replace (str "" (first values))
                    line-break-patter
                    (get-indentation (first parts))))
         (rest parts)
         (rest values))
         (str code (first parts))))))

(defn write-comment
  [form]
  (write-template "//~{}\n" form))

(defn write-def
  "Creates and interns or locates a global var with the name of symbol
  and a namespace of the value of the current namespace (*ns*). If init
  is supplied, it is evaluated, and the root binding of the var is set
  to the resulting value. If init is not supplied, the root binding of
  the var is unaffected. def always applies to the root binding, even if
  the var is thread-bound at the point where def is called. def yields
  the var itself (not its value)."
  [id init]
  (write-template "var ~{} = ~{}"
                  (write id)
                  (write init)))

(defn write-if
  "Evaluates test. If not the singular values nil or false,
  evaluates and yields then, otherwise, evaluates and yields else.
  If else is not supplied it defaults to nil. All of the other
  conditionals in Clojure are based upon the same logic, that is,
  nil and false constitute logical falsity, and everything else
  constitutes logical truth, and those meanings apply throughout."
  [condition then-expression else-expression]
  (write-template
   (if (and (list? else-expression)
            (= (first else-expression) 'if))
     "~{} ?\n  ~{} :\n~{}"
     "~{} ?\n  ~{} :\n  ~{}")
   (write condition)
   (write then-expression)
   (write else-expression)))

(defn write-dictionary
  "Compiles dictionary to JS object"
  [form]
  (let [body
        (loop [body nil
               names (keys form)]
          (if (empty? names)
            body
            (recur
             (str
              (if (nil? body) "" (str body ",\n"))
              (compile-template
               (list
                "~{}: ~{}"
                (compile (first names))
                (compile (macroexpand
                          (get form (first names)))))))
             (rest names))))
        ]
      (if (nil? body) "{}" (compile-template (list "{\n  ~{}\n}" body)))))


;; Function parser / compiler


(defn write-fn-body
  [form params]
  (if (and (dictionary? params) (:rest params))
    (write-statements
      (cons (list 'def
                  (:rest params)
                  (list
                    'Array.prototype.slice.call
                    'arguments
                    (:arity params)))
      form)
      "return ")

    ;; Optimize functions who's body only contains `let` form to avoid
    ;; function call overhead.
    (if (and (identical? (count form) 1)
             (list? (first form))
             (= (first (first form)) 'do))
      (write-fn-body (rest (first form)) params)
      (write-statements form "return "))))

(defn write-fn
  ;"(fn name? [params* ] exprs*)
  ;Defines a function (fn)"
  [name doc attrs params body]
  (if (nil? name)
    (compile-template "function(~{}) {\n  ~{}\n}"
                      (join ", " (map write (:names params)))
                      (write-fn-body body params))
    (compile-template "function ~{}(~{}) {\n  ~{}\n}"
                      (write name)
                      (join ", " (map write (:names params)))
                      (write-fn-body body params))))

(defn write-statements
  [form prefix]
  (loop [result ""
         expression (first form)
         expressions (rest form)]
    (if (empty? expressions)
      (str result
           (if (nil? prefix) "" prefix)
           (compile (macroexpand expression))
           ";")
      (recur
        (str result (compile (macroexpand expression)) ";\n")
        (first expressions)
        (rest expressions)))))

(defn write-invoke
  [callee & params]
  (write-template
   ;; Wrap functions returned by expressions into parenthesis.
   (if (list? callee) "(~{})(~{})" "~{}(~{})")
   (write callee)
   (write-group params)))

(defn write-group
  [form wrap]
  (if wrap
    (str "(" (write-group form) ")")
    (join ", " (vec (map write form)))))

(defn write-throw
  "The expression is evaluated and thrown, therefore it should yield an error."
  [form]
  (write-template "(function() { throw ~{}; })()" (write form))

(defn write-set!
  [variable value]
  (write-template "~{} = ~{}"
                  (write variale)
                  (write value)))

(defn compile-vector
  [form]
  (write-template (list "[~{}]" (write-group form))))


(defn write-try
  "The exprs are evaluated and, if no exceptions occur, the value
  of the last is returned. If an exception occurs and catch clauses
  are provided, its exprs are evaluated in a context in which name is
  bound to the thrown exception, and the value of the last is the return
  value of the function. If there is no matching catch clause, the exception
  propagates out of the function. Before returning, normally or abnormally,
  any finally exprs will be evaluated for their side effects."
  [try-exprs catch-exprs finally-exprs]
  (if (empty? catch-exprs)
    (write-template
     "(function() {\ntry {\n  ~{}\n} finally {\n  ~{}\n}})()"
     (write-fn-body try-exprs)
     (write-fn-body finally-exprs))
    (if (empty? finally-exprs)
      (write-template
       "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n}})()"
       (write-fn-body try-exprs)
       (write (first catch-exprs))
       (write-fn-body (rest catch-exprs)))
      (compile-template
       "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n} finally {\n  ~{}\n}})()"
       (write-fn-body try-exprs)
       (write (first catch-exprs))
       (write-fn-body (rest catch-exprs))
       (write-fn-body finally-exprs)))))

(defn write-property
  "(. object method arg1 arg2)

  The '.' special form that can be considered to be a method call,
  operator"
  [form]
  ;; (. object method arg1 arg2) -> (object.method arg1 arg2)
  ;; (. object -property) -> object.property
  (if (identical? (aget (name (second form)) 0) "-")
    (compile-template
      (list (if (list? (first form)) "(~{}).~{}" "~{}.~{}")
            (compile (macroexpand (first form)))
            (compile (macroexpand (symbol (subs (name (second form)) 1))))))
    (compile-template
      (list "~{}.~{}(~{})"
            (compile (macroexpand (first form)))    ;; object name
            (compile (macroexpand (second form)))   ;; method name
            (compile-group (rest (rest form)))))))  ;; args

(defn write-new
  [form]
  (write-template "new ~{}" (write form)))

(defn write-accessor
  "Compiles compound property accessor"
  [compound target attribute]
  (compile-template
   (if compound "(~{})[~{}]" "~{}[~{}]")
   target
   attribute))