add arglists and doc metadata to deftype/defrecord constructor fns

Matches Clojure behavior where (meta #'->Foo) has :arglists and :doc.
Also fixes deftype constructor to use positional args instead of varargs,
enforcing correct arity like Clojure does.

Author: borkdude

src/sci/impl/deftype.cljc

@@ -174,8 +174,11 @@
                      impls)))
             protocol-impls)]
        (emit-deftype rec-type record-name factory-fn-sym
-                     `(defn ~factory-fn-sym [& args#]
-                        (sci.impl.deftype/->type-impl '~rec-type ~record-name ~record-name (zipmap ~(list 'quote fields) args#)))
+                     `(defn ~(with-meta factory-fn-sym
+                               {:doc (str "Positional factory function for class " rec-type ".")
+                                :arglists (list fields)})
+                        ~fields
+                        (sci.impl.deftype/->type-impl '~rec-type ~record-name ~record-name (zipmap ~(list 'quote fields) ~fields)))
                      protocol-impls))))
 
 (defn deftype-macro
@@ -276,7 +279,10 @@
                                      `#{~@(map (fn [p] (list 'deref (:var p))) protocols)}
                                      `#{})]
                  (emit-deftype rec-type record-name factory-fn-sym
-                               `(defn ~factory-fn-sym [~@fields]
+                               `(defn ~(with-meta factory-fn-sym
+                                         {:doc (str "Positional factory function for class " rec-type ".")
+                                          :arglists (list fields)})
+                                  [~@fields]
                                   (~constructor-sym {:methods (hash-map ~@method-entries)
                                                      :fields (hash-map ~@field-entries)
                                                      :protocols ~protocols-form}))))
@@ -348,8 +354,11 @@
                            impls)))
                   protocol-impls)]
              (emit-deftype rec-type record-name factory-fn-sym
-                          `(defn ~factory-fn-sym [& args#]
-                             (sci.impl.deftype/->type-impl '~rec-type ~record-name ~record-name (zipmap ~(list 'quote fields) args#)))
+                          `(defn ~(with-meta factory-fn-sym
+                                    {:doc (str "Positional factory function for class " rec-type ".")
+                                     :arglists (list fields)})
+                             ~fields
+                             (sci.impl.deftype/->type-impl '~rec-type ~record-name ~record-name (zipmap ~(list 'quote fields) ~fields)))
                           protocol-impls)))]
     (if top-level?
       (types/->EvalForm result)

src/sci/impl/records.cljc

@@ -342,10 +342,14 @@
                                             ext# (merge ext#)
                                             meta# (with-meta meta#)))))
 
-       (defn ~factory-fn-sym
+       (defn ~(with-meta factory-fn-sym
+                {:doc (str "Positional factory function for class " rec-type ".")
+                 :arglists (list fields)})
          (~fields
           (~constructor-fn-sym ~@fields nil nil)))
-       (defn ~map-factory-sym [m#]
+       (defn ~(with-meta map-factory-sym
+                {:doc (str "Factory function for class " rec-type ", taking a map of keywords to field values.")})
+         [m#]
          (sci.impl.records/->record-impl '~rec-type
                                          ~record-name
                                          ~key-set

test/sci/defrecords_and_deftype_test.cljc

@@ -191,12 +191,12 @@
 #?(:cljs (def Exception js/Error))
 
 (deftest deftype-test
-  (is (= 1 (tu/eval* "(defprotocol GetX (getX [_])) (deftype Foo [x y] GetX (getX [_] x)) (getX (->Foo 1)) " {})))
+  (is (= 1 (tu/eval* "(defprotocol GetX (getX [_])) (deftype Foo [x y] GetX (getX [_] x)) (getX (->Foo 1 2)) " {})))
   (let [prog "(deftype Foo [a b]) (let [x (->Foo :a :b)] [(.-a x) (.-b x)])"]
     (is (= [:a :b] (tu/eval* prog {}))))
   (is
    (= 10
-      (tu/eval* (str/replace "(defprotocol IFoo (setField [_]) (getField [_])) (deftype Foo [^:volatile-mutable a] IFoo (setField [_] (set! a 10)) (getField [_] a)) (getField (doto (->Foo) (setField)))"
+      (tu/eval* (str/replace "(defprotocol IFoo (setField [_]) (getField [_])) (deftype Foo [^:volatile-mutable a] IFoo (setField [_] (set! a 10)) (getField [_] a)) (getField (doto (->Foo nil) (setField)))"
                              "^:volatile-mutable" #?(:clj "^:volatile-mutable"
                                                      :cljs "^:mutable")) {})))
   (is (= [1 2 2]
@@ -234,7 +234,7 @@
   (is (= "dude" (tu/eval* "(deftype Dude [] Object (toString [_] \"dude\")) (str (->Dude))" {})))
   #?(:clj (is (= [true false] (tu/eval* "(deftype Dude [x] Object (toString [_] (str x)) (equals [this other] (= (str this) (str other)))) [(= (->Dude 1) (->Dude 1)) (= (->Dude 1) (->Dude 2))]" {}))))
   #?(:clj (is (true? (tu/eval* "(deftype Dude [x] Object (hashCode [_] 1))
-(deftype Dude2 [x]) (and (= 1 (hash (Dude. 1337))) (not= 1 (hash (Dude2.))))" {})))))
+(deftype Dude2 [x]) (and (= 1 (hash (Dude. 1337))) (not= 1 (hash (Dude2. nil))))" {})))))
 
 (deftest equiv-test
   (let [prog "(defrecord Foo [a]) (defrecord Bar [a]) [(= (->Foo 1) (->Foo 1)) (= (->Foo 1) (->Bar 1)) (= (->Foo 1) {:a 1})]"]