Merge pull request #214 from jolt-lang/fix/defn-docstring-assert-seqable

defn docstrings, assert throws AssertionError, Seqable covers collections

host/chez/host-static-classes.ss

@@ -669,8 +669,14 @@
                    ((string=? iface "IPersistentMap") (or (pmap? val) (htable-sorted-map? val)))
                    ((string=? iface "IPersistentVector") (and (pvec? val) (not (jolt-map-entry? val))))
                    ((string=? iface "IPersistentSet") (or (pset? val) (htable-sorted-set? val)))
-                   ((or (string=? iface "ISeq") (string=? iface "Seqable"))
+                   ((string=? iface "ISeq")
                     (or (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)))
+                   ;; Seqable is anything (seq x) works on — every persistent
+                   ;; collection, not just seqs (a vector IS Seqable, not an ISeq).
+                   ((string=? iface "Seqable")
+                    (or (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)
+                        (pvec? val) (pmap? val) (pset? val)
+                        (htable-sorted-map? val) (htable-sorted-set? val)))
                    ((string=? iface "Sequential")
                     (or (pvec? val) (cseq? val) (empty-list-t? val) (jolt-lazyseq? val)))
                    ((string=? iface "IFn")

jolt-core/clojure/core/00-syntax.clj

@@ -378,7 +378,8 @@
 ;; needed. (map? is true for symbol forms too, so guard the attr-map with symbol?.)
 ;; Defined before fresh-sym below, which is a defn-.
 (defmacro defn [fn-name & body]
-  (let [body (if (and (seq body) (string? (first body))) (rest body) body)
+  (let [docstring (when (and (seq body) (string? (first body))) (first body))
+        body (if docstring (rest body) body)
         body (if (and (seq body) (map? (first body)) (not (symbol? (first body))))
                (rest body) body)
         ;; ^{:map} metadata on the name reads as a (with-meta sym …) form, not an
@@ -386,8 +387,11 @@
         ;; bare symbol, so unwrap it for the fn name.
         fn-only-name (if (symbol? fn-name) fn-name (first (rest fn-name)))]
     ;; pass the name through to fn: the compiled fn's host name carries it,
-    ;; so stack traces read app.deep/level3 instead of a gensym
-    `(def ~fn-name (fn ~fn-only-name ~@body))))
+    ;; so stack traces read app.deep/level3 instead of a gensym. A leading
+    ;; docstring rides the def's docstring slot so (:doc (meta #'f)) is set.
+    (if docstring
+      `(def ~fn-name ~docstring (fn ~fn-only-name ~@body))
+      `(def ~fn-name (fn ~fn-only-name ~@body)))))
 
 ;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
 ;; defn- delegates to defn with :private metadata).

jolt-core/clojure/core/30-macros.clj

@@ -208,8 +208,10 @@
     `(let [~g ~expr ~@(thread-binds g steps)] ~(if (empty? steps) g (last steps)))))
 
 (defmacro assert [x & [message]]
-  (let [msg (if message message (str "Assert failed: " (pr-str x)))]
-    `(when-not ~x (throw (ex-info ~msg {})))))
+  (let [msg (if message
+              (str "Assert failed: " message "\n" (pr-str x))
+              (str "Assert failed: " (pr-str x)))]
+    `(when-not ~x (throw (new AssertionError ~msg)))))
 
 ;; (pvalues e1 e2 ...) — each expression evaluated in parallel (pcalls).
 (defmacro pvalues [& exprs]

test/chez/corpus.edn

@@ -24,6 +24,11 @@
   {:suite "try / multi-catch" :label "a host condition is caught by its RuntimeException subclass" :expected ":arith" :actual "(try (/ 1 0) (catch ArithmeticException _ :arith) (catch Throwable _ :other))"}
   {:suite "locking" :label "returns the body value" :expected "42" :actual "(let [o (Object.)] (locking o 42))"}
   {:suite "locking" :label "reentrant on the same object" :expected "42" :actual "(let [o (Object.)] (locking o (locking o 42)))"}
+  {:suite "defn / docstring" :label "leading docstring becomes :doc metadata" :expected "\"the docs\"" :actual "(do (defn dd \"the docs\" [x] x) (:doc (meta (var dd))))"}
+  {:suite "assert" :label "failed assert throws AssertionError" :expected ":ae" :actual "(try (assert false) (catch AssertionError _ :ae))"}
+  {:suite "fn / pre-post" :label ":pre failure throws AssertionError" :expected ":caught" :actual "(do (defn pp [x] {:pre [(pos? x)]} x) (try (pp -1) (catch AssertionError _ :caught)))"}
+  {:suite "interop / Seqable" :label "a vector is Seqable but not an ISeq" :expected "[true false]" :actual "[(instance? clojure.lang.Seqable [1 2 3]) (instance? clojure.lang.ISeq [1 2 3])]"}
+  {:suite "interop / Seqable" :label "a map is Seqable" :expected "true" :actual "(instance? clojure.lang.Seqable {:a 1})"}
   {:suite "extend-protocol / class value" :label "extend to (Class/forName \"[B\") dispatches a byte-array" :expected "[:ba :str]" :actual "(do (defprotocol P (m [x])) (extend-protocol P (Class/forName \"[B\") (m [bs] :ba) String (m [s] :str)) [(m (byte-array 1)) (m \"x\")])"}
   {:suite "interop / ByteBuffer" :label "wrap then remaining + array" :expected "[3 [1 2 3]]" :actual "(let [bb (java.nio.ByteBuffer/wrap (byte-array [1 2 3]))] [(.remaining bb) (vec (.array bb))])"}
   {:suite "interop / ByteBuffer" :label "get drains into a byte-array" :expected "[1 2]" :actual "(let [bb (java.nio.ByteBuffer/wrap (byte-array [1 2])) d (byte-array 2)] (.get bb d) (vec d))"}
@@ -817,7 +822,7 @@
   {:suite "macros / core-overlay" :label "cond->> skip" :expected "10" :actual "(cond->> 10 false (+ 1))"}
   {:suite "macros / core-overlay" :label "assert pass" :expected ":ok" :actual "(do (assert (= 1 1)) :ok)"}
   {:suite "macros / core-overlay" :label "assert throws" :expected ":threw" :actual "(try (assert (= 1 2)) (catch :default e :threw))"}
-  {:suite "macros / core-overlay" :label "assert message" :expected "\"nope\"" :actual "(try (assert false \"nope\") (catch :default e (ex-message e)))"}
+  {:suite "macros / core-overlay" :label "assert message" :expected "\"Assert failed: nope\\nfalse\"" :actual "(try (assert false \"nope\") (catch AssertionError e (ex-message e)))"}
   {:suite "macros / core-overlay" :label "delay value" :expected "42" :actual "(deref (delay 42))"}
   {:suite "macros / core-overlay" :label "delay forces once" :expected "1" :actual "(let [c (atom 0) d (delay (swap! c inc))] @d @d @c)"}
   {:suite "macros / core-overlay" :label "future deref" :expected "9" :actual "(deref (future (* 3 3)))"}