(defn- compiler-emit
  [level msg]
  (let [source (or (dyn :current-file) "n/a")
        [l c] (tuple/sourcemap (dyn :macro-form ()))]
    (eprintf "%s:%i:%i: [%s] %s" source l c level msg)))

(defn- compiler-warn [msg] (compiler-emit "WARNING" msg))
(defn- compiler-info [msg] (compiler-emit "INFO" msg))

#
# Compile-time field access
#

(def- proto-field-registry
  "Keep compile-time track of field definitions"
  @{})

(defn- registry-fields
  [sym]
  (get-in proto-field-registry [sym]))

(defn- registry-register
  [key value]
  (put proto-field-registry key value))

#
# Bootstrapping
#

(defn- base-proto
  "Basic prototype table."
  [name defined-fields instance-defaults proto-allocated-fields & kvs]
  (table
    :_meta @{:object-type :prototype
             :fields defined-fields
             :prototype-allocations proto-allocated-fields
             :instance-defaults instance-defaults
             :getters @{}}
    :_name name
    ;kvs))

(def Root
  "Root of the Fugue object hierarchy."
  (base-proto "Prototype" [] @{} @{} :_init identity))

#
# Field Access
#

(defn fields
  ```
  Return all the defined fields for `obj` and its prototype
  hierarchy.
  ```
  [obj]
  (let [proto-fields ;(if (table? obj)
                        (fields (table/getproto obj))
                        @[])
        obj-fields (or (get-in obj [:_meta :fields]) @[])]
    (array ;proto-fields ;obj-fields)))

(defn- comp-aware-fields
  "Fields checks, even when the proto is not available yet"
  [obj]
  (cond
    (not (symbol? obj)) (fields obj)
    (dyn obj) (fields (eval obj))
    true (if-let [reg-key (string (dyn :current-file) "-" obj)
                  listing (registry-fields reg-key)]
           listing
           (compiler-warn (string "no prototype definition found for " obj)))))

#
# Field Validation
#

(defn- validate-field
  [field fields]
  (unless fields
    (errorf "Field validation for `%s` failed; no fields registered" (string field)))
  (unless (index-of field fields)
    (errorf "Field `%s` not found; got fields: %q" (string field) fields)))

(defn- validate-proto-match
  [name attrs]
  (let [fields (comp-aware-fields name)]
    (loop [k :keys attrs]
      (validate-field k fields))))

(defn- warn-proto-method-shadow
  [name proto]
  (when (index-of (keyword name) (comp-aware-fields proto))
    (compiler-warn
      (string/format "you are defining a method named %s on the prototype %s; there is a field of the same name on that prototype."
                     (string name)
                     (string proto)))))

#
# defproto Forms
#

(defn- proto-docstring
  [name defined-fields]
  (string/format
    "%s Prototype.\nFields: %q"
    (string name)
    ((comp freeze (partial map symbol)) defined-fields)))

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

    (loop [entry :in fields
           :when (= 2 (length entry))
           :let [[field-name attrs] entry
                 key-field (keyword field-name)]]
      # Assemble list of arguments to constructor
      (when (attrs :init?)
        (array/push (field-definitions :init-args) field-name))
      # Assemble fields that should be set directly on this prototype
      (when (= (attrs :allocation) :prototype)
        (put-in field-definitions [:proto-allocated-fields key-field] true))
      # Assemble values to be set directly on prototype
      (when-let [proto-value (attrs :allocate-value)]
        (put-in field-definitions [:proto-allocations key-field] proto-value))
      # Assemble mapping of fields to default values for instances
      (when-let [default-value (attrs :default)]
        (put-in field-definitions [:instance-defaults key-field] default-value))
      # Assemble mapping of fields to getters (unless excluded)
      (when-let [getter-name (match attrs
                               {:getter getter} getter
                               _ field-name)]
        (put-in field-definitions [:getters field-name] getter-name)))
    field-definitions))

(defn- prototype-attributes
  [name attrs]
  (let [prototype-attributes @{}]
    (when-let [constructor-name (match attrs
                                  {:constructor constructor-name} constructor-name
                                  _ (symbol "new-" name))]
      (put prototype-attributes :constructor-name constructor-name))
    prototype-attributes))

(defn- proto-form
  "Generate the def form for a Prototype."
  [name parent fields defined-fields
   {:proto-allocated-fields proto-allocated-fields
    :proto-allocations to-allocate
    :instance-defaults instance-defaults}]
  ~(let [parent (if (symbol? ',parent) ,parent ',Root)]
     (->
       ',name
       (,string)
       (,base-proto
          ,defined-fields
          ,instance-defaults
          ,proto-allocated-fields
          ;(,kvs ,to-allocate))
       (,table/setproto 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}}]
       # 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])]
           (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 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)

       (:_init inst))))

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

(defn get-type-or-proto
  ```
  Return the prototype of `obj`, if it has one, otherwise the keyword
  output of `type`.
  ```
  [obj]
  (if (table? obj) (table/getproto obj) (type obj)))

(defn- pred-name [name] (symbol name "?"))

(defn- prototype-check
  "Check if obj is an instance of proto."
  [proto obj]
  (and (table? obj) (= proto (table/getproto obj))))

(defn- pred-form
  "Generate the defn form for the Prototype predicate."
  [name]
  (let [pred-name (pred-name name)
        pred-docstring (string/format ```
                                      Proto instance predicate: return if `obj` is an
                                      instance (that is, a direct child) of %s.
                                      ```
                                      (string name))]
    ~(defn ,pred-name
       ,pred-docstring
       [obj]
       (,prototype-check ,name obj))))

(eval (pred-form 'Root))

(defn- recursive-prototype-check
  "Check if obj is a descendent of ancestor."
  [ancestor obj]
  (or (prototype-check ancestor obj)
      (and (table? obj) (recursive-prototype-check ancestor (table/getproto obj)))))

(defn- pred*-form
  "Generate the defn form for the recursive Prototype predicate."
  [name]
  (let [pred-name (pred-name name)
        rec-pred-name (symbol name "*?")

        rec-pred-docstring (string/format ```
                                          Proto ancestor predicate: return if `obj` is a
                                          descendent of %s.
                                          ```
                                          (string name))]
    ~(defn ,rec-pred-name
       ,rec-pred-docstring
       [obj]
       (,recursive-prototype-check ,name obj))))

(eval (pred*-form 'Root))

(defn- new-form
  "Generate the init form wrapper."
  [name constructor-name]
  (when constructor-name
    (let [docstring (string/format "Constructor for %s. Return a new object with %s as the prototype."
                                   (string name)
                                   (string name))]
      ~(defn ,constructor-name
         ,docstring
         [& rest]
         (:new ,name ;rest)))))

(eval (new-form 'Root 'new-Root))

(defn- getters
  [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)]]
    (with-syms [self]
      ~(defn ,getter-name
         ,docstring
         [,self]
         (let [current-fields (,fields ,self)]
           (unless (,index-of ,key-field current-fields)
             (,errorf "type error: expected proto with field %q, got %s with fields: %q"
                ,key-field
                (in ,self :_name)
                current-fields)))
         (,in ,self ,key-field)))))

(defmacro defproto
  ````
  Object prototype definition.

  ## Usage
  
  `name` should be any symbol. The resulting prototype will be
  named after it.

  `parent-name` is required; it can be an existing prototype, *or*
  some null-ish value. If null-ish (`nil` or `()` should make the most
  sense...) the parent of the prototype will be set to `fugue/Root`.

  `fields` should be 0 or more pairs of the following format:

  `<field-name> <field-attributes>`

  Where `field-name` is a field to define on the prototype and
  `field-attributes` is a struct describing the field. The following
  field attributes are currently recognized:

  - `:default`: provide a default value for all new instances of this
  prototype
  - `:init?`: if truthy, then this field will be a required parameter
  to the prototype 's constructor
  - `:allocation`: if `:prototype`, then `fugue/allocate` will always act on
  the prototype when putting this field.
  - `:allocate-value`: this field will have this attribute set at the
  prototype, so that any children without their own values will
  inherit it.
  - `:getter`: specify a name for the defined function to access this
  field (by default, has the same name as the field). Specify `false`
  to prevent a getter from being defined.

  `defproto` will define a getter function for each of the defined
  fields, unless `:getter` is false.

  `defproto` will also create a `:new` method in the created
  prototype. This will take as positional arguments all of the fields
  specified as `init?`, and then accept in `&keys` format any other
  attributes to set on this object.

  The special method `:_init` will be called as the last step in the
  `:new` constructor. It can be defined for a prototype (see
  `defmethod`) to take a new instance and to make any arbitrary
  mutations on the instance or prototype as part of object
  instantiation. By default it simply returns the instance.

  The value provided to a field's `:default` entry will be inserted
  directly to the instance. Thus, mutable/referenced terms like tables
  and arrays will be shared amongst all instances. In cases where you
  want to insert a new term for each new instance, use the `_init`
  method to put a value at that field.
  
  If `fields` is of an odd length, the last element will be treated as
  a prototype attributes struct. There is currently one valid prototype attribute:

  - `:constructor` : Set the name of the defined function that
    calls `:new`. If false, no additional constructor will be
    defined. By default, will be set to `new-<prototype name>`.
  
  ---
  
  An example usage:

  ```
  repl:43:> (fugue/defproto Dog () name {:allocate-value "Fido"})
  repl:44:> (fugue/defproto Pekingese Dog size {:default "Extremely Small"})
  repl:45:> (fugue/defmethod speak Dog [self] (string "My name is " (self :name)))
  repl:46:> (fugue/defmethod speak Pekingese [self] (string (prototype-method self) " and I am " (self :size)))
  repl:47:> (speak (:new Pekingese))
  "My name is Fido and I am Extremely Small"
  ```
  ````
  [name parent-name & fields]
  (let [has-proto-attributes (odd? (length fields))
        fields (partition 2 fields)
        defined-fields (map (comp keyword 0) (if has-proto-attributes (array/slice fields 0 -2) fields))
        field-definitions (field-definitions name fields defined-fields)
        [prototype-attributes-entry] (if has-proto-attributes (last fields) [{}])
        prototype-attributes (prototype-attributes name prototype-attributes-entry)]
    @[~(def ,name
         ,(proto-docstring name defined-fields)
         (->
           ,(proto-form name
                        parent-name
                        fields
                        defined-fields
                        field-definitions)
           (,put :new ,(init-form name (field-definitions :init-args)))))
      (pred-form name)
      (pred*-form name)
      (new-form name (prototype-attributes :constructor-name))
      ;(getters name field-definitions)]))

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

(defn allocate
  ```
  Allocation-aware put. If `obj` has inherited an allocation to a
  specific prototype for this key, then `fugue/allocate` will put `value`
  at `key` in the appropriate prototype, and it will be inherited by
  all descendents of that prototype.
  ```
  [obj key value]
  (var source-of-defaults obj)
  (while source-of-defaults
    (let [prototype-allocations (get-in source-of-defaults [:_meta :prototype-allocations])]
      (if (and prototype-allocations (in prototype-allocations key)) (break))
      # Recurse to grandparent
      (set source-of-defaults (table/getproto source-of-defaults))))

  (let [dest (or source-of-defaults obj)]
    (put dest key value)))

(def- raise-sentinel (gensym))

(defn- defgeneric*
  [name docstring args & body]
  (default docstring "Generic function.")
  (with-syms [wrapper-args]
    (let [err-msg (string/format
                    "could not apply generic %s to args %%q"
                    (string name))
          method-name (keyword name)
          final-case (case body
                       [raise-sentinel] ~(,errorf
                                            ,err-msg
                                            ,wrapper-args)
                       ~(fn ,args ,;body))]
      ~(defn ,name
         ,docstring
         [& ,wrapper-args]
         (match (,first ,wrapper-args)
           ({,method-name f} (function? f)) (f ;,wrapper-args)
           _ (,final-case ;,wrapper-args))))))

(defmacro defgeneric
  ```
  Define a generic function. When this function is called, if the
  first argument has a method corresponding to the name of the
  function, call that object 's method with the arguments. Otherwise,
  evaluate `body`.
  ```
  [name & rest]
  (let [[docstring args body]
        (if (string? (first rest))
          [(rest 0)
           (rest 1)
           (array/slice rest 2)]
          [nil
           (rest 0)
           (array/slice rest 1)])]
    (defgeneric* name docstring args ;(if (empty? body) [raise-sentinel] body))))

(defmacro defmethod
  ```
  Simple single-dispatch method definition. Roughly equivalent to
  `put` ing a function directly into a prototype.

  Defines a few symbols for reference in the body of the method.
  
  - `__parent` - Bound to the parent of `proto`.
  - `__super` - Bound to the method at `name` within `__parent`.
  ```
  [name proto args & body]
  (warn-proto-method-shadow name proto)
  (upscope
    (let [current-binding (dyn name)]
      @[(unless (and current-binding (function? (current-binding :value)))
          (compiler-info (string "Defining generic function for method " name "..."))
          (defgeneric* name nil args raise-sentinel))

        (let [method-name (keyword name)
              full-method-name (symbol proto "-" name)]
          ~(,put ,proto
              ,method-name
              (fn ,full-method-name
                ,args
                (let [__parent (table/getproto ,proto)
                      __super (__parent ,method-name)]
                  ,;body))))])))

#
# Multimethod Helpers
#

(defn- get-cases
  [name store]
  (as-> name .
        (store .)
        (pairs .)
        # Total hack: rely on the fact that `nil` is the smallest
        # value. Thus, when sorted, cases should always have the base
        # case last for any positional argument.
        #
        # ie: [:string :string]
        #     [:string :_]
        #     [:_ :number]
        #     [:_ :_]
        (sort . >)))

(defn- replace-placeholder-symbols
  [types]
  (defn f [sym]
    (case sym
      '_ nil
      :_ nil
      (let [evaled (eval sym)]
        (if (not (or (table? evaled) (keyword? evaled)))
          (errorf `Multimethod type error. Expected keyword or prototype, got:
                   %q of type %q`
                  sym
                  (type sym))
          evaled))))
  (tuple/slice (map f types)))

(defn- put-case
  [name types fun store]
  (let [types (replace-placeholder-symbols types)]
    (put-in store [name types] fun)))

#
# Multimethod Closures
#

(def- multi-cases @{})

(defn- set-multi-default
  [name]
  (unless (in multi-cases name)
    (put multi-cases name @{})))

(defn- put-multi-case
  [name types fun]
  (put-case name types fun multi-cases))

(defn- get-multi-cases
  [name]
  (get-cases name multi-cases))

#
# Open Multi Closures
#

(def- var-cases @{})

(defn- put-var-case
  [f types fun]
  (put-case f types fun var-cases))

(defn- get-var-cases
  [name]
  (get-cases name var-cases))

#
# Multimethod API
#

(defn multimethod-types-match?
  ```
  Check to see if the types `args` match the sequence `arg-types`,
  according to multimethod rules (ie, following prototype membership
  and using `:_` as a fallback)
  ```
  [args arg-types]
  (if (not= (length arg-types) (length args))
    false
    (do
      (var kk nil)
      (var vk nil)
      (var res true)
      (while true
        (set kk (next args kk))
        (if (= nil kk) (break))
        (set vk (next arg-types vk))
        (if (= nil vk) (break))
        (unless (or (= (arg-types vk) nil)
                    (= (get-type-or-proto (args kk)) (arg-types vk)))
          (set res false)
          (break)))
      res)))

(defn- construct-cond
  "Build main function logic of multimethod"
  [name cases args-symbol]
  (defn cond-case
    [[case-types case]]
    ~[(,multimethod-types-match? ,args-symbol ',case-types)
      (,case ;,args-symbol)])

  (let [body (mapcat cond-case cases)
        err-msg (string/format "could not apply multimethod %s to args %%q" name)]
    ~(cond ,;body (,errorf ,err-msg ,args-symbol))))

(defn- make-docstring
  "Compose docstring for multimethod"
  [cases &opt prefix]
  (default prefix "")
  (as->
    (partial string/format "- %q") .
    (comp . 0)
    (map . cases)
    (string/join . "\n\n")
    (string prefix "Multimethod. Defined types:\n\n" .)))

(defn- emit-defn
  "Generate defn form of multimethod"
  [name docstring args cond-form]
  ~(defn ,name
     ,docstring
     [& ,args]
     ,cond-form))

(defn- find-root
  [t]
  (cond
    (table/rawget t :ref) t
    (table/getproto t) (find-root (table/getproto t))
    nil))

(defn- emit-varfn
  "Generate varfn form of multimethod"
  [name fn-name docstring args cond-form]
  ~(let [cell (,find-root (dyn ',name))
         f (fn ,fn-name [& ,args] ,cond-form)]
     (,put-in cell [:ref 0] f)
     (,put-in cell [:doc] ,docstring)
     f))

(defn- make-case
  [args body]
  (eval ~(fn ,args ,;body)))

(defmacro defmulti
  ````
  Define a multimethod based on all the arguments passed to the
  function.

  Example usage :

  ```
  > (defproto Foo ())
  > (defmulti add [Foo] [f] (put f :value 1))
  > (defmulti add [:number] [x] (+ x 1))
  > (defmulti add [:string] [s] (string s "!"))
  > (def a-foo (:new Foo))
  > (add a-foo)
  @Foo{:value 1 :_meta @{:object-type :instance}}
  > (add 1)
  2
  > (add "s")
  "s!"
  ```

  `defmulti` takes a sequence of type-or-prototypes, and builds a
  function which will check its arguments against those types (as well
  as all other ones specified in other `defmulti` calls to the same
  function name), and execute the function body for the matching type
  signature.

  In addition to type names or prototypes, you can use the symbol `_`
  or keyword `:_` as a wildcard that means "match any type". For
  instance,

  ``` 
  repl:2:> (defmulti cat [:string :_] [s1 s2] (string s1 s2))
  repl:3:> (cat "hello " "world!")
  "hello world!"
  repl:4:> (cat "hello " 42)
  "hello 42"
  repl:5:> (cat 42 "hello")
  error: could not apply multimethod <function cat> to args (42 "hello")
    in cat [repl] on line 2, column 1
    in _thunk [repl] (tailcall) on line 5, column 1
  ```

  Defining a multimethod with the signature `[:string :_]` will match
  on any two arguments if the first one is a string.

  A multimethod without wilcards will be preferred to one with one in
  the same position. For instance, if we define an additional
  multimethod:

  ```
  repl:8:> (defmulti cat [:string :number] [s n] (string s " #" n))
  ```

  Then that more specific method will be preferred and the wildcard
  will be a fallback if the specific one doesn't match:

  ```
  repl:10:> (cat "hello " @"world")
  "hello world"
  repl:12:> (cat "hello" 100)
  "hello #100"
  ```
  ````
  [name multi-types args & body]
  # Nominal case handling: group declared cases by concating the
  # current file with the name of the function.
  (let [cases-key (keyword (dyn :current-file) "-" name)]
    (set-multi-default cases-key)
    (put-multi-case cases-key multi-types (make-case args body))

    (with-syms [args]
      (let [cases (get-multi-cases cases-key)
            cond-form (construct-cond (string name) cases args)
            docstring (make-docstring cases)]
        (emit-defn name docstring args cond-form)))))

(defmacro declare-open-multi
  ```
  Declare an open multimethod, ie, one that can be extended.

  Extending an open multimethod (see `extend-multi`) from any other
  environment makes the case extension available wherever the
  multimethod has been imported.
  ```
  [name]
  (let [f (eval ~(fn ,name [& _] (error "No cases declared for open multimethod")))
        ref @[f]
        cell @{:doc "Open multimethod." :ref ref}]
    (put var-cases ref @{})
    (setdyn name cell)
    f))

(defmacro extend-multi
  ```
  Extend an open multimethod (see `declare-open-multi`) using the same
  syntax as `defmulti`.

  See that function's documentation for full usage reference.

  Whenever a case is added to `multi`, that case is available
  wherever the multimethod is imported.
  ```
  [multi multi-types args & body]
  (let [ref (and (dyn multi) (in (dyn multi) :ref))]
    (put-var-case ref multi-types (make-case args body))

    (with-syms [args]
      (let [cases (get-var-cases ref)
            fn-name (->> multi (string/split "/") (last))
            cond-form (construct-cond fn-name cases args)
            docstring (make-docstring cases "Open ")]
        (emit-varfn multi (symbol fn-name) docstring args cond-form)))))

(defn- field-transformer
  [fields obj-sym as proto-name]
  (fn [sym]
    (cond
      (and (tuple? sym) (= (length sym) 2) (= (sym 0) as) (symbol? (sym 1)))
      (let [field-name (-> sym (1) (keyword))]
        (unless (index-of field-name fields)
          (errorf `Encountered field reference %q for prototype %q;

                   Expected one of: %q`
                  sym
                  proto-name
                  fields))
        ~(,obj-sym ,field-name))

      (= sym as)
      obj-sym

      true
      sym)))

(defn- do-with-slots-as
  [proto obj as body]
  (with-syms [x]
    (let [f (-> proto (eval) (fields) (field-transformer x as proto))]
      ~(let [,x ,obj]
         ,;(prewalk f body)
         ,x))))

(defmacro with-slots
  ````
  Anaphoric macro with transformed getter/setters.

  Introduces two useful forms for referring to `obj`.

  It introduces a *reference symbol* - `@` by default
  (see `with-slots-as `to specify the symbol).

  The pattern `(@ <field name>)`, where `<field name>` is a symbol, is
  transformed into `(obj (keyword <field name>))`, if and only if
  `<field name>` is defined for `proto`, so that `(@ name)` or its
  setter form `(set (@ name) foo)` do the right thing.

  The reference symbol by itself is introduces as a reference to
  `obj`.

  Returns `obj`.
  
  ---

  Example :

  ```
  repl:2:> (defproto Foo nil name {:default "Jane Doe"})
  repl:4:> (with-slots Foo (new-Foo)
             (set (@ name) "Cosmo Kramer")
             (print (@ name))
             (print (Foo? @)))
  Cosmo Kramer
  true
  @Foo{:_meta @{:object-type :instance} :name "Cosmo Kramer"}
  ```
  ````
  [proto obj & body]
  (do-with-slots-as proto obj '@ body))

(defmacro with-slots-as
  ```
  Anaphoric macro with transformed getter/setters.

  Specifies `as` as the reference symbol for `with-slots`.

  See `with-slots` documentation for more details.
  ```
  [proto obj as & body]
  (do-with-slots-as proto obj as body))

(defmacro @
  ```
  Compile-time Prototype field checking.

  Accepts two forms:

  `(@ SomePrototype :some-field)` - Translates into `:some-field`, if
  `some-field` is defined on `SomePrototype`.

  `(@ SomePrototype some-object :some-field)` - Asserts (as above) at
  compile time that `some-field` is defined on `SomePrototype`; at
  runtime, checks that `some-object` is a descendent of
  `SomePrototype` and if so, translates to `(some-object :some-field)`.
  ```
  [proto x &opt y]
  (let [[obj field] (if y [x y] [nil x])
        fields (fields (eval proto))]

    (validate-field field fields)

    (if-not obj
      field
      ~(if-not (,recursive-prototype-check ,proto ,obj)
         (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:

  - `(@ <prototype-name> <dictionary>)`: Will pattern match against an
    instance of `prototype-name`. Additionally, will validate at
    compile-time that every key in `dictionary` is a field that's
    present on the specified prototype. 
  ```
  [x & cases]
  (defn transform
    [[pattern exp]]
    [(match pattern
       @[(@ '@) proto-name attrs]
       (do
         (validate-proto-match proto-name attrs)
         (struct ;(kvs attrs) :_name (string proto-name)))

       pattern)
     exp])

  (let [oddlen (odd? (length cases))
        else (if oddlen (last cases))
        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)))