ruby-wisp-source 0.7.0

data/vendor/src/drafts/drafts.wisp

@@ -0,0 +1,50 @@
+(defn ^boolean =
+  "Equality. Returns true if x equals y, false if not. Compares
+  numbers and collections in a type-independent manner. Clojure's
+  immutable data structures define -equiv (and thus =) as a value,
+  not an identity, comparison."
+  ([x] true)
+  ([x y] (cond (identical? x y) true
+               ;; exit early for unlike primitive values
+               (and (identical? a a)
+                    (or (not y) 
+                        (and (not (identical? (typeof x) "function"))
+                             (not (identical? (typeof x) "object"))))
+                    (or (not x) 
+                        (and (not (identical? (typeof y) "function"))
+                             (not (identical? (typeof y) "object"))))) false
+               ;; exit early for `null` and `undefined`, avoiding ES3's
+               ;; Function#call behavior
+               (or (identical? x null)
+                   (identical? x undefined)) (or (identical? y undefined)
+                                                 (identical? y null))
+               (or (identical? y null)
+                   (identical? y undefined)) (or (identical? x undefined)
+                                                 (identical? x null))
+
+               :else (let [class-x (classof x)
+                           class-y (classof y)]
+                       (cond (not (identical? class-x class-y)) false
+                             (or (identical? class-x class-boolean)
+                                 (identical? class-x class-date))
+                               (identical? (+ x 0)
+                                           (+ y 0))
+                             (identical? class-x class-number)
+                               (if (not (identical? x (+ x 0)))
+                                 (not (identical? y (+ y 0)))
+                                 (if (identical? x 0)
+                                   (identical? (/ 1 x) (/ 1 y))
+                                   (identical? x (+ y 0))))
+                             (or (identical? class-x class-regex)
+                                 (identical? class-x class-string))
+                               (identical? x (+ y ""))
+                             (identical? class-x class-array)
+
+                             ))))
+
+  ([x & more] (loop [head x
+                     tail more]
+                  (if (= head (first tail))
+                    (recur head (rest tail))
+                    false))))
+

data/vendor/src/drafts/drft.wisp

@@ -0,0 +1,329 @@
+
+(defn ^boolean self-evaluating?
+  "Returns true if form is self evaluating"
+  [form]
+  (or (number? form)
+      (and (string? form)
+           (not (symbol? form))
+           (not (keyword? form)))
+      (boolean? form)
+      (nil? form)
+      (re-pattern? form)))
+
+
+;; special forms
+;;
+;; special forms are like macros for generating source code. It allows the
+;; generator to customize how certain forms look in the final output.
+;; these could have been macros that expand into basic forms, but we
+;; want readable output. Special forms are responsible for integrity
+;; checking of the form.
+
+(def **specials** {})
+
+(defn install-special
+  "Installs special function"
+  [name f validator]
+  (set! (get **specials** name)
+        (fn [form]
+          (if validator (validator form))
+          (f (with-meta (rest form) (meta form))))))
+
+(defn special?
+  "Returns true if special form"
+  [name]
+  (and (symbol? name)
+       (get **specials** name)
+       true))
+
+(defn execute-special
+  "Expands special form"
+  [name form]
+  ((get **specials** name) form))
+
+
+(defn opt [argument fallback]
+  (if (or (nil? argument) (empty? argument)) fallback (first argument)))
+
+;; compiler
+
+
+(defn compile-object
+  ""
+  [form quoted?]
+  ;; TODO: Add regexp to the list.
+  (cond
+    (keyword? form) (write-keyword form)
+    (symbol? form) (compile-symbol form)
+    (number? form) (compile-number form)
+    (string? form) (compile-string form)
+    (boolean? form) (compile-boolean form)
+    (nil? form) (compile-nil form)
+    (re-pattern? form) (compile-re-pattern form)
+    (vector? form) (compile (apply-form 'vector
+                                        (apply list form)
+                                        quoted?))
+    (list? form) (compile (apply-form 'list
+                                      form
+                                      quoted?))
+    (dictionary? form) (compile-dictionary
+                        (if quoted?
+                          (map-dictionary form (fn [x] (list 'quote x)))
+                          form))))
+
+
+    
+    ;; **macros** ->  __macros__
+    (set! id (join "_" (split id "*")))
+    ;; list->vector ->  listToVector
+    (set! id (join "-to-" (split id "->")))
+    ;; set! ->  set
+    (set! id (join (split id "!")))
+    (set! id (join "$" (split id "%")))
+    ;; foo= -> fooEqual
+    ;(set! id (join "-equal-" (split id "="))
+    ;; foo+bar -> fooPlusBar
+    (set! id (join "-plus-" (split id "+")))
+    (set! id (join "-and-" (split id "&")))
+    ;; number? -> isNumber
+    (set! id (if (identical? (last id) "?")
+               (str "is-" (subs id 0 (dec (count id))))
+               id))
+    ;; create-server -> createServer
+    (set! id (reduce
+              (fn [result key]
+                (str result
+                     (if (and (not (empty? result))
+                              (not (empty? key)))
+                       (str (upper-case (get key 0)) (subs key 1))
+                       key)))
+              ""
+              (split id "-")))
+    id))
+
+(defn write-keyword-reference
+  [form]
+  (str "\"" (name form) "\""))
+
+
+
+
+
+;; backend specific compiler hooks
+
+(defn write-template
+  "Compiles given template"
+  [& form]
+  (let [indent-pattern #"\n *$"
+        line-break-patter (RegExp "\n" "g")
+        get-indentation (fn [code] (or (re-find indent-pattern code) "\n"))]
+    (loop [code ""
+           parts (split (first form) "~{}")
+           values (rest form)]
+      (if (> (count parts) 1)
+        (recur
+         (str
+          code
+          (first parts)
+          (replace (str "" (first values))
+                    line-break-patter
+                    (get-indentation (first parts))))
+         (rest parts)
+         (rest values))
+         (str code (first parts))))))
+
+(defn write-comment
+  [form]
+  (write-template "//~{}\n" form))
+
+(defn write-def
+  "Creates and interns or locates a global var with the name of symbol
+  and a namespace of the value of the current namespace (*ns*). If init
+  is supplied, it is evaluated, and the root binding of the var is set
+  to the resulting value. If init is not supplied, the root binding of
+  the var is unaffected. def always applies to the root binding, even if
+  the var is thread-bound at the point where def is called. def yields
+  the var itself (not its value)."
+  [id init]
+  (write-template "var ~{} = ~{}"
+                  (write id)
+                  (write init)))
+
+(defn write-if
+  "Evaluates test. If not the singular values nil or false,
+  evaluates and yields then, otherwise, evaluates and yields else.
+  If else is not supplied it defaults to nil. All of the other
+  conditionals in Clojure are based upon the same logic, that is,
+  nil and false constitute logical falsity, and everything else
+  constitutes logical truth, and those meanings apply throughout."
+  [condition then-expression else-expression]
+  (write-template
+   (if (and (list? else-expression)
+            (= (first else-expression) 'if))
+     "~{} ?\n  ~{} :\n~{}"
+     "~{} ?\n  ~{} :\n  ~{}")
+   (write condition)
+   (write then-expression)
+   (write else-expression)))
+
+(defn write-dictionary
+  "Compiles dictionary to JS object"
+  [form]
+  (let [body
+        (loop [body nil
+               names (keys form)]
+          (if (empty? names)
+            body
+            (recur
+             (str
+              (if (nil? body) "" (str body ",\n"))
+              (compile-template
+               (list
+                "~{}: ~{}"
+                (compile (first names))
+                (compile (macroexpand
+                          (get form (first names)))))))
+             (rest names))))
+        ]
+      (if (nil? body) "{}" (compile-template (list "{\n  ~{}\n}" body)))))
+
+
+;; Function parser / compiler
+
+
+(defn write-fn-body
+  [form params]
+  (if (and (dictionary? params) (:rest params))
+    (write-statements
+      (cons (list 'def
+                  (:rest params)
+                  (list
+                    'Array.prototype.slice.call
+                    'arguments
+                    (:arity params)))
+      form)
+      "return ")
+
+    ;; Optimize functions who's body only contains `let` form to avoid
+    ;; function call overhead.
+    (if (and (identical? (count form) 1)
+             (list? (first form))
+             (= (first (first form)) 'do))
+      (write-fn-body (rest (first form)) params)
+      (write-statements form "return "))))
+
+(defn write-fn
+  ;"(fn name? [params* ] exprs*)
+  ;Defines a function (fn)"
+  [name doc attrs params body]
+  (if (nil? name)
+    (compile-template "function(~{}) {\n  ~{}\n}"
+                      (join ", " (map write (:names params)))
+                      (write-fn-body body params))
+    (compile-template "function ~{}(~{}) {\n  ~{}\n}"
+                      (write name)
+                      (join ", " (map write (:names params)))
+                      (write-fn-body body params))))
+
+(defn write-statements
+  [form prefix]
+  (loop [result ""
+         expression (first form)
+         expressions (rest form)]
+    (if (empty? expressions)
+      (str result
+           (if (nil? prefix) "" prefix)
+           (compile (macroexpand expression))
+           ";")
+      (recur
+        (str result (compile (macroexpand expression)) ";\n")
+        (first expressions)
+        (rest expressions)))))
+
+(defn write-invoke
+  [callee & params]
+  (write-template
+   ;; Wrap functions returned by expressions into parenthesis.
+   (if (list? callee) "(~{})(~{})" "~{}(~{})")
+   (write callee)
+   (write-group params)))
+
+(defn write-group
+  [form wrap]
+  (if wrap
+    (str "(" (write-group form) ")")
+    (join ", " (vec (map write form)))))
+
+(defn write-throw
+  "The expression is evaluated and thrown, therefore it should yield an error."
+  [form]
+  (write-template "(function() { throw ~{}; })()" (write form))
+
+(defn write-set!
+  [variable value]
+  (write-template "~{} = ~{}"
+                  (write variale)
+                  (write value)))
+
+(defn compile-vector
+  [form]
+  (write-template (list "[~{}]" (write-group form))))
+
+
+(defn write-try
+  "The exprs are evaluated and, if no exceptions occur, the value
+  of the last is returned. If an exception occurs and catch clauses
+  are provided, its exprs are evaluated in a context in which name is
+  bound to the thrown exception, and the value of the last is the return
+  value of the function. If there is no matching catch clause, the exception
+  propagates out of the function. Before returning, normally or abnormally,
+  any finally exprs will be evaluated for their side effects."
+  [try-exprs catch-exprs finally-exprs]
+  (if (empty? catch-exprs)
+    (write-template
+     "(function() {\ntry {\n  ~{}\n} finally {\n  ~{}\n}})()"
+     (write-fn-body try-exprs)
+     (write-fn-body finally-exprs))
+    (if (empty? finally-exprs)
+      (write-template
+       "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n}})()"
+       (write-fn-body try-exprs)
+       (write (first catch-exprs))
+       (write-fn-body (rest catch-exprs)))
+      (compile-template
+       "(function() {\ntry {\n  ~{}\n} catch (~{}) {\n  ~{}\n} finally {\n  ~{}\n}})()"
+       (write-fn-body try-exprs)
+       (write (first catch-exprs))
+       (write-fn-body (rest catch-exprs))
+       (write-fn-body finally-exprs)))))
+
+(defn write-property
+  "(. object method arg1 arg2)
+
+  The '.' special form that can be considered to be a method call,
+  operator"
+  [form]
+  ;; (. object method arg1 arg2) -> (object.method arg1 arg2)
+  ;; (. object -property) -> object.property
+  (if (identical? (aget (name (second form)) 0) "-")
+    (compile-template
+      (list (if (list? (first form)) "(~{}).~{}" "~{}.~{}")
+            (compile (macroexpand (first form)))
+            (compile (macroexpand (symbol (subs (name (second form)) 1))))))
+    (compile-template
+      (list "~{}.~{}(~{})"
+            (compile (macroexpand (first form)))    ;; object name
+            (compile (macroexpand (second form)))   ;; method name
+            (compile-group (rest (rest form)))))))  ;; args
+
+(defn write-new
+  [form]
+  (write-template "new ~{}" (write form)))
+
+(defn write-accessor
+  "Compiles compound property accessor"
+  [compound target attribute]
+  (compile-template
+   (if compound "(~{})[~{}]" "~{}[~{}]")
+   target
+   attribute))

data/vendor/src/drafts/extra.wisp

@@ -0,0 +1,36 @@
+(import [conj take drop concat] "./sequence")
+
+(defn range 
+  "Returns a lazy seq of nums from start (inclusive) to end
+  (exclusive), by step, where start defaults to 0, step to 1, and end
+  to infinity."
+  {:added "1.0"
+   :static true}
+  ([end] (range 0 end 1))
+  ([start end] (range start end 1))
+  ([start end step]
+   (loop [result []
+          position start]
+     (if (<= end position)
+       result
+       (recur (conj result position)
+              (+ position step))))))
+
+(defn partition
+  "Returns a lazy sequence of lists of n items each, at offsets step
+  apart. If step is not supplied, defaults to n, i.e. the partitions
+  do not overlap. If a pad collection is supplied, use its elements as
+  necessary to complete last partition upto n items. In case there are
+  not enough padding elements, return a partition with less than n items."
+  ([n coll]
+     (partition n n coll))
+  ([n step coll]
+     (loop [result []
+            items coll]
+       (let [group (take n items)]
+         (if (= n (count group))
+           (recur (conj result group)
+                  (drop step items))
+           result))))
+  ([n step pad coll]
+   (partition n step (concat coll pad))))

data/vendor/src/engine/browser.wisp

@@ -0,0 +1,67 @@
+(ns wisp.engine.browser
+  (:use [wisp.runtime :only [str]]
+        [wisp.sequence :only [rest]]
+        [wisp.reader :only [read-from-string]]
+        [wisp.compiler :only [compile*]]))
+
+(defn evaluate
+  [code url] (eval (compile* (read* code url))))
+
+;; Running code does not provide access to this scope.
+(defn run
+  [code url]
+  ((Function (compile* (read* code url)))))
+
+;; If we're not in a browser environment, we're finished with the public API.
+;; return unless window?
+;;
+;; Load a remote script from the current domain via XHR.
+(defn load
+  [url callback]
+  (def request
+    (if window.XMLHttpRequest
+      (XMLHttpRequest.)
+      (ActiveXObject. "Microsoft.XMLHTTP")))
+
+  (.open request :GET url true)
+
+  (if request.override-mime-type
+    (.override-mime-type request "application/wisp"))
+
+  (set! request.onreadystatechange
+        (fn []
+          (if (identical? request.ready-state 4)
+            (if (or (identical? request.status 0)
+                    (identical? request.status 200))
+              (callback (run request.response-text url))
+              (callback "Could not load")))))
+
+  (.send request null))
+
+;; Activate LispyScript in the browser by having it compile and evaluate
+;; all script tags with a content-type of `application/wisp`.
+;; This happens on page load.
+(defn run-scripts
+  "Compiles and exectues all scripts that have type application/wisp type"
+  []
+  (def scripts
+    (Array.prototype.filter.call
+     (document.get-elements-by-tag-name :script)
+     (fn [script] (identical? script.type "application/wisp"))))
+
+  (defn next []
+    (if scripts.length
+      (let [script (.shift scripts)]
+        (if script.src
+          (load script.src next)
+          (next (run script.innerHTML))))))
+
+  (next))
+
+;; Listen for window load, both in browsers and in IE.
+(if (or (identical? document.ready-state :complete)
+        (identical? document.ready-state :interactive))
+  (run-scripts)
+  (if window.add-event-listener
+    (.add-event-listener window :DOMContentLoaded run-scripts false)
+    (.attach-event window :onload run-scripts)))

data/vendor/src/engine/node.wisp

@@ -0,0 +1,16 @@
+(ns wisp.engine.node
+  (:use [fs :only [read-file-sync]]
+        [wisp.sequence :only [rest]]
+        [wisp.runtime :only [str]]
+        [wisp.reader :only [read*]]
+        [wisp.compiler :only [compile*]]))
+
+(set! global.**verbose** (<= 0 (.indexOf process.argv :--verbose)))
+
+;; Register `.wisp` file extension so that
+;; modules can be simply required.
+(set! (get require.extensions ".wisp")
+  (fn [module uri]
+    (._compile module
+               (compile* (read* (read-file-sync uri :utf8) uri)))))
+

data/vendor/src/functional-reader.wisp

@@ -0,0 +1,96 @@
+(ns wisp.reader
+  "Reader module provides functions for reading text input
+  as wisp data structures")
+
+(defn char-stream [source uri]
+  {:lines (split source "\n")
+   :uri uri
+   :line 0
+   :column 0})
+
+(defn first [beffer]
+  (get (get (:lines buffer) (:line buffer)) (:column buffer)))
+
+(defn second [buffer]
+  (let [line-position (:line buffer)
+        column-position (:column buffer)
+        lines (:lines buffer)
+        line (get lines line-position)]
+    (if (> (count line) (inc column-position))
+      (get line column-position)
+      (get (get lines (inc line-position)) 0))))
+
+(defn rest [buffer]
+  (let [line-position (:line buffer)
+        column-position (:column buffer)
+        lines (:lines buffer)
+        line (get lines line-position)]
+    (if (> (count line) (inc column-position))
+      {:lines lines
+      :uri (:uri source)
+      :line line-position
+      :column (inc column-position)}
+      (if (> (count lines) line-position)
+        {:lines lines
+        :uri (:uri source)
+        :line (inc line-position)
+        :column 0}))))
+
+(defn ^boolean number-literal?
+  "Checks whether the reader is at the start of a number literal"
+  [buffer]
+  (let [ch (first buffer)]
+        (or (numeric? ch)
+            (and (or (identical? \+ ch)
+                     (identical? \- ch))
+                 (numeric? (second buffer))))))
+
+(defn read-number
+  [buffer]
+  (loop [buffer buffer
+         result ""
+         ch (first buffer)]
+
+    (if (or (nil? ch)
+            (whitespace? ch)
+            (macros ch))
+      (if (nil? match (match-number result))
+        (reader-error buffer "Invalid number format [" result "]")
+        match)
+      (recur (rest buffer)
+             (str result ch)
+             (first buffer)))))
+
+
+
+(defn read-symbol
+  [source]
+  (let [chunk (read-token source)
+        token (first chunk)
+        buffer (rest chunk)]
+
+    (if (contains? token "/") 0
+      (symbol (substr token 0 (index-of token "/"))
+              (substr token (inc (index-of token "/")) (count token)))
+      (special-symbols token (symbol token)))))
+
+
+
+(defn read [source uri]
+  (loop [buffer (char-stream source uri)]
+    (let [ch (first buffer)]
+      (cond
+       (nil? ch) (if eof-is-error (reader-error reader "EOF") sentinel)
+       (whitespace? ch) (recur (rest buffer))
+       (comment-prefix? ch) (read (read-comment buffer)
+                                  eof-is-error
+                                  sentinel
+                                  is-recursive)
+       :else (let [f (macros ch)
+                   form (cond
+                        f (f buffer)
+                        (number-literal? buffer) (read-number buffer)
+                        :else (read-symbol buffer))]
+               (if (identical? form buffer)
+                 (recur buffer)
+                 form))))))