~subsetpark/fugue

4759dba56607a6ad18f8a140fc1d7f2b7b3869d4 — Zach Smith 5 months ago ec9de0f
Eval parent at runtime
2 files changed, 19 insertions(+), 14 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +15 -13
@@ 54,13 54,14 @@
    ((comp freeze (partial map symbol)) defined-fields)))

(defn- field-definitions
  [name fields]
  [name fields defined-fields]
  (let [field-definitions @{:init-args @[]
                            :proto-allocated-fields @[]
                            :proto-allocations @{}
                            :instance-defaults @{}
                            :getters @{}}]
    (put field-definitions :fields (map (comp keyword 0) fields))
    (put field-definitions :fields defined-fields)
    (put proto-field-registry (string (dyn :current-file) "-" name) field-definitions)

    (loop [[field-name attrs] :in fields
           :let [key-field (keyword field-name)]]


@@ 81,27 82,29 @@
                               {:getter getter} getter
                               _ field-name)]
        (put-in field-definitions [:getters field-name] getter-name)))
    (put proto-field-registry (string (dyn :current-file) "-" name) field-definitions)
    field-definitions))

(defn- proto-form
  "Generate the def form for a Prototype."
  [name parent fields defined-fields
   {:proto-allocated-fields proto-allocated-fields :proto-allocations proto-allocations :instance-defaults instance-defaults :getters getters}]
  ~(let [object (,bare-proto (,string ',name) ,defined-fields)]
   {:proto-allocated-fields proto-allocated-fields
    :proto-allocations proto-allocations
    :instance-defaults instance-defaults
    :getters getters}]
  ~(let [object (,bare-proto (,string ',name) ,defined-fields)
         parent (if (symbol? ',parent) ,parent ',Root)]
     (,put-in object [:_meta :prototype-allocations]
        (,table/setproto
           (,table ;(,mapcat |[$0 object] ',proto-allocated-fields))
           (,get-in ',parent [:_meta :prototype-allocations])))
           (,get-in parent [:_meta :prototype-allocations])))
     (,put-in object [:_meta :instance-defaults] ',instance-defaults)
     (,put-in object [:_meta :getters] ',getters)
     (,merge-into object ',proto-allocations)
     (,table/setproto object ',parent)))
     (,table/setproto object parent)))

(defn- init-form
  "Generate the form that puts the object constructor method."
  [name init-args]

  ~(fn ,(symbol "new-from-" name)
     [self ,;init-args &keys attrs]
     (let [inst @{:_meta @{:object-type :instance}}]


@@ 201,7 204,7 @@
(eval (new-form 'Root))

(defn- getters
  [name parent {:getters getter-list}]
  [name {:getters getter-list}]
  (seq [[field-name getter-name] :pairs getter-list
        :let [key-field (keyword field-name)
              docstring (string "Get " field-name " from a " name)]]


@@ 290,15 293,14 @@
    (error "defproto received odd number of fields"))

  (let [fields (partition 2 fields)
        parent (if (symbol? parent-name) (eval parent-name) Root)
        defined-fields (map (comp keyword 0) fields)
        field-definitions (field-definitions name fields)]
        field-definitions (field-definitions name fields defined-fields)]
    (array
      ~(def ,name
         ,(proto-docstring name defined-fields)
         (->
           ,(proto-form name
                        parent
                        parent-name
                        fields
                        defined-fields
                        field-definitions)


@@ 306,7 308,7 @@
      (pred-form name)
      (pred*-form name)
      (new-form name)
      ;(getters name parent field-definitions))))
      ;(getters name field-definitions))))

(defn prototype?
  ```

M test/fugue.janet => test/fugue.janet +4 -1
@@ 325,7 325,10 @@

(deftest defproto-child-in-test
  (fugue/defproto InTestParent nil)
  (fugue/defproto InTestChild InTestParent))
  (fugue/defproto InTestChild InTestParent)

  (is (InTestParent? InTestChild))
  (is (InTestChild? (new-InTestChild))))

(deftest defgeneric-in-test
  (fugue/defgeneric in-test [x] (string x " ok"))