ruby-wisp-source 0.7.0

data/vendor/try/node_modules/~wisp/src/backend/js/generator.wisp

@@ -0,0 +1,939 @@
+(import [read-from-string] "./reader")
+(import [meta with-meta symbol? symbol keyword? keyword namespace
+         unquote? unquote-splicing? quote? syntax-quote? name gensym pr-str] "./ast")
+(import [empty? count list? list first second third rest cons conj
+         reverse reduce vec last
+         map filter take concat] "./sequence")
+(import [odd? dictionary? dictionary merge keys vals contains-vector?
+         map-dictionary string? number? vector? boolean? subs re-find
+         true? false? nil? re-pattern? inc dec str char int = ==] "./runtime")
+(import [split join upper-case replace] "./string")
+
+(def **specials** {})
+
+
+(defn compile-reference
+  "Translates references from clojure convention to JS:
+
+  **macros**      __macros__
+  list->vector    listToVector
+  set!            set
+  foo_bar         foo_bar
+  number?         isNumber
+  create-server   createServer"
+  [form]
+  (def id (name form))
+  (set! id (cond (identical? id  "*") "multiply"
+                 (identical? id "/") "divide"
+                 (identical? id "+") "sum"
+                 (identical? id "-") "subtract"
+                 (identical? id "=") "equal?"
+                 (identical? id "==") "strict-equal?"
+                 (identical? id "<=") "not-greater-than"
+                 (identical? id ">=") "not-less-than"
+                 (identical? id ">") "greater-than"
+                 (identical? id "<") "less-than"
+                 :else id))
+
+  ;; **macros** ->  __macros__
+  (set! id (join "_" (split id "*")))
+  ;; list->vector ->  listToVector
+  (set! id (join "-to-" (split id "->")))
+  ;; set! ->  set
+  (set! id (join (split id "!")))
+  (set! id (join "$" (split id "%")))
+  ;; foo= -> fooEqual
+  ;(set! id (join "-equal-" (split id "="))
+  ;; foo+bar -> fooPlusBar
+  (set! id (join "-plus-" (split id "+")))
+  (set! id (join "-and-" (split id "&")))
+  ;; number? -> isNumber
+  (set! id (if (identical? (last id) "?")
+             (str "is-" (subs id 0 (dec (count id))))
+             id))
+  ;; create-server -> createServer
+  (set! id (reduce
+            (fn [result key]
+              (str result
+                   (if (and (not (empty? result))
+                            (not (empty? key)))
+                     (str (upper-case (get key 0)) (subs key 1))
+                     key)))
+            ""
+            (split id "-")))
+  id)
+
+(defn write-keyword [form]
+  (str "\"" (name form) "\""))
+
+
+(defn write-comment [form]
+  (write-template (list "//~{}\n" (first form))))
+
+(def ^:private *indent-pattern* #"\n *$")
+(def ^:private *line-break-pattern #"(?m)\n") ;; if not then (RegExp "\n" "g")
+(defn- get-indentation [code]
+  (or (re-find *indent-pattern* code) "\n"))
+
+(defn write-template [template form]
+  (loop [code ""
+         parts (split template "~{}")
+         values form]
+    (if (> (count parts) 1)
+      (recur (str code
+                  (first parts)
+                  (replace (str "" (first values))
+                           line-break-pattern
+                           (get-indentation (first parts)))
+                  (rest parts)
+                  (rest values)
+                  (str code (first parts)))))))
+
+       
+(defn- write-dictionary-pair
+  [pair]
+  (let [key (first pair)
+        value (second pair)]
+    (compile-template "~{}: ~{}\n"
+                      (write key)
+                      (write vaulue))))
+
+(defn write-dictionary
+  "Compiles dictionary to JS object"
+  [form]
+  (let [pairs (key-values form)
+        entries (map write-dictionary-pair pairs)]
+    (if (empty? pairs)
+      "~{}"
+      (write-template "{\n  ~{}}"
+                      (reduce str "" entries)))))
+
+(defn write-fn
+  [form]
+  (let [doc (:doc form)
+        attrs (:attrs form)
+        name (first form)
+        params (second form)
+        body (rest (rest form))
+        ]
+    (if (nil? name)
+      (list "function(~{}) {\n  ~{}\n}"
+            (join ", " (map write params))
+            (write-expressions (map write body))
+      (list "function ~{}(~{}) {\n  ~{}\n}"
+            (write name)
+            (join ", " (map write params))
+            (write-expressions (map write body)))))))
+
+(defn write-switch
+  [value cases default-case]
+  (compile-template
+   (list "switch (~{}) {\n  ~{}\n  default:\n    ~{}\n}"
+         (compile (macroexpand value))
+         (compile-switch-cases cases)
+         (compile (macroexpand default-case)))))
+
+
+(defn write-call
+  [form]
+  {:type :CallExpression
+   :callee (write (first form))
+   :arguments (map write (vec (rest params)))})   
+  
+(defn- write-property
+  [pair]
+  {:type :Property
+   :key (write (first pair))
+   :value (write (second pair))
+   :kind :init})
+
+(def **specials** {})
+(defn special?
+  "Returns true if special form"
+  [operator]
+  (and (symbol? operator)
+       (get **specials** operator)
+       true))
+  
+(defn- write-special
+  [form]
+  ((get **specials** (first form)) (with-meta (rest form) (meta form))))
+
+
+(defmacro defoperator
+  "Installs special function"
+  [operator & body]
+  `(set-operator! (quote ~operator) (fn ~@body)))
+
+(defn set-operator!
+  [operator fn]
+  `(set! (get **specials** (name operator)) fn))
+
+(defoperator set!
+  [form]
+  {:type :AssignmentExpression
+   :operator :=
+   :left (write (first form))
+   :right (write (second form))})
+
+(defoperator get
+  [form]
+  (let [property (write (second form))]
+    {:type :MemberExpression
+     :computed true
+     :object (write (first form))
+     :property (write (second form))}))
+
+(defoperator 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)."
+  [form]
+  (let [id (first form)
+        export? (and (:top (meta form))
+                     (not (:private (meta id))))
+        attribute (symbol (namespace id)
+                          (str "-" (name id)))
+        declaration {:type :VariableDeclaration
+                     :kind :var
+                     :declarations [{:type :VariableDeclarator
+                                     :id (write id)
+                                     :init (write (second form))}]}]
+    (if export?
+      [declaration (write (set! (get exports ~attribute) ~id))]
+      declaration)))
+
+(defoperator 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."
+  [form]
+  {:type :ConditionalExpression
+   :test (write (first form))
+   :consequent (second form)
+   :alternate (third form)})
+
+(defoperator do
+  [form]
+  )
+
+(defoperator fn
+  [form]
+  )
+
+(defoperator throw
+  [form]
+  {:type :ThrowStatement
+   :argument (write (first form))})
+
+
+(defn- try-handler?
+  [form]
+  (and (list? form)
+       (or (= 'catch (first head))
+           (= 'finally (first head)))))
+
+(defn- analyze-handlers
+  [form]
+  (let [head (first form)]
+    (if (and (list? head)
+             (= 'catch (first head)))
+      {:catch (rest head)
+       :finally (rest (second form))}
+      {:catch nil
+       :finally head})))
+
+(defn- analyze-try
+  [form]
+  (loop [metadata (meta form)
+         head (first form)
+         tail (rest form)
+         result []]
+    (cond (try-handler? head) (with-meta form
+                                (conj {}
+                                      metadata
+                                      {:try result}
+                                      (analyze-handlers tail)))
+          :else (recur (first tail)
+                       (rest tail)
+                       (conj result head)))))
+    
+    
+(defoperator try
+  [form]
+  (let [analyzed (analyze-try form)
+        metadata (meta analyzed)
+        try-block (:try metadata)
+        catch-block (:catch metadata)
+        finally-block (:finally metadata)]                        
+                        
+    
+    {:type :TryStatement
+     :guardedHandlers []
+     :block (write-block try-block)
+     :handlers (if catch-block
+                 [{:type :CatchClause
+                      :param (first catch-block)
+                      :body (write-block (rest catch-block))}]
+                 [])
+     :finalizer (write-block finally-block)}))
+
+
+(defoperator new
+  [form]
+  {:type :NewExpression
+   :callee (write (first form))
+   :arguments (map write (vec (rest form)))})
+
+
+;; Operators that compile to binary expressions
+
+(defn make-binary-expression
+  [operator left right]
+  {:type :BinaryExpression
+   :operator operator
+   :left left
+   :right right})
+
+
+(defmacro def-binary-operator
+  [id operator default-operand make-operand]
+  `(set-operator! (name ~id)
+                  (fn make-expression
+                    ([] (write ~default-operand))
+                    ([operand] (write (~make-operand operand)))
+                    ([left right] (make-binary-expression ~operator
+                                                          (write left)
+                                                          (write right)))
+                    ([left & more] (make-binary-expression ~operator
+                                                          (write left)
+                                                          (apply make-expression right))))))
+
+(defn verify-one
+  [operator]
+  (error (str operator "form requires at least one operand")))
+
+(defn verify-two
+  [operator]
+  (error (str operator "form requires at least two operands")))
+
+;; Arithmetic operators
+
+(def-binary-operator :+ :+ 0 identity)
+(def-binary-operator :- :- 'NaN identity)
+(def-binary-operator :* :* 1 identity)
+(def-binary-operator (keyword "/") (keyword "/") verify-two verify-two)
+(def-binary-operator :mod (keyword "%") verify-two verify-two)
+
+;; Comparison operators
+
+(def-binary-operator :not= :!= verify-one false)
+(def-binary-operator :== :=== verify-one true)
+(def-binary-operator :identical? '=== verify-two verify-two)
+(def-binary-operator :> :> verify-one true)
+(def-binary-operator :>= :>= verify-one true)
+(def-binary-operator :< :< verify-one true)
+(def-binary-operator :<= :<= verify-one true)
+
+;; Bitwise Operators
+
+(def-binary-operator :bit-and :& verify-two verify-two)
+(def-binary-operator :bit-or :| verify-two verify-two)
+(def-binary-operator :bit-xor (keyword "^") verify-two verify-two)
+(def-binary-operator :bit-not (keyword "~") verify-two verify-two)
+(def-binary-operator :bit-shift-left :<< verify-two verify-two)
+(def-binary-operator :bit-shift-right :>> verify-two verify-two)
+(def-binary-operator :bit-shift-right-zero-fil :>>> verify-two verify-two)
+
+
+;; Logical operators
+
+(defn make-logical-expression
+  [operator left right]
+  {:type :LogicalExpression
+   :operator operator
+   :left left
+   :right right})
+
+(defmacro def-logical-expression
+  [id operator default-operand make-operand]
+  `(set-operator! (name ~id)
+                  (fn make-expression
+                    ([] (write ~default-operand))
+                    ([operand] (write (~make-operand operand)))
+                    ([left right] (make-logical-expression ~operator
+                                                          (write left)
+                                                          (write right)))
+                    ([left & more] (make-logical-expression ~operator
+                                                          (write left)
+                                                          (apply make-expression right))))))
+
+(def-logical-expression :and :&& 'true identity)
+(def-logical-expression :and :|| 'nil identity)
+
+
+(defoperator .
+  [form]
+  {:type :CallExpression
+   :callee {:type :MemberExpression
+            :computed false
+            :object (write (first form))
+            :property (write (second form))}
+   :arguments (map write (vec (rest (rest params))))})
+
+(defoperator instance?
+  [form]
+  {:type :BinaryExpression
+   :operator :instanceof
+   :left (write (second form))
+   :right (write (first form))})
+
+(defoperator not
+  [form]
+  {:type :UnaryExpression
+   :operator :!
+   :argument (write (second form))})
+
+
+   
+  
+
+(defn- write-list
+  (let [operator (first form)
+        body (rest form)]
+      (cond
+       (empty? form) (write-call '(list))
+       (keyword? operator) (write `(get (or ~body 0) ~operator))
+       (special? operator) (write-special form)
+       (= 'set! operator) (write-set! body)
+       (= 'get operator) (write-get body)
+       (= 'def operator) (write-def body)
+       (quote? form) (write-quoted (second form))
+       (syntax-quote? form) (write-syntax-quoted (second form))
+
+       
+       ;; Compile keyword invoke as a property access.
+       (keyword? head) (compile `(get (or ~(second form) 0) ~head))
+       :else (do
+              (if (not (or (symbol? head) (list? head)))
+                (throw (compiler-error
+                        form
+                        (str "operator is not a procedure: " head)))
+              (compile-invoke form))))))
+
+  
+(defn write [form]
+  (cond (nil? form) {:type :UnaryExpression
+                     :operator :void
+                     :argument {:type :Literal
+                                :value 0}}
+        (symbol? form) {:type :Identifier
+                        :name (name form)}
+        (keyword? form) {:type :Literal
+                         :value (str "\"" (name form) "\"")}
+        (pattern? form) {:type :Literal
+                         :value (str form)}
+        (or (boolean? form)
+            (number? form)
+            (string? form)) {:type :Literal
+                             :value form}
+        (vector? form) {:type :ArrayExpression
+                        :elements (map write form)}
+        (dictionary? form) {:type :ObjectExpression
+                            :properties (map write-property
+                                             (key-vals form))}
+        (list? form) (write-list form)))
+        
+
+            
+  
+     
+       
+  (write-template
+   (if (list? (first)))
+   ;; Wrap functions returned by expressions into parenthesis.
+   (list (if (list? (first form)) "(~{})(~{})" "~{}(~{})")
+         (compile (first form))
+         (compile-group (rest form)))))
+
+(defn compile-group
+  [form wrap]
+  (if wrap
+    (str "(" (compile-group form) ")")
+    (join ", " (vec (map compile (map  macroexpand form))))))
+
+(defn compile-do
+  "Evaluates the expressions in order and returns the value of the last.
+  If no expressions are supplied, returns nil."
+  [form]
+  (compile (list (cons 'fn (cons [] form)))))
+
+
+(defn define-bindings
+  "Returns list of binding definitions"
+  [form]
+  (loop [defs '()
+         bindings form]
+    (if (identical? (count bindings) 0)
+      (reverse defs)
+      (recur
+        (cons
+          (list 'def                ; '(def (get bindings 0) (get bindings 1))
+                (get bindings 0)    ; binding name
+                (get bindings 1))   ; binding value
+           defs)
+        (rest (rest bindings))))))
+
+(defn compile-throw
+  "The expression is evaluated and thrown, therefore it should yield an error."
+  [form]
+  (compile-template
+    (list "(function() { throw ~{}; })()"
+          (compile (macroexpand (first form))))))
+
+(defn compile-set
+  "Assignment special form.
+
+  When the first operand is a field member access form, the assignment
+  is to the corresponding field."
+  ; {:added "1.0", :special-form true, :forms '[(loop [bindings*] exprs*)]}
+  [form]
+  (compile-template
+    (list "~{} = ~{}"
+      (compile (macroexpand (first form)))
+      (compile (macroexpand (second form))))))
+
+(defn compile-vector
+  "Creates a new vector containing the args"
+  [form]
+  (compile-template (list "[~{}]" (compile-group form))))
+
+
+(defn compile-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."
+  [form]
+  (loop [try-exprs '()
+         catch-exprs '()
+         finally-exprs '()
+         exprs (reverse form)]
+    (if (empty? exprs)
+      (if (empty? catch-exprs)
+        (compile-template
+          (list
+            "(function() {\ntry {\n  ~{}\n} finally {\n  ~{}\n}})()"
+            (compile-fn-body try-exprs)
+            (compile-fn-body finally-exprs)))
+        (if (empty? finally-exprs)
+          (compile-template
+            (list
+              "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n}})()"
+              (compile-fn-body try-exprs)
+              (compile (first catch-exprs))
+              (compile-fn-body (rest catch-exprs))))
+          (compile-template
+            (list
+              "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n} finally {\n  ~{}\n}})()"
+              (compile-fn-body try-exprs)
+              (compile (first catch-exprs))
+              (compile-fn-body (rest catch-exprs))
+              (compile-fn-body finally-exprs)))))
+        (if (= (first (first exprs)) 'catch)
+          (recur try-exprs
+                 (rest (first exprs))
+                 finally-exprs
+                 (rest exprs))
+          (if (= (first (first exprs)) 'finally)
+            (recur try-exprs
+                   catch-exprs
+                   (rest (first exprs))
+                   (rest exprs))
+            (recur (cons (first exprs) try-exprs)
+                   catch-exprs
+                   finally-exprs
+                   (rest exprs)))))))
+
+(defn compile-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 compile-apply
+  [form]
+  (compile
+    (list '.
+          (first form)
+          'apply
+          (first form)
+          (second form))))
+
+(defn compile-new
+  "(new Classname args*)
+  Compiles new special form. The args, if any, are evaluated
+  from left to right, and passed to the constructor of the
+  class named by Classname. The constructed object is returned."
+  ; {:added "1.0", :special-form true, :forms '[(new Classname args*)]}
+  [form]
+  (compile-template (list "new ~{}" (compile form))))
+
+(defn compile-compound-accessor
+  "Compiles compound property accessor"
+  [form]
+  (let [target (macroexpand (first form))
+        attribute (macroexpand (second form))
+        template (if (list? target) "(~{})[~{}]" "~{}[~{}]")]
+    (compile-template
+     (list template (compile target) (compile attribute)))))
+
+(defn compile-instance
+  "Evaluates x and tests if it is an instance of the class
+  c. Returns true or false"
+  [form]
+  (compile-template (list "~{} instanceof ~{}"
+                          (compile (macroexpand (second form)))
+                          (compile (macroexpand (first form))))))
+
+
+(defn compile-not
+  "Returns true if x is logical false, false otherwise."
+  [form]
+  (compile-template (list "!(~{})" (compile (macroexpand (first form))))))
+
+
+(defn compile-loop
+  "Evaluates the body in a lexical context in which the symbols
+  in the binding-forms are bound to their respective
+  initial-expressions or parts therein. Acts as a recur target."
+  [form]
+  (let [bindings (loop [names []
+                        values []
+                        tokens (first form)]
+                  (if (empty? tokens)
+                    {:names names :values values}
+                    (recur (conj names (first tokens))
+                           (conj values (second tokens))
+                           (rest (rest tokens)))))
+        names (:names bindings)
+        values (:values bindings)
+        body (rest form)]
+    ;; `((fn loop []
+    ;;    ~@(define-bindings bindings)
+    ;;    ~@(compile-recur body names)))
+    (compile
+      (cons (cons 'fn
+              (cons 'loop
+                (cons names
+                  (compile-recur names body))))
+            (apply list values)))))
+
+(defn rebind-bindings
+  "Rebinds given bindings to a given names in a form of
+  (set! foo bar) expressions"
+  [names values]
+  (loop [result '()
+         names names
+         values values]
+    (if (empty? names)
+      (reverse result)
+      (recur
+       (cons (list 'set! (first names) (first values)) result)
+       (rest names)
+       (rest values)))))
+
+(defn expand-recur
+  "Expands recur special form into params rebinding"
+  [names body]
+  (map (fn [form]
+         (if (list? form)
+           (if (= (first form) 'recur)
+             (list 'raw*
+                   (compile-group
+                    (concat
+                      (rebind-bindings names (rest form))
+                      (list 'loop))
+                    true))
+             (expand-recur names form))
+           form))
+        body))
+
+(defn compile-recur
+  "Eliminates tail calls in form of recur and rebinds the bindings
+  of the recursion point to the parameters of the recur"
+  [names body]
+  (list
+    (list 'raw*
+          (compile-template
+          (list "var recur = loop;\nwhile (recur === loop) {\n  recur = ~{}\n}"
+                (compile-statements (expand-recur names body)))))
+    'recur))
+
+(defn compile-raw
+  "returns form back since it's already compiled"
+  [form]
+  (first form))
+
+(install-special 'set! compile-set)
+(install-special 'get compile-compound-accessor)
+(install-special 'aget compile-compound-accessor)
+(install-special 'def compile-def)
+(install-special 'if compile-if-else)
+(install-special 'do compile-do)
+(install-special 'do* compile-statements)
+(install-special 'fn compile-fn)
+(install-special 'throw compile-throw)
+(install-special 'vector compile-vector)
+(install-special 'try compile-try)
+(install-special '. compile-property)
+(install-special 'apply compile-apply)
+(install-special 'new compile-new)
+(install-special 'instance? compile-instance)
+(install-special 'not compile-not)
+(install-special 'loop compile-loop)
+(install-special 'raw* compile-raw)
+(install-special 'comment compile-comment)
+
+
+(defn compile-keyword [form] (str "\"" "\uA789" (name form) "\""))
+(defn compile-symbol [form]
+  (compile (list 'symbol (namespace form) (name form))))
+(defn compile-nil [form] "void(0)")
+(defn compile-number [form] form)
+(defn compile-boolean [form] (if (true? form) "true" "false"))
+(defn compile-string
+  [form]
+  (set! form (replace form (RegExp "\\\\" "g") "\\\\"))
+  (set! form (replace form (RegExp "\n" "g") "\\n"))
+  (set! form (replace form (RegExp "\r" "g") "\\r"))
+  (set! form (replace form (RegExp "\t" "g") "\\t"))
+  (set! form (replace form (RegExp "\"" "g") "\\\""))
+  (str "\"" form "\""))
+
+(defn compile-re-pattern
+  [form]
+  (str form))
+
+(defn install-native
+  "Creates an adapter for native operator"
+  [alias operator validator fallback]
+  (install-special
+   alias
+   (fn [form]
+    (if (empty? form)
+      fallback
+      (reduce
+        (fn [left right]
+          (compile-template
+            (list "~{} ~{} ~{}"
+                  left
+                  (name operator)
+                  right)))
+        (map (fn [operand]
+              (compile-template
+                (list (if (list? operand) "(~{})" "~{}")
+                  (compile (macroexpand operand)))))
+             form))))
+    validator))
+
+(defn install-operator
+  "Creates an adapter for native operator that does comparison in
+  monotonical order"
+  [alias operator]
+  (install-special
+   alias
+   (fn [form]
+    (loop [result ""
+           left (first form)
+           right (second form)
+           operands (rest (rest form))]
+      (if (empty? operands)
+        (str result
+             (compile-template (list "~{} ~{} ~{}"
+                                     (compile (macroexpand left))
+                                     (name operator)
+                                     (compile (macroexpand right)))))
+        (recur
+          (str result
+              (compile-template (list "~{} ~{} ~{} && "
+                                      (compile (macroexpand left))
+                                      (name operator)
+                                      (compile (macroexpand right)))))
+          right
+          (first operands)
+          (rest operands)))))
+   verify-two))
+
+
+(defn compiler-error
+  [form message]
+  (let [error (Error (str message))]
+    (set! error.line 1)
+    (throw error)))
+
+
+(defn verify-two
+  [form]
+  (if (or (empty? (rest form))
+          (empty? (rest (rest form))))
+    (throw
+      (compiler-error
+        form
+        (str (first form) " form requires at least two operands")))))
+
+;; Arithmetic Operators
+(install-native '+ '+ nil 0)
+(install-native '- '- nil "NaN")
+(install-native '* '* nil 1)
+(install-native '/ '/ verify-two)
+(install-native 'mod (symbol "%") verify-two)
+
+;; Logical Operators
+(install-native 'and '&&)
+(install-native 'or '||)
+
+;; Comparison Operators
+
+(install-operator 'not= '!=)
+(install-operator '== '===)
+(install-operator 'identical? '===)
+(install-operator '> '>)
+(install-operator '>= '>=)
+(install-operator '< '<)
+(install-operator '<= '<=)
+
+;; Bitwise Operators
+
+(install-native 'bit-and '& verify-two)
+(install-native 'bit-or '| verify-two)
+(install-native 'bit-xor (symbol "^"))
+(install-native 'bit-not (symbol "~") verify-two)
+(install-native 'bit-shift-left '<< verify-two)
+(install-native 'bit-shift-right '>> verify-two)
+(install-native 'bit-shift-right-zero-fil '>>> verify-two)
+
+
+(install-macro
+ 'str
+ (fn str
+   "str inlining and optimization via macros"
+   [& forms]
+   `(+ "" ~@forms)))
+
+(install-macro
+  'let
+  (fn let-macro
+    "Evaluates the exprs in a lexical context in which the symbols in
+    the binding-forms are bound to their respective init-exprs or parts
+    therein."
+    {:added "1.0" :special-form true :forms '[(let [bindings*] exprs*)]}
+    [bindings & body]
+    ;; TODO: Implement destructure for bindings:
+    ;; https://github.com/clojure/clojure/blob/master/src/clj/clojure/core.clj#L3937
+    ;; Consider making let a macro:
+    ;; https://github.com/clojure/clojure/blob/master/src/clj/clojure/core.clj#L3999
+    (cons 'do
+      (concat (define-bindings bindings) body))))
+
+(install-macro
+ 'cond
+ (fn cond
+   "Takes a set of test/expr pairs. It evaluates each test one at a
+   time.  If a test returns logical true, cond evaluates and returns
+   the value of the corresponding expr and doesn't evaluate any of the
+   other tests or exprs. (cond) returns nil."
+   {:added "1.0"}
+   [& clauses]
+   (if (not (empty? clauses))
+     (list 'if (first clauses)
+           (if (empty? (rest clauses))
+             (throw (Error "cond requires an even number of forms"))
+             (second clauses))
+           (cons 'cond (rest (rest clauses)))))))
+
+(install-macro
+ 'defn
+ (fn defn
+   "Same as (def name (fn [params* ] exprs*)) or
+   (def name (fn ([params* ] exprs*)+)) with any doc-string or attrs added
+   to the var metadata"
+   {:added "1.0" :special-form true }
+   [name & body]
+   `(def ~name (fn ~name ~@body))))
+
+(install-macro
+ 'defn-
+ (fn defn
+   "Same as (def name (fn [params* ] exprs*)) or
+   (def name (fn ([params* ] exprs*)+)) with any doc-string or attrs added
+   to the var metadata"
+   {:added "1.0" :special-form true }
+   [name & body]
+   `(defn ~(with-meta name (conj {:private true} (meta name))) ~@body)))
+
+(install-macro
+ 'assert
+ (fn assert
+   "Evaluates expr and throws an exception if it does not evaluate to
+   logical true."
+   {:added "1.0"}
+   [x message]
+   (let [title (or message "")
+         assertion (pr-str x)
+         uri (:uri x)
+         form (if (list? x) (second x) x)]
+     `(do
+        (if (and (not (identical? (typeof **verbose**) "undefined"))
+                 **verbose**)
+          (.log console "Assert:" ~assertion))
+        (if (not ~x)
+          (throw (Error. (str "Assert failed: "
+                              ~title
+                              "\n\nAssertion:\n\n"
+                              ~assertion
+                              "\n\nActual:\n\n"
+                              ~form
+                              "\n--------------\n")
+                         ~uri)))))))
+
+(install-macro
+ 'import
+ (fn
+   "Helper macro for importing node modules"
+   [imports path]
+   (if (nil? path)
+     `(require ~imports)
+     (if (symbol? imports)
+       `(def ~(with-meta imports {:private true}) (require ~path))
+       (loop [form '() names imports]
+         (if (empty? names)
+           `(do* ~@form)
+           (let [alias (first names)
+                 id (symbol (str ".-" (name alias)))]
+             (recur (cons `(def ~(with-meta alias {:private true})
+                             (~id (require ~path))) form)
+                    (rest names)))))))))