Merge pull request #253 from truecolour/better-stdlib

Various additions to the standard libraries

Author: halgari

pixie/stdlib.pxi

@@ -164,6 +164,32 @@
 (def reduce (fn [rf init col]
               (-reduce col rf init)))
 
+(def instance? (fn ^{:doc "Checks if x is an instance of t.
+
+                           When t is seqable, checks if x is an instance of
+                           any of the types contained therein."
+                     :signatures [[t x]]}
+                 instance? [t x]
+                 (if (-satisfies? ISeqable t)
+                   (let [ts (seq t)]
+                     (if (not ts) false
+                       (or (-instance? (first ts) x)
+                           (instance? (rest ts) x))))
+                   (-instance? t x))))
+
+(def satisfies? (fn ^{:doc "Checks if x satisfies the protocol p.
+
+                            When p is seqable, checks if x satisfies all of
+                            the protocols contained therein."
+                      :signatures [[t x]]}
+                  satisfies? [p x]
+                  (if (-satisfies? ISeqable p)
+                    (let [ps (seq p)]
+                      (if (not ps) true
+                        (and (-satisfies? (first ps) x)
+                             (satisfies? (rest ps) x))))
+                    (-satisfies? p x))))
+
 (def into (fn ^{:doc "Add the elements of `from` to the collection `to`."
                 :signatures [[to from]]
                 :added "0.1"}
@@ -751,7 +777,6 @@ there's a value associated with the key. Use `some` for checking for values."
          ~then
          (cond ~@clauses))))
 
-
 (defmacro try [& body]
   (loop [catch nil
          catch-sym nil
@@ -802,7 +827,7 @@ If further arguments are passed, invokes the method named by symbol, passing the
 (defn string? [v] (instance? String v))
 (defn keyword? [v] (instance? Keyword v))
 
-(defn list? [v] (instance? PersistentList v))
+(defn list? [v] (instance? [PersistentList Cons] v))
 (defn set? [v] (instance? PersistentHashSet v))
 (defn map? [v] (satisfies? IMap v))
 (defn fn? [v] (satisfies? IFn v))
@@ -861,17 +886,21 @@ If further arguments are passed, invokes the method named by symbol, passing the
       ([x y] (not (f x y)))
       ([x y & more] (not (apply f x y more))))))
 
-(defn some
-  {:doc "Checks if the predicate is true for any element of the collection.
+(defn constantly [x]
+  {:doc "Return a function that always returns x, no matter what it is called with."
+   :examples [["(let [f (constantly :me)] [(f 1) (f \"foo\") (f :abc) (f nil)])"
+               nil [:me :me :me :me]]]}
+  (fn [& _] x))
 
-Stops if it finds such an element."
+(defn some
+  {:doc "Returns the first true value of the predicate for the elements of the collection."
    :signatures [[pred coll]]
    :added "0.1"}
   [pred coll]
-  (cond
-   (nil? (seq coll)) false
-   (pred (first coll)) true
-   :else (recur pred (next coll))))
+  (if-let [coll (seq coll)]
+    (or (pred (first coll))
+        (recur pred (next coll)))
+    false))
 
 (extend -count MapEntry (fn [self] 2))
 (extend -nth MapEntry (fn map-entry-nth [self idx]
@@ -1053,7 +1082,7 @@ Creates new maps if the keys are not present."
   ([test msg]
      `(if ~test
         nil
-        (throw (str "Assert failed " ~msg)))))
+        (throw (str "Assert failed: " ~msg)))))
 
 (defmacro resolve
   {:doc "Resolve the var associated with the symbol in the current namespace."
@@ -1243,6 +1272,17 @@ and implements IAssociative, ILookup and IObject."
   ([n x]
      (take n (repeat x))))
 
+(defn repeatedly
+  {:doc "Returns a lazy seq that contains the return values of repeated calls to f.
+
+        Yields an infinite seq with one argument.
+        With two arguments n specifies the number of elements."
+   :examples [["(into '(:batman!) (repeatedly 8 (fn [] :na)))"
+               nil (:na :na :na :na :na :na :na :na :batman!)]]
+   :signatures [[f] [n f]]}
+  ([f] (lazy-seq (cons (f) (repeatedly f))))
+  ([n f] (take n (repeatedly f))))
+
 (defmacro doseq
   {:doc "Evaluates all elements of the seq, presumably for side effects. Returns nil."
    :added "0.1"}
@@ -1476,6 +1516,13 @@ The new value is thus `(apply f current-value-of-atom args)`."
       (recur (dec n) (next s))
       s)))
 
+(defn split-at
+  {:doc "Returns a vector of the first n elements of the collection, and the remaining elements."
+   :examples [["(split-at 2 [:a :b :c :d :e])" nil
+               [(:a :b) (:c :d :e)]]]}
+  [n coll]
+  [(take n coll) (drop n coll)])
+
 (defmacro while
   {:doc "Repeatedly executes body while test expression is true. Presumes
   some side-effect will cause test to become false/nil. Returns nil"
@@ -1568,8 +1615,21 @@ not enough elements were present."
    :added "0.1"}
   ([n coll] (partition n n coll))
   ([n step coll]
-     (when-let [s (seq coll)]
-       (cons (take n s) (partition n step (drop step s))))))
+   (when-let [s (seq coll)]
+     (lazy-seq
+       (cons (take n s) (partition n step (drop step s)))))))
+
+(defn partitionf [f coll]
+  {:doc "A generalized version of partition. Instead of taking a constant number of elements,
+         this function calls f with the remaining collection to determine how many elements to
+         take."
+   :examples [["(partitionf first [1 :a, 2 :a b, 3 :a :b :c])"
+               nil ((1 :a) (2 :a :b) (3 :a :b :c))]]}
+  (when-let [s (seq coll)]
+    (lazy-seq
+      (let [n (f s)]
+        (cons (take n s)
+              (partitionf f (drop n coll)))))))
 
 (defn destructure [binding expr]
   (cond
@@ -1942,6 +2002,9 @@ user => (refer 'pixie.string :exclude '(substring))"
    (pred (first coll)) (recur pred (next coll))
    :else false))
 
+; If you want a fn that uses destructuring in its parameter list, place
+; it after this definition. If you don't, you will get compile failures
+; in unrelated files.
 (defmacro fn
   {:doc "Creates a function.
 
@@ -2115,6 +2178,45 @@ Expands to calls to `extend-type`."
                         [~@body])))]
     `(or (seq ~(gen-loop [] bindings)) '())))
 
+(defn reverse
+  ; TODO: We should probably have a protocol IReversible, so we can e.g.
+  ;       reverse vectors efficiently, etc..
+  [coll]
+  "Returns a collection that contains all the elements of the argument in reverse order."
+  (into () coll))
+
+;; TODO: implement :>> like in Clojure?
+(defmacro condp
+  "Takes a binary predicate, an expression and a number of two-form clauses.
+  Calls the predicate on the first value of each clause and the expression.
+  If the result is truthy returns the second value of the clause.
+
+  If the number of arguments is odd and no clause matches, the last argument is returned.
+  If the number of arguments is even and no clause matches, throws an exception."
+  [pred-form expr & clauses]
+  (let [x (gensym 'expr), pred (gensym 'pred)]
+    `(let [~x ~expr, ~pred ~pred-form]
+       (cond ~@(mapcat
+                 (fn [[a b :as clause]]
+                   (if (> (count clause) 1)
+                     `((~pred ~a ~x) ~b)
+                     `(:else ~a)))
+                 (partition 2 clauses))
+             :else (throw "No matching clause!")))))
+
+(defmacro case
+  "Takes an expression and a number of two-form clauses.
+  Checks for each clause if the first part is equal to the expression.
+  If yes, returns the value of the second part.
+
+  The first part of each clause can also be a set. If that is the case, the clause matches when the result of the expression is in the set.
+
+  If the number of arguments is odd and no clause matches, the last argument is returned.
+  If the number of arguments is even and no clause matches, throws an exception."
+  [expr & args]
+  `(condp #(if (set? %1) (%1 %2) (= %1 %2))
+     ~expr ~@args))
+
 (defmacro use
   [ns]
   `(do
@@ -2176,14 +2278,47 @@ Expands to calls to `extend-type`."
                     (mapcat walk (children node))))))]
     (walk root)))
 
+(defn flatten [x]
+  ; TODO: laziness?
+  {:doc "Takes any nested combination of ISeqable things, and return their contents
+        as a single, flat sequence.
+
+        Calling this function on something that is not ISeqable returns a seq with that
+        value as its only element."
+   :examples [["(flatten [[1 2 [3 4] [5 6]] 7])" nil [1 2 3 4 5 6 7]]
+              ["(flatten :this)" nil [:this]]]}
+  (if (not (satisfies? ISeqable x)) [x]
+    (transduce (comp (map flatten) cat)
+               conj []
+               (seq x))))
+
+(defn juxt [& fns]
+  {:doc "Returns a function that applies all fns to its arguments,
+         and returns a vector of the results."
+   :examples [["((juxt + - *) 2 3)" nil [5 -1 6]]]}
+  (fn [& args]
+    (mapv #(apply % args) fns)))
+
+(defn map-invert
+  {:doc "Returns a map where the vals are mapped to the keys."
+   :examples [["(map-invert {:a :b, :c :d})" nil {:b :a, :d :c}]]}
+  [m]
+  (reduce (fn [m* ent]
+            (assoc m* (val ent) (key ent)))
+          {} m))
+
 (defn mapv
   ([f col]
    (transduce (map f) conj col)))
 
+(def *1)
+(def *2)
+(def *3)
 (defn -push-history [x]
   (def *3 *2)
   (def *2 *1)
   (def *1 x))
 
+(def *e)
 (defn -set-*e [e]
   (def *e e))

pixie/string.pxi

@@ -3,7 +3,7 @@
 
 ; reexport native string functions
 (def substring si/substring)
-(def index-of si/index-of)
+(def index-of (comp #(if (not= -1 %) %) si/index-of))
 (def split si/split)
 
 (def ends-with? si/ends-with)
@@ -17,24 +17,33 @@
 (def lower-case si/lower-case)
 (def upper-case si/upper-case)
 
+; TODO: There should be locale-aware variants of these values
+(def lower "abcdefghijklmnopqrstuvwxyz")
+(def upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+(def digits "0123456789")
+(def punctuation "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
+(def whitespace (str \space \newline \tab \backspace \formfeed \return))
+(def letters (str lower upper))
+(def printable (str letters digits punctuation whitespace))
+(def hexdigits "0123456789abcdefABCDEF")
+(def octdigits "012345678")
+
 (defn replace
   "Replace all occurrences of x in s with r."
   [s x r]
   (let [offset (if (zero? (count x)) (+ 1 (count r)) (count r))]
     (loop [start 0
            s s]
-      (let [i (index-of s x start)]
-        (if (neg? i)
-          s
-          (recur (+ i offset) (str (substring s 0 i) r (substring s (+ i (count x))))))))))
+      (if-let [i (index-of s x start)]
+        (recur (+ i offset) (str (substring s 0 i) r (substring s (+ i (count x)))))
+        s))))
 
 (defn replace-first
   "Replace the first occurrence of x in s with r."
   [s x r]
-  (let [i (index-of s x)]
-    (if (neg? i)
-      s
-      (str (substring s 0 i) r (substring s (+ i (count x)))))))
+  (if-let [i (index-of s x)]
+    (str (substring s 0 i) r (substring s (+ i (count x))))
+    s))
 
 (defn join
   {:doc "Join the elements of the collection using an optional separator"
@@ -54,7 +63,7 @@
   "True if s is nil, empty, or contains only whitespace."
   [s]
   (if s
-    (let [white #{\space \newline \tab \backspace \formfeed \return}
+    (let [white (set whitespace)
           length (count s)]
       (loop [index 0]
         (if (= length index)
@@ -63,3 +72,32 @@
             (recur (inc index))
             false))))
     true))
+
+(defmacro interp
+  ; TODO: This might merit special read syntax
+  {:doc "String interpolation."
+   :examples [["(require pixie.string :refer [interp])"]
+              ["(interp \"2 plus 2 is $(+ 2 2)$!\")" nil "2 plus 2 is 4!"]
+              ["(let [x \"locals\"] (interp \"You can use arbitrary forms; for example $x$\"))"
+               nil "You can use arbitrary forms; for example locals"]
+              ["(interp \"$$$$ is the escape for a literal $$\")"
+               nil "$$ is the escape for a literal $"]
+              ]}
+  [txt]
+  (loop [forms [], txt txt]
+    (cond
+      (empty? txt) `(str ~@ forms)
+      (starts-with? txt "$")
+        (let [pos (or (index-of txt "$" 1)
+                      (throw "Unmatched $ in interp argument!"))
+              form-str (subs txt 1 pos)
+              form (if (empty? form-str) "$"
+                     (read-string form-str))
+              rest-str (subs txt (inc pos))]
+          (recur (conj forms form) rest-str))
+      :else
+        (let [pos (or (index-of txt "$")
+                      (count txt))
+              form (subs txt 0 pos)
+              rest-str (subs txt pos)]
+          (recur (conj forms form) rest-str)))))

pixie/vm/compiler.py

@@ -353,7 +353,7 @@ def compile_form(form, ctx):
         ctx.push_const(nil)
         return
 
-    if rt.satisfies_QMARK_(rt.ISeq.deref(), form) and form is not nil:
+    if rt._satisfies_QMARK_(rt.ISeq.deref(), form) and form is not nil:
         form = macroexpand(form)
         return compile_cons(form, ctx)
     if isinstance(form, numbers.Integer):
@@ -425,7 +425,7 @@ def compile_form(form, ctx):
         compile_set_literal(form, ctx)
         return
 
-    if rt.satisfies_QMARK_(rt.IMap.deref(), form):
+    if rt._satisfies_QMARK_(rt.IMap.deref(), form):
         compile_map_literal(form, ctx)
         return
 
@@ -480,7 +480,7 @@ def compile_fn(form, ctx):
 
 
 
-    if rt.satisfies_QMARK_(rt.ISeq.deref(), rt.first(form)):
+    if rt._satisfies_QMARK_(rt.ISeq.deref(), rt.first(form)):
         arities = []
         while form is not nil:
             required_arity, argc = compile_fn_body(name, rt.first(rt.first(form)), rt.next(rt.first(form)), ctx)

pixie/vm/libs/pxic/writer.py

@@ -255,11 +255,11 @@ def write_object(obj, wtr):
     elif isinstance(obj, Var):
         #wtr.write_cached_obj(obj, write_var)
         write_var(obj, wtr)
-    elif rt.satisfies_QMARK_(rt.IMap.deref(), obj):
+    elif rt._satisfies_QMARK_(rt.IMap.deref(), obj):
         write_map(obj, wtr)
-    elif rt.satisfies_QMARK_(rt.IVector.deref(), obj):
+    elif rt._satisfies_QMARK_(rt.IVector.deref(), obj):
         write_vector(obj, wtr)
-    elif rt.satisfies_QMARK_(rt.ISeq.deref(), obj):
+    elif rt._satisfies_QMARK_(rt.ISeq.deref(), obj):
         write_seq(obj, wtr)
     elif isinstance(obj, Keyword):
         wtr.write_cached_obj(obj, write_keyword)

pixie/vm/persistent_vector.py

@@ -456,7 +456,7 @@ def _eq(self, obj):
                 return false
         return true
     else:
-        if obj is nil or not rt.satisfies_QMARK_(proto.ISeqable, obj):
+        if obj is nil or not rt._satisfies_QMARK_(proto.ISeqable, obj):
             return false
         seq = rt.seq(obj)
         for i in range(0, intmask(self._cnt)):