~subsetpark/fugue

18d7772632ed329ceb2038bf6d13ca2b5f55999d — Zach Smith 13 days ago 375e79b master
Tighten up proto-form code
2 files changed, 21 insertions(+), 28 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +20 -27
@@ 55,23 55,15 @@
  "Generate the def form for a Prototype."
  [name parent fields defined-fields
   _init-args proto-allocated-fields proto-allocations instance-defaults]
  ~(let [parent ',parent
         object (,bare-proto (string ',name) ,defined-fields)
         proto-allocations @{}]

     (each field ',proto-allocated-fields
       (put proto-allocations field ',name))
  ~(let [object (,bare-proto (string ',name) ,defined-fields)]
     (put-in object [:_meta :prototype-allocations]
             (table/setproto
               proto-allocations
               (get-in parent [:_meta :prototype-allocations])))
               (table ;(mapcat |[$0 object] ',proto-allocated-fields))
               (get-in ',parent [:_meta :prototype-allocations])))

     (put-in object [:_meta :instance-defaults] ',instance-defaults)

     (loop [[allocation-field allocation-value] :pairs ',proto-allocations]
       (put object allocation-field allocation-value))

     (table/setproto object parent)))
     (merge-into object ',proto-allocations)
     (table/setproto object ',parent)))

(defn- init-form
  "Generate the form that puts the object constructor method."


@@ 262,25 254,26 @@
        field-definitions (field-definitions name fields)
        [init-args] field-definitions]
    (array
     ~(def ,name
        ,(proto-docstring name defined-fields)
        (->
         ,(proto-form name
                      parent
                      fields
                      defined-fields
                      ;field-definitions)
         (put :new ,(init-form name init-args))))
     (pred-form name)
     (pred*-form name)
     ;(getters name fields))))
      ~(def ,name
         ,(proto-docstring name defined-fields)
         (->
           ,(proto-form name
                        parent
                        fields
                        defined-fields
                        ;field-definitions)
           (put :new ,(init-form name init-args))))
      (pred-form name)
      (pred*-form name)
      ;(getters name fields))))

(defn prototype?
  ```
  Is `obj` the result of a `defproto ` call? 
  ```
  [obj]
  (= :prototype (get-in obj [:_meta :object-type])))
  (and (Root*? obj)
       (= :prototype (get-in obj [:_meta :object-type]))))

(defn allocate
  ```


@@ 293,7 286,7 @@
  (if-let [proto (table/getproto obj)
           allocations (get-in proto [:_meta :prototype-allocations])
           allocation (allocations key)
           to-allocate (eval allocation)]
           to-allocate allocation]
    (put to-allocate key value)
    (put obj key value)))


M test/fugue.janet => test/fugue.janet +1 -1
@@ 3,7 3,7 @@

(def tab @{})

(deftest table
(deftest table-not-a-proto
  (is (not (fugue/prototype? tab))))

(defn- proto-tests [proto]