Move list definition to a sequence module.

(import [nil? vector? dec string? dictionary? key-values] "./runtime")
(import [list? list cons drop-list concat-list] "./list")

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

(defn List
  "List type"
  [head tail]
  (set! this.head head)
  (set! this.tail (or tail (list)))
  (set! this.length (inc (count this.tail)))
  this)

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

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

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

(defn cons
  "Creates list with `head` as first item and `tail` as rest"
  [head tail]
  (new List head tail))
(defn map
  "Returns a sequence consisting of the result of applying `f` to the
  first item, followed by applying f to the second items, until sequence is
  exhausted."
  [f sequence]
  (if (vector? sequence)
    (map-vector f sequence)
    (map-list f sequence)))

(defn map-vector
  "Like map but optimized for vectors"
  [f sequence]
  (.map sequence f))

(defn map-list
  "Like map but optimized for lists"
  [f sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (cons (f (first items)) result) (rest items)))))

(defn filter
  "Returns a sequence of the items in coll for which (f? item) returns true.
  f? must be free of side-effects."
  [f? sequence]
  (if (vector? sequence)
    (filter-vector f? sequence)
    (filter-list f? sequence)))

(defn filter-vector
  "Like filter but optimized for vectors"
  [f? vector]
  (.filter vector f?))

(defn filter-list
  "Like filter but for lists"
  [f? sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (if (f? (first items))
              (cons (first items) result)
              result)
              (rest items)))))

(defn take
  "Returns a sequence of the first `n` items, or all items if
  there are fewer than `n`."
  [n sequence]
  (if (vector? sequence)
    (take-vector n sequence)
    (take-list n sequence)))

(defn take-vector
  "Like take but optimized for vectors"
  [n vector]
  (.slice vector 0 n))

(defn take-list
  "Like take but for lists"
  [n sequence]
  (loop [taken '()
         items sequence
         n n]
    (if (or (= n 0) (empty? items))
      (reverse taken)
      (recur (cons (first items) taken)
             (rest items)
             (dec n)))))

(defn reduce
  [f initial sequence]
  (if (nil? sequence)
    (reduce f nil sequence)
    (if (vector? sequence)
      (reduce-vector f initial sequence)
      (reduce-list f initial sequence))))

(defn reduce-vector
  [f initial sequence]
  (if (nil? initial)
    (.reduce sequence f)
    (.reduce sequence f initial)))

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

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

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

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

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

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

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

(defn drop
  [n sequence]
  (cond (string? sequence) (.substr sequence n)

        (vector? sequence) (.slice sequence n)
        (list? sequence) (drop-list n sequence)))

(defn concat
  [& sequences]
  (apply concat-list (map seq sequences)))

(defn seq [sequence]
  (cond (nil? sequence) nil
        (or (vector? sequence) (list? sequence)) sequence
        (string? sequence) (.call Array.prototype.slice sequence)
        (dictionary? sequence) (key-values sequence)
        :default (throw TypeError (str "Can not seq " sequence))))

(export map filter reduce take reverse drop concat
        empty? count first second third rest seq)

(import [nil? vector? dec string? dictionary? key-values] "./runtime")
(import [list? list cons drop-list concat-list] "./list")

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

(defn map
  "Returns a sequence consisting of the result of applying `f` to the
  first item, followed by applying f to the second items, until sequence is
  exhausted."
  [f sequence]
  (if (vector? sequence)
    (map-vector f sequence)
    (map-list f sequence)))

(defn map-vector
  "Like map but optimized for vectors"
  [f sequence]
  (.map sequence f))

(defn map-list
  "Like map but optimized for lists"
  [f sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (cons (f (first items)) result) (rest items)))))

(defn filter
  "Returns a sequence of the items in coll for which (f? item) returns true.
  f? must be free of side-effects."
  [f? sequence]
  (if (vector? sequence)
    (filter-vector f? sequence)
    (filter-list f? sequence)))

(defn filter-vector
  "Like filter but optimized for vectors"
  [f? vector]
  (.filter vector f?))

(defn filter-list
  "Like filter but for lists"
  [f? sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (if (f? (first items))
              (cons (first items) result)
              result)
              (rest items)))))

(defn take
  "Returns a sequence of the first `n` items, or all items if
  there are fewer than `n`."
  [n sequence]
  (if (vector? sequence)
    (take-vector n sequence)
    (take-list n sequence)))

(defn take-vector
  "Like take but optimized for vectors"
  [n vector]
  (.slice vector 0 n))

(defn take-list
  "Like take but for lists"
  [n sequence]
  (loop [taken '()
         items sequence
         n n]
    (if (or (= n 0) (empty? items))
      (reverse taken)
      (recur (cons (first items) taken)
             (rest items)
             (dec n)))))

(defn reduce
  [f initial sequence]
  (if (nil? sequence)
    (reduce f nil sequence)
    (if (vector? sequence)
      (reduce-vector f initial sequence)
      (reduce-list f initial sequence))))

(defn reduce-vector
  [f initial sequence]
  (if (nil? initial)
    (.reduce sequence f)
    (.reduce sequence f initial)))

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

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

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

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

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

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

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

(defn drop
  [n sequence]
  (cond (string? sequence) (.substr sequence n)

        (vector? sequence) (.slice sequence n)
        (list? sequence) (drop-list n sequence)))

(defn concat
  [& sequences]
  (apply concat-list (map seq sequences)))

(defn seq [sequence]
  (cond (nil? sequence) nil
        (or (vector? sequence) (list? sequence)) sequence
        (string? sequence) (.call Array.prototype.slice sequence)
        (dictionary? sequence) (key-values sequence)
        :default (throw TypeError (str "Can not seq " sequence))))

(export map filter reduce take reverse drop concat
        empty? count first second third rest seq)


Implement seq.

Implement seq.

(import [nil? vector? dec string? dictionary? key-values] "./runtime")
(import [list? list cons drop-list concat-list] "./list")

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

(defn map
  "Returns a sequence consisting of the result of applying `f` to the
  first item, followed by applying f to the second items, until sequence is
  exhausted."
  [f sequence]
  (if (vector? sequence)
    (map-vector f sequence)
    (map-list f sequence)))

(defn map-vector
  "Like map but optimized for vectors"
  [f sequence]
  (.map sequence f))

(defn map-list
  "Like map but optimized for lists"
  [f sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (cons (f (first items)) result) (rest items)))))

(defn filter
  "Returns a sequence of the items in coll for which (f? item) returns true.
  f? must be free of side-effects."
  [f? sequence]
  (if (vector? sequence)
    (filter-vector f? sequence)
    (filter-list f? sequence)))

(defn filter-vector
  "Like filter but optimized for vectors"
  [f? vector]
  (.filter vector f?))

(defn filter-list
  "Like filter but for lists"
  [f? sequence]
  (loop [result '()
         items sequence]
    (if (empty? items)
      (reverse result)
      (recur (if (f? (first items))
              (cons (first items) result)
              result)
              (rest items)))))

(defn take
  "Returns a sequence of the first `n` items, or all items if
  there are fewer than `n`."
  [n sequence]
  (if (vector? sequence)
    (take-vector n sequence)
    (take-list n sequence)))

(defn take-vector
  "Like take but optimized for vectors"
  [n vector]
  (.slice vector 0 n))

(defn take-list
  "Like take but for lists"
  [n sequence]
  (loop [taken '()
         items sequence
         n n]
    (if (or (= n 0) (empty? items))
      (reverse taken)
      (recur (cons (first items) taken)
             (rest items)
             (dec n)))))

(defn reduce
  [f initial sequence]
  (if (nil? sequence)
    (reduce f nil sequence)
    (if (vector? sequence)
      (reduce-vector f initial sequence)
      (reduce-list f initial sequence))))

(defn reduce-vector
  [f initial sequence]
  (if (nil? initial)
    (.reduce sequence f)
    (.reduce sequence f initial)))

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

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

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

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

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

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

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

(export map filter reduce take reverse
        empty? count first second third rest)
(defn drop
  [n sequence]
  (cond (string? sequence) (.substr sequence n)

        (vector? sequence) (.slice sequence n)
        (list? sequence) (drop-list n sequence)))
(defn seq [sequence]
  (cond (nil? sequence) nil
        (or (vector? sequence) (list? sequence)) sequence
        (string? sequence) (.call Array.prototype.slice sequence)
        (dictionary? sequence) (key-values sequence)
        :default (throw TypeError (str "Can not seq " sequence))))


Improvements/fixes to vsplice and vfunc.

;;; Core definitions for Wisp

;; Set up require
(defun apply (f lst)
  (if (not (listp lst))
      (throw 'wrong-type-argument lst)
    (eval (cons f lst))))

(defun concat (str &rest strs)
  (if (nullp strs)
      str
    (concat2 str (apply concat strs))))

(defun require (lib)
  (load (concat wisproot "/wisplib/" (symbol-name lib) ".wisp")))

;; Load up other default libraries
(require 'list)
(require 'math)

(defmacro setq (var val)
  (list 'set (list 'quote var) val))

(defun equal (a b)
  (or (eql a b)
      (and (listp a)
	   (listp b)
	   (equal (car a) (car b))
	   (equal (cdr a) (cdr b)))))

(defun make-symbol (str)
  (if (not (stringp str))
      (throw 'wrong-type-argument str)
    (eval-string (concat "(quote " str ")"))))

(defun vconcat (vec &rest vecs)
  (if (nullp vecs)
      vec
    (vconcat2 vec (apply vconcat vecs))))

(defun vsplice (vmain start end vins)
  (vconcat
   (if (= start 0) []
     (vsub vmain 0 (1- start)))
   vins
   (if (= end (vlength vmain)) []
     (vsub vmain (1+ end)))))

(defun vfunc (vec &rest args)
  (let ((narg (length args)))
    (cond
     ((>= narg 3) (throw 'wrong-number-of-arguments args))
     ((= 0 narg) vec)
     ; vget
     ((and (= 1 narg) (listp (car args)))
      (vsub vec (caar args) (cadar args)))
     ((and (= 1 narg)) (vget vec (car args)))
     ; vset
     ((listp (car args)) (vsplice vec (caar args) (cadar args) (cadr args)))
     (t (vset vec (car args) (cadr args))))))

;;; Core definitions for Wisp

;; Set up require
(defun apply (f lst)
  (if (not (listp lst))
      (throw 'wrong-type-argument lst)
    (eval (cons f lst))))

(defun concat (str &rest strs)
  (if (nullp strs)
      str
    (concat2 str (apply concat strs))))

(defun require (lib)
  (load (concat wisproot "/wisplib/" (symbol-name lib) ".wisp")))

;; Load up other default libraries
(require 'list)
(require 'math)

(defmacro setq (var val)
  (list 'set (list 'quote var) val))

(defun equal (a b)
  (or (eql a b)
      (and (listp a)
	   (listp b)
	   (equal (car a) (car b))
	   (equal (cdr a) (cdr b)))))

(defun make-symbol (str)
  (if (not (stringp str))
      (throw 'wrong-type-argument str)
    (eval-string (concat "(quote " str ")"))))

(defun vconcat (vec &rest vecs)
  (if (nullp vecs)
      vec
    (vconcat2 vec (apply vconcat vecs))))

(defun vsplice (vmain start end vins)
  (vconcat (vsub vmain 0 (1- start )) vins (vsub vmain (1+ end))))

(defun vfunc (vec &rest args)
  (let ((narg (length args)))
    (cond
     ((>= 3 narg) (throw 'wrong-number-of-arguments args))
     ((= 0 narg) vec)
     ; vget
     ((and (= 1 narg) (listp (car args)))
      (vsub vec (caar args) (cadar args)))
     ((and (= 1 narg)) (vget vec (car args)))
     ; vset
     ((listp (car args)) (vsplice vec (caar args) (cadar args) (cadr args)))
     (t (vset vec (car args) (cadr args))))))


Improve naming of variables in the read-delimited-list function.

(ns wisp.reader
  "Reader module provides functions for reading text input
  as wisp data structures"
  (:require [wisp.sequence :refer [list list? count empty? first second third
                                   rest map vec cons conj rest concat last
                                   butlast sort lazy-seq reduce]]
            [wisp.runtime :refer [odd? dictionary keys nil? inc dec vector? string?
                                  number? boolean? object? dictionary? re-pattern
                                  re-matches re-find str subs char vals =]]
            [wisp.ast :refer [symbol? symbol keyword? keyword meta with-meta name
                              gensym]]
            [wisp.string :refer [split join]]))

(defn push-back-reader
  "Creates a StringPushbackReader from a given string"
  [source uri]
  {:lines (split source "\n") :buffer ""
   :uri uri
   :column -1 :line 0})

(defn peek-char
  "Returns next char from the Reader without reading it.
  nil if the end of stream has being reached."
  [reader]
  (let [line (aget (:lines reader)
                   (:line reader))
        column (inc (:column reader))]
    (if (nil? line)
      nil
      (or (aget line column) "\n"))))

(defn read-char
  "Returns the next char from the Reader, nil if the end
  of stream has been reached"
  [reader]
  (let [ch (peek-char reader)]
    ;; Update line column depending on what has being read.
    (if (newline? (peek-char reader))
      (do
        (set! (:line reader) (inc (:line reader)))
        (set! (:column reader) -1))
      (set! (:column reader) (inc (:column reader))))
    ch))

;; Predicates

(defn ^boolean newline?
  "Checks whether the character is a newline."
  [ch]
  (identical? "\n" ch))

(defn ^boolean breaking-whitespace?
 "Checks if a string is all breaking whitespace."
 [ch]
 (or (identical? ch " ")
     (identical? ch "\t")
     (identical? ch "\n")
     (identical? ch "\r")))

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

(defn ^boolean numeric?
 "Checks whether a given character is numeric"
 [ch]
 (or (identical? ch \0)
     (identical? ch \1)
     (identical? ch \2)
     (identical? ch \3)
     (identical? ch \4)
     (identical? ch \5)
     (identical? ch \6)
     (identical? ch \7)
     (identical? ch \8)
     (identical? ch \9)))

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

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

;; read helpers

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

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

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

    (if (or (nil? ch)
            (whitespace? ch)
            (macro-terminating? ch)) buffer
        (recur (str buffer (read-char reader))
               (peek-char reader)))))

(defn skip-line
  "Advances the reader to the end of a line. Returns the reader"
  [reader _]
  (loop []
    (let [ch (read-char reader)]
      (if (or (identical? ch "\n")
              (identical? ch "\r")
              (nil? ch))
        reader
        (recur)))))

;; Note: Input begin and end matchers are used in a pattern since otherwise
;; anything begininng with `0` will match just `0` cause it's listed first.
(def int-pattern (re-pattern "^([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?$"))
(def ratio-pattern (re-pattern "([-+]?[0-9]+)/([0-9]+)"))
(def float-pattern (re-pattern "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"))

(defn match-int
  [s]
  (let [groups (re-find int-pattern s)
        group3 (aget groups 2)]
    (if (not (or (nil? group3)
                 (< (count group3) 1)))
      0
      (let [negate (if (identical? "-" (aget groups 1)) -1 1)
            a (cond
               (aget groups 3) [(aget groups 3) 10]
               (aget groups 4) [(aget groups 4) 16]
               (aget groups 5) [(aget groups 5) 8]
               (aget groups 7) [(aget groups 7) (parse-int (aget groups 7))]
               :else [nil nil])
            n (aget a 0)
            radix (aget a 1)]
        (if (nil? n)
          nil
          (* negate (parse-int n radix)))))))

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

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

(defn match-number
  [s]
  (cond
   (re-matches int-pattern s) (match-int s)
   (re-matches ratio-pattern s) (match-ratio s)
   (re-matches float-pattern s) (match-float s)))

(defn escape-char-map [c]
  (cond
   (identical? c \t) "\t"
   (identical? c \r) "\r"
   (identical? c \n) "\n"
   (identical? c \\) \\
   (identical? c "\"") "\""
   (identical? c \b) "\b"
   (identical? c \f) "\f"
   :else nil))

;; unicode

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

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

(def unicode-2-pattern (re-pattern "[0-9A-Fa-f]{2}"))
(def unicode-4-pattern (re-pattern "[0-9A-Fa-f]{4}"))

(defn validate-unicode-escape
  "Validates unicode escape"
  [unicode-pattern reader escape-char unicode-str]
  (if (re-matches unicode-pattern unicode-str)
    unicode-str
    (reader-error
     reader
     (str "Unexpected unicode escape " \\ escape-char unicode-str))))

(defn make-unicode-char
  [code-str base]
  (let [base (or base 16)
        code (parseInt code-str base)]
    (char code)))

(defn escape-char
  "escape char"
  [buffer reader]
  (let [ch (read-char reader)
        mapresult (escape-char-map ch)]
    (if mapresult
      mapresult
      (cond
        (identical? ch \x) (make-unicode-char
                            (validate-unicode-escape unicode-2-pattern
                                                     reader
                                                     ch
                                                     (read-2-chars reader)))
        (identical? ch \u) (make-unicode-char
                            (validate-unicode-escape unicode-4-pattern
                                                     reader
                                                     ch
                                                     (read-4-chars reader)))
        (numeric? ch) (char ch)
        :else (reader-error reader
                            (str "Unexpected unicode escape " \\ ch ))))))

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

;; TODO: Complete implementation
(defn read-delimited-list
  "Reads out delimited list"
  [delim reader recursive?]
  (loop [forms []]
    (let [ch (read-past whitespace? reader)]
      (if (not ch) (reader-error reader :EOF))
      (if (identical? delim ch)
        (do (read-char reader) forms)
        (let [macro (macros ch)]
          (if macro
            (let [form (macro reader (read-char reader))]
              (recur (if (identical? form reader)
                       forms
                       (conj forms form))))
            (let [form (read reader true nil recursive?)]
              (recur (if (identical? form reader)
                       forms
                       (conj forms form))))))))))

;; data structure readers

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

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

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

(defn read-list
  [reader _]
  (let [form (read-delimited-list ")" reader true)]
    (with-meta (apply list form) (meta form))))

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

    (cond
     (or (nil? ch)
         (identical? "\n" ch)) (or reader ;; ignore comments for now
                                   (list 'comment buffer))
     (or (identical? \\ ch)) (recur (str buffer (escape-char buffer reader))
                                    (read-char reader))
     :else (recur (str buffer ch) (read-char reader)))))

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

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

(defn read-set
  [reader _]
  (let [form (read-delimited-list "}" reader true)]
    (with-meta (concat ['set] form) (meta form))))

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

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

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

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

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

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

(defn read-symbol
  [reader initch]
  (let [token (read-token reader initch)
        parts (split token "/")
        has-ns (and (> (count parts) 1)
                    ;; Make sure it's not just `/`
                    (> (count token) 1))
        ns (first parts)
        name (join "/" (rest parts))]
    (if has-ns
      (symbol ns name)
      (special-symbols token (symbol token)))))

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

(defn desugar-meta
  [form]
  ;; keyword should go before string since it is a string.
  (cond (keyword? form) (dictionary (name form) true)
        (symbol? form) {:tag form}
        (string? form) {:tag form}
        (dictionary? form) (reduce (fn [result pair]
                                     (set! (get result
                                                (name (first pair)))
                                           (second pair))
                                     result)
                                   {}
                                   form)
        :else form))

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

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

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

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

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

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

(defn read-param
  [reader initch]
  (let [form (read-symbol reader initch)]
    (if (= form (symbol "%")) (symbol "%1") form)))

(defn param? [form]
  (and (symbol? form) (identical? \% (first (name form)))))

(defn lambda-params-hash [form]
  (cond (param? form) (dictionary form form)
        (or (dictionary? form)
            (vector? form)
            (list? form)) (apply conj
                                 (map lambda-params-hash (vec form)))
        :else {}))

(defn lambda-params [body]
  (let [names (sort (vals (lambda-params-hash body)))
        variadic (= (first names) (symbol "%&"))
        n (if (and variadic (identical? (count names) 1))
              0
              (parseInt (rest (name (last names)))))
        params (loop [names []
                      i 1]
                (if (<= i n)
                  (recur (conj names (symbol (str "%" i))) (inc i))
                  names))]
    (if variadic (conj params '& '%&) names)))

(defn read-lambda
  [reader]
   (let [body (read-list reader)]
    (list 'fn (lambda-params body) body)))

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

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

(defn dispatch-macros [s]
  (cond
   (identical? s \{) read-set
   (identical? s \() read-lambda
   (identical? s \<) (throwing-reader "Unreadable form")
   (identical? s "\"") read-regex
   (identical? s \!) read-comment
   (identical? s \_) read-discard
   :else nil))

(defn read-form
  [reader ch]
  (let [start {:line (:line reader)
               :column (:column reader)}
        read-macro (macros ch)
        form (cond read-macro (read-macro reader ch)
                   (number-literal? reader ch) (read-number reader ch)
                   :else (read-symbol reader ch))]
    (cond (identical? form reader) form
          (not (or (string? form)
                   (number? form)
                   (boolean? form)
                   (nil? form)
                   (keyword? form))) (with-meta form
                                                (conj {:start start
                                                       :end {:line (:line reader)
                                                             :column (:column reader)}}
                                                      (meta form)))
          :else form)))

(defn read
  "Reads the first object from a PushbackReader.
  Returns the object read. If EOF, throws if eof-is-error is true.
  Otherwise returns sentinel."
  [reader eof-is-error sentinel is-recursive]
  (loop []
    (let [ch (read-char reader)
          form (cond
                (nil? ch) (if eof-is-error (reader-error reader :EOF) sentinel)
                (whitespace? ch) reader
                (comment-prefix? ch) (read (read-comment reader ch)
                                           eof-is-error
                                           sentinel
                                           is-recursive)
                :else (read-form reader ch))]
      (if (identical? form reader)
        (recur eof-is-error sentinel is-recursive)
        form))))

(defn read*
  [source uri]
  (let [reader (push-back-reader source uri)
        eof (gensym)]
    (loop [forms []
           form (read reader false eof false)]
      (if (identical? form eof)
        forms
        (recur (conj forms form)
               (read reader false eof false))))))

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

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

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

(def **tag-table**
  (dictionary :uuid read-uuid
              :queue read-queue))

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

(ns wisp.reader
  "Reader module provides functions for reading text input
  as wisp data structures"
  (:require [wisp.sequence :refer [list list? count empty? first second third
                                   rest map vec cons conj rest concat last
                                   butlast sort lazy-seq reduce]]
            [wisp.runtime :refer [odd? dictionary keys nil? inc dec vector? string?
                                  number? boolean? object? dictionary? re-pattern
                                  re-matches re-find str subs char vals =]]
            [wisp.ast :refer [symbol? symbol keyword? keyword meta with-meta name
                              gensym]]
            [wisp.string :refer [split join]]))

(defn push-back-reader
  "Creates a StringPushbackReader from a given string"
  [source uri]
  {:lines (split source "\n") :buffer ""
   :uri uri
   :column -1 :line 0})

(defn peek-char
  "Returns next char from the Reader without reading it.
  nil if the end of stream has being reached."
  [reader]
  (let [line (aget (:lines reader)
                   (:line reader))
        column (inc (:column reader))]
    (if (nil? line)
      nil
      (or (aget line column) "\n"))))

(defn read-char
  "Returns the next char from the Reader, nil if the end
  of stream has been reached"
  [reader]
  (let [ch (peek-char reader)]
    ;; Update line column depending on what has being read.
    (if (newline? (peek-char reader))
      (do
        (set! (:line reader) (inc (:line reader)))
        (set! (:column reader) -1))
      (set! (:column reader) (inc (:column reader))))
    ch))

;; Predicates

(defn ^boolean newline?
  "Checks whether the character is a newline."
  [ch]
  (identical? "\n" ch))

(defn ^boolean breaking-whitespace?
 "Checks if a string is all breaking whitespace."
 [ch]
 (or (identical? ch " ")
     (identical? ch "\t")
     (identical? ch "\n")
     (identical? ch "\r")))

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

(defn ^boolean numeric?
 "Checks whether a given character is numeric"
 [ch]
 (or (identical? ch \0)
     (identical? ch \1)
     (identical? ch \2)
     (identical? ch \3)
     (identical? ch \4)
     (identical? ch \5)
     (identical? ch \6)
     (identical? ch \7)
     (identical? ch \8)
     (identical? ch \9)))

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

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

;; read helpers

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

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

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

    (if (or (nil? ch)
            (whitespace? ch)
            (macro-terminating? ch)) buffer
        (recur (str buffer (read-char reader))
               (peek-char reader)))))

(defn skip-line
  "Advances the reader to the end of a line. Returns the reader"
  [reader _]
  (loop []
    (let [ch (read-char reader)]
      (if (or (identical? ch "\n")
              (identical? ch "\r")
              (nil? ch))
        reader
        (recur)))))

;; Note: Input begin and end matchers are used in a pattern since otherwise
;; anything begininng with `0` will match just `0` cause it's listed first.
(def int-pattern (re-pattern "^([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?$"))
(def ratio-pattern (re-pattern "([-+]?[0-9]+)/([0-9]+)"))
(def float-pattern (re-pattern "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"))

(defn match-int
  [s]
  (let [groups (re-find int-pattern s)
        group3 (aget groups 2)]
    (if (not (or (nil? group3)
                 (< (count group3) 1)))
      0
      (let [negate (if (identical? "-" (aget groups 1)) -1 1)
            a (cond
               (aget groups 3) [(aget groups 3) 10]
               (aget groups 4) [(aget groups 4) 16]
               (aget groups 5) [(aget groups 5) 8]
               (aget groups 7) [(aget groups 7) (parse-int (aget groups 7))]
               :else [nil nil])
            n (aget a 0)
            radix (aget a 1)]
        (if (nil? n)
          nil
          (* negate (parse-int n radix)))))))

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

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

(defn match-number
  [s]
  (cond
   (re-matches int-pattern s) (match-int s)
   (re-matches ratio-pattern s) (match-ratio s)
   (re-matches float-pattern s) (match-float s)))

(defn escape-char-map [c]
  (cond
   (identical? c \t) "\t"
   (identical? c \r) "\r"
   (identical? c \n) "\n"
   (identical? c \\) \\
   (identical? c "\"") "\""
   (identical? c \b) "\b"
   (identical? c \f) "\f"
   :else nil))

;; unicode

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

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

(def unicode-2-pattern (re-pattern "[0-9A-Fa-f]{2}"))
(def unicode-4-pattern (re-pattern "[0-9A-Fa-f]{4}"))

(defn validate-unicode-escape
  "Validates unicode escape"
  [unicode-pattern reader escape-char unicode-str]
  (if (re-matches unicode-pattern unicode-str)
    unicode-str
    (reader-error
     reader
     (str "Unexpected unicode escape " \\ escape-char unicode-str))))

(defn make-unicode-char
  [code-str base]
  (let [base (or base 16)
        code (parseInt code-str base)]
    (char code)))

(defn escape-char
  "escape char"
  [buffer reader]
  (let [ch (read-char reader)
        mapresult (escape-char-map ch)]
    (if mapresult
      mapresult
      (cond
        (identical? ch \x) (make-unicode-char
                            (validate-unicode-escape unicode-2-pattern
                                                     reader
                                                     ch
                                                     (read-2-chars reader)))
        (identical? ch \u) (make-unicode-char
                            (validate-unicode-escape unicode-4-pattern
                                                     reader
                                                     ch
                                                     (read-4-chars reader)))
        (numeric? ch) (char ch)
        :else (reader-error reader
                            (str "Unexpected unicode escape " \\ ch ))))))

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

;; TODO: Complete implementation
(defn read-delimited-list
  "Reads out delimited list"
  [delim reader recursive?]
  (loop [form []]
    (let [ch (read-past whitespace? reader)]
      (if (not ch) (reader-error reader :EOF))
      (if (identical? delim ch)
        (do (read-char reader) form)
        (let [macro (macros ch)]
          (if macro
            (let [result (macro reader (read-char reader))]
              (recur (if (identical? result reader)
                       form
                       (conj form result))))
            (let [o (read reader true nil recursive?)]
              (recur (if (identical? o reader)
                       form
                       (conj form o))))))))))

;; data structure readers

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

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

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

(defn read-list
  [reader _]
  (let [form (read-delimited-list ")" reader true)]
    (with-meta (apply list form) (meta form))))

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

    (cond
     (or (nil? ch)
         (identical? "\n" ch)) (or reader ;; ignore comments for now
                                   (list 'comment buffer))
     (or (identical? \\ ch)) (recur (str buffer (escape-char buffer reader))
                                    (read-char reader))
     :else (recur (str buffer ch) (read-char reader)))))

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

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

(defn read-set
  [reader _]
  (let [form (read-delimited-list "}" reader true)]
    (with-meta (concat ['set] form) (meta form))))

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

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

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

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

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

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

(defn read-symbol
  [reader initch]
  (let [token (read-token reader initch)
        parts (split token "/")
        has-ns (and (> (count parts) 1)
                    ;; Make sure it's not just `/`
                    (> (count token) 1))
        ns (first parts)
        name (join "/" (rest parts))]
    (if has-ns
      (symbol ns name)
      (special-symbols token (symbol token)))))

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

(defn desugar-meta
  [form]
  ;; keyword should go before string since it is a string.
  (cond (keyword? form) (dictionary (name form) true)
        (symbol? form) {:tag form}
        (string? form) {:tag form}
        (dictionary? form) (reduce (fn [result pair]
                                     (set! (get result
                                                (name (first pair)))
                                           (second pair))
                                     result)
                                   {}
                                   form)
        :else form))

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

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

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

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

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

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

(defn read-param
  [reader initch]
  (let [form (read-symbol reader initch)]
    (if (= form (symbol "%")) (symbol "%1") form)))

(defn param? [form]
  (and (symbol? form) (identical? \% (first (name form)))))

(defn lambda-params-hash [form]
  (cond (param? form) (dictionary form form)
        (or (dictionary? form)
            (vector? form)
            (list? form)) (apply conj
                                 (map lambda-params-hash (vec form)))
        :else {}))

(defn lambda-params [body]
  (let [names (sort (vals (lambda-params-hash body)))
        variadic (= (first names) (symbol "%&"))
        n (if (and variadic (identical? (count names) 1))
              0
              (parseInt (rest (name (last names)))))
        params (loop [names []
                      i 1]
                (if (<= i n)
                  (recur (conj names (symbol (str "%" i))) (inc i))
                  names))]
    (if variadic (conj params '& '%&) names)))

(defn read-lambda
  [reader]
   (let [body (read-list reader)]
    (list 'fn (lambda-params body) body)))

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

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

(defn dispatch-macros [s]
  (cond
   (identical? s \{) read-set
   (identical? s \() read-lambda
   (identical? s \<) (throwing-reader "Unreadable form")
   (identical? s "\"") read-regex
   (identical? s \!) read-comment
   (identical? s \_) read-discard
   :else nil))

(defn read-form
  [reader ch]
  (let [start {:line (:line reader)
               :column (:column reader)}
        read-macro (macros ch)
        form (cond read-macro (read-macro reader ch)
                   (number-literal? reader ch) (read-number reader ch)
                   :else (read-symbol reader ch))]
    (cond (identical? form reader) form
          (not (or (string? form)
                   (number? form)
                   (boolean? form)
                   (nil? form)
                   (keyword? form))) (with-meta form
                                                (conj {:start start
                                                       :end {:line (:line reader)
                                                             :column (:column reader)}}
                                                      (meta form)))
          :else form)))

(defn read
  "Reads the first object from a PushbackReader.
  Returns the object read. If EOF, throws if eof-is-error is true.
  Otherwise returns sentinel."
  [reader eof-is-error sentinel is-recursive]
  (loop []
    (let [ch (read-char reader)
          form (cond
                (nil? ch) (if eof-is-error (reader-error reader :EOF) sentinel)
                (whitespace? ch) reader
                (comment-prefix? ch) (read (read-comment reader ch)
                                           eof-is-error
                                           sentinel
                                           is-recursive)
                :else (read-form reader ch))]
      (if (identical? form reader)
        (recur eof-is-error sentinel is-recursive)
        form))))

(defn read*
  [source uri]
  (let [reader (push-back-reader source uri)
        eof (gensym)]
    (loop [forms []
           form (read reader false eof false)]
      (if (identical? form eof)
        forms
        (recur (conj forms form)
               (read reader false eof false))))))

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

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

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

(def **tag-table**
  (dictionary :uuid read-uuid
              :queue read-queue))

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


Improve repl to print lisp forms instead of JS.

(import repl "repl")
(import vm "vm")
(import transpile "./engine/node")
(import [pr-str] "./ast")

(defn evaluate [code context file callback]
  (try
    (callback null
              (.run-in-this-context
               vm
               ;; Strip out first and last chars since node repl module
               ;; wraps code passed to eval function '()'.
               (transpile (.substring code 1 (- (.-length code) 2)) file)
               file))
    (catch error (callback error))))

(defn start
  "Starts repl"
  []
  (.start repl {
          :writer pr-str
          :prompt "=> "
          :ignoreUndefined true
          :useGlobal true
          :eval evaluate}))

(export start)

(import repl "repl")
(import vm "vm")
(import transpile "./engine/node")

(defn evaluate [code context file callback]
  (try
    (callback null
              (.run-in-this-context
               vm
               ;; Strip out first and last chars since node repl module
               ;; wraps code passed to eval function '()'.
               (transpile (.substring code 1 (- (.-length code) 2)) file)
               file))
    (catch error (callback error))))

(defn start
  "Starts repl"
  []
  (.start repl {
          :prompt "=> "
          :ignoreUndefined true
          :useGlobal true
          :eval evaluate}))

(export start)


Shorten transpile function.

Shorten transpile function.

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

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

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

(.log console "compile primitive forms")

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

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

(.log console "compile functions")

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

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

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

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

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

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

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

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

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

(.log console "compile if special form")

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

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

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

(.log console "compile do special form")

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

(.log console "compile let special form")

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

(.log console "compile throw special form")

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

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

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

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

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

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

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

(.log console "compile vectors")

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

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

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

(.log console "compiles try special form")

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

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

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

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

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

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

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

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

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

(.log console "compile references")

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

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

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

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

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

(.log console "compiles new special form")

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

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

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

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

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

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

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

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

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

(.log console "compiles compound accessor")

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

(.log console "compiles instance?")

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

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

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

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


Fix regression in --print <format> param.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


fix compiling stdin not working

fix compiling stdin not working

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

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

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

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

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

(defn compile-string
  [source options]
  (let [channel (or (:print options) :code)
        output (compile source options)
        content (if (= channel :code)
                  (:code output)
                  (JSON.stringify (get output channel) 2 2))]
    (if (:ast options) (map (fn [item]
                              (.write process.stdout
                                      (str (pr-str item.form) "\n")))
                              output.ast))
    (if (and (:output options) (:source-uri options) content)
      (writeFileSync (path.join (:output options) ;; `join` relies on `path`
                           (str (basename (:source-uri options) ".wisp") ".js"))
                     content)
      (.write process.stdout (or content "nil")))
    (if (:error output) (throw (:error output)))))

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

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

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

(defn main
  []
  (let [options commander]
    (-> options
      (.usage "[options] <file ...>")
      (.option "-r, --run"           "Compile and execute the file")
      (.option "-c, --compile"       "Compile to JavaScript and save as .js files")
      (.option "-i, --interactive"   "Run an interactive wisp REPL")
      (.option "--debug, --print <type>"    "Print debug information. Possible values are `form`, `ast` and `js-ast`")
      (.option "-o, --output <dir>"  "Output to specified directory")
      (.option "--no-map"            "Disable source map generation")
      (.parse process.argv))
    (set! (aget options "no-map") (not (aget options "map"))) ;; commander auto translates to camelCase
    (cond options.run (run options.args)
          (not process.stdin.isTTY) (compile-stdin options)
          options.interactive (start-repl)
          options.compile (compile-file options.args options)
          options.args (run options.args)
          :else (start-repl)
   )))

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

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

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

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

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

(defn compile-string
  [source options]
  (let [channel (or (:print options) :code)
        output (compile source options)
        content (cond
                  (= channel :code) (:code output)
                  (= channel :forms) (map (fn [item]
                                            (str (pr-str (:form item)) "\n"))
                                          (:ast output))
                  :else (pr-str (get output channel) 2 2))]
    (if (and (:output options) (:source-uri options) content)
      (writeFileSync (path.join (:output options) ;; `join` relies on `path`
                           (str (basename (:source-uri options) ".wisp") ".js"))
                     content)
      (.write process.stdout (or content "nil")))
    (if (:error output) (throw (:error output)))))

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

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

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

(defn main
  []
  (let [options commander]
    (-> options
      (.usage "[options] <file ...>")
      (.option "-r, --run"           "Compile and execute the file")
      (.option "-c, --compile"       "Compile to JavaScript and save as .js files")
      (.option "-i, --interactive"   "Run an interactive wisp REPL")
      (.option "--debug, --print <type>"    "Print debug information. Possible values are `form`, `ast` and `js-ast`")
      (.option "-o, --output <dir>"  "Output to specified directory")
      (.option "--no-map"            "Disable source map generation")
      (.parse process.argv))
    (set! (aget options "no-map") (not (aget options "map"))) ;; commander auto translates to camelCase
    (cond options.run (run options.args)
          (not process.stdin.isTTY) (compile-stdin options)
          options.interactive (start-repl)
          options.compile (compile-file options.args options)
          options.args (run options.args)
          :else (start-repl)
   )))