macro.clj

(defn ^:no-doc careful-def [ns]
  #?(:cljs
     (fn [sym form]
       `(def ~sym ~form))

     :clj
     (let [ns-sym  (ns-name ns)
           nsm     (ns-map ns)
           remote? (fn [sym]
                     (when-let [v (nsm sym)]
                       (not= *ns* (:ns (meta v)))))
           warn (fn [sym]
                  `(log/warn '~sym
                             "already refers to:"
                             ~ (nsm sym)
                             (str "in namespace:" '~ns-sym ",")
                             "being replaced by:"
                             ~(str "#'" ns-sym "/" sym)))]
       (fn [sym form]
         (if (remote? sym)
           `(do
              ~(warn sym)
              (ns-unmap '~ns-sym '~sym)
              (intern '~ns-sym '~sym ~form))
           `(def ~sym ~form))))))

(defmacro define-coordinates
  "Give some `coordinate-system` like `R2-rect` and a `coordinate-prototype` like
  `[x y]` or `(up x y), `binds the following definitions into the namespace
  where [[define-coordinates]] is invoked:

  - `R2-rect` binds to a new version of the coordinate system with its
    `coordinate-prototype` replaced by the supplied prototype

  - `x` and `y` bind to coordinate functions, ie, functions from manifold point
  to that particular coordinate

  - `d:dx` and `d:dy` bind to the corresponding vector field procedures

  - `dx` and `dy` bind to 1-forms for each coordinate."
  [coordinate-prototype coordinate-system]
  (let [sys-name           (symbol (name coordinate-system))
        coord-names        (symbols-from-prototype coordinate-prototype)
        vector-field-names (map vf/coordinate-name->vf-name coord-names)
        form-field-names   (map ff/coordinate-name->ff-name coord-names)
        sys-sym            (gensym)
        value-sym          (gensym)
        bind               (careful-def *ns*)]
    `(let [~sys-sym (m/with-coordinate-prototype
                      ~coordinate-system
                      ~(quotify-coordinate-prototype coordinate-prototype))]
       ~(bind sys-name sys-sym)
       (let [~value-sym
             (into [] (flatten
                       [(coordinate-functions ~sys-sym)
                        (vf/coordinate-system->vector-basis ~sys-sym)
                        (ff/coordinate-system->oneform-basis ~sys-sym)]))]
         ~@(map-indexed
            (fn [i sym]
              (bind sym `(nth ~value-sym ~i)))
            (concat coord-names vector-field-names form-field-names))))))