a6b24c6da5af86cd6f73ad1a36425666d9f71630 — Zach Smith 3 years ago 4579ccb
Use merge-module technique; use proto name in field validation
2 files changed, 14 insertions(+), 17 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +13 -16
@@ 1,3 1,5 @@
(merge-module (curenv) root-env "janet/")

# Compile-time field access

@@ 73,8 75,9 @@
            (string field)
            (string name)))
  (unless (index-of field fields)
    (errorf "Field `%s` not found; got fields: %q"
    (errorf "Field `%s` not found on %s; got: %q"
            (string field)
            (string name)

(defn- validate-proto-match

@@ 169,27 172,24 @@
     [self ,;init-args &keys attrs]
     (let [inst @{:_meta @{:object-type :instance}}]
       # Recursively lookup defaults in prototype hierarchy
       (var source-of-defaults self)
       (while source-of-defaults
         (let [defaults (,get-in source-of-defaults [:_meta :instance-defaults])]
       (var current-proto self)
       (while current-proto
         (let [defaults (,get-in current-proto [:_meta :instance-defaults])]
           (loop [[default-key default-value] :pairs defaults]
             (,put inst default-key default-value)))
         # Recurse to grandparent
         (set source-of-defaults (,table/getproto source-of-defaults)))

         (set current-proto (,table/getproto current-proto)))
       # Set positional values passed to constructor
       (let [kvs (->> ,init-args
                      (,interleave ',init-args)
                      (,partition 2))]
         (each [arg-name arg] kvs
           (,put inst (,keyword arg-name) arg)))

       # Set additional attributes passed to constructor
       (,merge-into inst attrs)

       # Associate instance with Prototype
       (,table/setproto inst self)

       # Call initialize method
       (:_init inst))))

(put Root :new (eval (init-form 'Root [])))

@@ 601,10 601,9 @@

(defn- find-root
    (table/rawget t :ref) t
    (table/getproto t) (find-root (table/getproto t))
  (if (table/rawget t :ref)
    (when-let [it (table/getproto t)] it)))

(defn- emit-varfn
  "Generate varfn form of multimethod"

@@ 836,8 835,6 @@
         (errorf "Expected a %s, got: %q" ,(string proto) (,get-type-or-proto ,obj))
         ,(tuple obj field)))))

(def- root-match match)

(defmacro match
  Prototype-aware version of `match`. Introduces one new case form:

@@ 864,4 861,4 @@
        patterns (partition 2 (if oddlen (slice cases 0 -2) cases))
        transformed (mapcat transform patterns)
        cases (if else (array/push transformed else) transformed)]
    (root-match x ;cases)))
    ~(as-macro ,janet/match ,x ,;cases)))

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

(deftest fugue-match-warnings
  (is (thrown?
        "Field `some-other-field` not found; got fields: @[:name]"
        "Field `some-other-field` not found on MyMatcher; got: @[:name]"
        (apply fugue/match '[:ok (@ MyMatcher {:some-other-field foo}) foo]))))

(deftest fugue-match-else