From e16b5692b04972f0bc9ea6d07f7ead41edccc066 Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Fri, 4 Aug 2023 13:59:03 -0600 Subject: [PATCH] Improve SCI environment, add sci-macro (#145) Co-authored-by: Matthew Huebert --- .dir-locals.el | 14 +- .github/workflows/kondo.yml | 3 + CHANGELOG.md | 23 ++ bb.edn | 11 +- deps.edn | 2 +- .../org.mentat/emmy/config.edn | 3 + .../org.mentat/emmy/hooks/emmy/util.clj | 13 ++ src/emmy/abstract/function.cljc | 2 +- src/emmy/algebra/fold.cljc | 3 +- src/emmy/calculus/coordinate.cljc | 48 ++-- src/emmy/collection.cljc | 4 + src/emmy/env.cljc | 77 ++++++- src/emmy/numerical/quadrature/common.cljc | 9 +- src/emmy/pattern/rule.cljc | 10 +- src/emmy/sci.cljc | 205 +++++++----------- src/emmy/sci/macros.cljc | 199 ----------------- src/emmy/sr/frames.cljc | 1 - src/emmy/util.cljc | 35 ++- src/emmy/util/def.cljc | 161 +++++++------- test/emmy/pattern/rule_test.cljc | 11 +- test/emmy/series_test.cljc | 10 +- test/emmy/sicm/ch3_test.cljc | 166 +++++++------- test/emmy/sicm/ch5_test.cljc | 7 +- test/emmy/tex_web_test.clj | 1 - test/emmy/util/def_test.cljc | 11 + test/emmy/value_test.cljc | 1 - 26 files changed, 485 insertions(+), 545 deletions(-) create mode 100644 resources/clj-kondo.exports/org.mentat/emmy/hooks/emmy/util.clj delete mode 100644 src/emmy/sci/macros.cljc create mode 100644 test/emmy/util/def_test.cljc diff --git a/.dir-locals.el b/.dir-locals.el index 31715bec..6c97ebe1 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,9 +1,9 @@ ((nil . ((cider-print-fn . "emmy.expression/expression->stream") - (cider-default-cljs-repl . node))) - (clojurec-mode - . ((cider-preferred-build-tool . clojure-cli) - (cider-clojure-cli-aliases . ":test:cljs:nextjournal/clerk:dev"))) - (clojure-mode - . ((cider-preferred-build-tool . clojure-cli) - (cider-clojure-cli-aliases . ":test:cljs:nextjournal/clerk:dev")))) + (cider-default-cljs-repl . node) + (cider-preferred-build-tool . clojure-cli) + (cider-clojure-cli-aliases . ":test:cljs:nextjournal/clerk:dev") + + ;; Custom indentation: + (eval . (put-clojure-indent 'sci-macro :defn)) + (eval . (put-clojure-indent 'careful-def 1))))) diff --git a/.github/workflows/kondo.yml b/.github/workflows/kondo.yml index 71dbf479..4f5e77ec 100644 --- a/.github/workflows/kondo.yml +++ b/.github/workflows/kondo.yml @@ -24,5 +24,8 @@ jobs: key: ${{ runner.os }}-kondo restore-keys: ${{ runner.os }}-kondo + - name: Lint dependencies + run: bb lint-deps + - name: Run clj-kondo run: bb lint --config '{:output {:pattern "::{{level}} file={{filename}},line={{row}},col={{col}}::{{message}}"}}' diff --git a/CHANGELOG.md b/CHANGELOG.md index c0ad36bb..fdcc77d9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,29 @@ ## [unreleased] +- #145 (thank you to @mhuebert for amazing work here!!): + + - Adds `emmy.util/sci-macro` for defining macros meant to be exposed via SCI, + without requiring redefinition as a `fn`. + + - Modifies `emmy.sci` so that SCI has access to all of the metadata we need + for a great experience on https://2.maria.cloud and other platforms that use + SCI. + + - Removes some unused `kondo/ignore` metadata and upgrades `clj-kondo` to + 2023.07.13, which caught a couple more errors like a test with no assertion + and a block of tests accidentally included in another test block. + + - Upgrades `emmy.calculus.coordinate/define-coordinates` and + `emmy.util.def/{import-vars,careful-def}` to play nicely with SCI. + + - Resolves the ambiguous `simplify` implementation for subvectors. + + - Adds docstrings to the aliased macros in `emmy.env`. + + - Exposes `emmy.calculus.coordinate/coordinate-functions` as + `emmy.env/coordinate-functions`. + - #143: - Replace the implementation of common subexpression elimination with diff --git a/bb.edn b/bb.edn index 48011f63..3534dd6d 100644 --- a/bb.edn +++ b/bb.edn @@ -1,7 +1,7 @@ {:deps {org.babashka/http-server {:mvn/version "0.1.11"} org.babashka/cli {:mvn/version "0.2.23"} io.github.clj-kondo/clj-kondo-bb - {:git/tag "v2023.01.20" :git/sha "adfc7df"}} + {:git/sha "178b027e827172da0d63122a754bb4d765a6faeb"}} :tasks {:requires ([babashka.cli :as cli]) :init @@ -63,6 +63,15 @@ {:doc "Release the library to Clojars." :task (shell "clojure -T:build publish")} + lint-deps + {:requires ([clj-kondo.core :as kondo]) + :doc "Lint dependencies." + :task (kondo/run! + {:lint [(with-out-str + (babashka.tasks/clojure + "-Spath -A:nextjournal/clerk"))] + :dependencies true})} + lint {:doc "Lint with clj-kondo." :task (exec 'clj-kondo.core/exec) diff --git a/deps.edn b/deps.edn index 8a0c833a..6f32dbba 100644 --- a/deps.edn +++ b/deps.edn @@ -7,7 +7,7 @@ com.taoensso/timbre {:mvn/version "6.0.4"} dm3/stopwatch {:mvn/version "0.1.1" :exclusions [org.clojure/clojurescript]} org.apache.commons/commons-math3 {:mvn/version "3.6.1"} - org.babashka/sci {:mvn/version "0.7.39"} + org.babashka/sci {:mvn/version "0.8.40"} org.mentat/clerk-utils {:mvn/version "0.6.0"}} :aliases diff --git a/resources/clj-kondo.exports/org.mentat/emmy/config.edn b/resources/clj-kondo.exports/org.mentat/emmy/config.edn index 59fbe848..7890cf33 100644 --- a/resources/clj-kondo.exports/org.mentat/emmy/config.edn +++ b/resources/clj-kondo.exports/org.mentat/emmy/config.edn @@ -7,6 +7,7 @@ :lint-as {emmy.numerical.quadrature.common/defintegrator clojure.core/def + emmy.util/sci-macro clojure.core/defmacro emmy.util.def/import-vars potemkin/import-vars emmy.util.def/defgeneric clojure.core/defmulti} @@ -42,6 +43,8 @@ emmy.env/with-literal-functions hooks.emmy.abstract.function/with-literal-functions + emmy.util/copy-ns hooks.emmy.util/copy-ns + emmy.util.def/import-def hooks.emmy.util.def/import-def emmy.util.def/import-macro hooks.emmy.util.def/import-def diff --git a/resources/clj-kondo.exports/org.mentat/emmy/hooks/emmy/util.clj b/resources/clj-kondo.exports/org.mentat/emmy/hooks/emmy/util.clj new file mode 100644 index 00000000..2d0beaab --- /dev/null +++ b/resources/clj-kondo.exports/org.mentat/emmy/hooks/emmy/util.clj @@ -0,0 +1,13 @@ +(ns hooks.emmy.util + (:require [clj-kondo.hooks-api :as api])) + +(defn copy-ns + "Converts a node representing an invocation of the [[emmy.util/copy-ns]] macro + into a vector node that quotes the `ns-sym` and `opts` entries." + [{:keys [node]}] + (let [[_ ns-sym sci-ns opts] (:children node)] + {:node + (api/vector-node + [(api/list-node [(api/token-node 'quote) ns-sym]) + sci-ns + (api/list-node [(api/token-node 'quote) opts])])})) diff --git a/src/emmy/abstract/function.cljc b/src/emmy/abstract/function.cljc index 6fd4ec3b..cbb714b8 100644 --- a/src/emmy/abstract/function.cljc +++ b/src/emmy/abstract/function.cljc @@ -229,7 +229,7 @@ (entry->fn entry)]) litfns))) -(defmacro with-literal-functions [litfns & body] +(u/sci-macro with-literal-functions [litfns & body] (let [pairs (binding-pairs litfns) bindings (into [] cat pairs)] `(let ~bindings ~@body))) diff --git a/src/emmy/algebra/fold.cljc b/src/emmy/algebra/fold.cljc index f6813bc2..665f780b 100644 --- a/src/emmy/algebra/fold.cljc +++ b/src/emmy/algebra/fold.cljc @@ -13,6 +13,7 @@ (:refer-clojure :exclude [min max count]) (:require [clojure.core :as core] [emmy.generic :as g] + [emmy.util :as u] [emmy.util.def :as ud] [mentat.clerk-utils :refer [->clerk ->clerk-only]]) #?(:cljs @@ -483,7 +484,7 @@ (let [~@(mapcat #(klein-term % delta) prefix)] [~@prefix (+ ~final ~delta)]))])) -(defmacro kbk-n +(u/sci-macro kbk-n "Given some order `n`, returns a fold implementing `n`-th order Kahan-Babushka-Klein summation. diff --git a/src/emmy/calculus/coordinate.cljc b/src/emmy/calculus/coordinate.cljc index 6174c99f..7cb71f98 100644 --- a/src/emmy/calculus/coordinate.cljc +++ b/src/emmy/calculus/coordinate.cljc @@ -67,7 +67,7 @@ (symbol? p) [p] :else (u/illegal (str "Invalid coordinate prototype: " p)))) -(defmacro let-coordinates +(u/sci-macro let-coordinates "similar to a `let` binding that holds pairs of , @@ -124,7 +124,7 @@ (map ff/coordinate-system->oneform-basis c-systems#))] ~@body))) -(defmacro using-coordinates +(u/sci-macro using-coordinates "[[using-coordinates]] wraps [[let-coordinates]] and allows you to supply a single coordinate prototype and a single coordinate system. See [[let-coordinates]] for details about what symbols are bound inside the @@ -140,7 +140,7 @@ `(let-coordinates [~coordinate-prototype ~coordinate-system] ~@body)) -(defmacro define-coordinates +(u/sci-macro 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: @@ -156,22 +156,30 @@ - `dx` and `dy` bind to 1-forms for each coordinate." [coordinate-prototype coordinate-system] (let [sys-name (symbol (name coordinate-system)) + value-sym (gensym (str sys-name "-values")) 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 (ud/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)))))) + form-field-names (map ff/coordinate-name->ff-name coord-names)] + `(do + (ud/careful-def ~sys-name + (m/with-coordinate-prototype + ~coordinate-system + ~(quotify-coordinate-prototype coordinate-prototype))) + + (def ~value-sym + (into [] (flatten + [(coordinate-functions ~sys-name) + (vf/coordinate-system->vector-basis ~sys-name) + (ff/coordinate-system->oneform-basis ~sys-name)]))) + + ~@(map-indexed + (fn [i sym] + `(ud/careful-def ~sym (nth ~value-sym ~i))) + (concat coord-names vector-field-names form-field-names)) + + #_{:clj-kondo/ignore [:unresolved-symbol]} + ~(if (or (:sci? &env) #?(:clj (not (:ns &env)))) + `(ns-unmap *ns* '~value-sym) + `(set! ~value-sym nil)) + + (var ~sys-name)))) diff --git a/src/emmy/collection.cljc b/src/emmy/collection.cljc index 997b1efe..e94dd4f6 100644 --- a/src/emmy/collection.cljc +++ b/src/emmy/collection.cljc @@ -33,6 +33,10 @@ (defmethod g/simplify [PersistentVector] [v] (mapv g/simplify v)) +#?(:clj + (defmethod g/simplify [clojure.lang.APersistentVector$SubVector] [v] + (mapv g/simplify v))) + (extend-type #?(:clj IPersistentVector :cljs PersistentVector) v/Value (zero? [v] (every? v/zero? v)) diff --git a/src/emmy/env.cljc b/src/emmy/env.cljc index 4e3195fc..ad980c78 100644 --- a/src/emmy/env.cljc +++ b/src/emmy/env.cljc @@ -76,7 +76,7 @@ [emmy.sr.boost] [emmy.sr.frames] [emmy.structure :as structure] - [emmy.util] + [emmy.util :as u] [emmy.util.aggregate] [emmy.util.def :refer [import-def import-vars]] [emmy.util.permute] @@ -97,7 +97,7 @@ :refer (into [] (keys (ns-publics 'emmy.env)))])) -(defmacro literal-function +(u/sci-macro literal-function ([f] `(af/literal-function ~f)) ([f sicm-signature] (if (and (list? sicm-signature) @@ -107,17 +107,74 @@ ([f domain range] `(af/literal-function ~f ~domain ~range))) -(defmacro with-literal-functions [& args] +(u/sci-macro with-literal-functions [& args] `(af/with-literal-functions ~@args)) -(defmacro let-coordinates [& args] - `(cc/let-coordinates ~@args)) +(u/sci-macro let-coordinates + "similar to a `let` binding that holds pairs of -(defmacro using-coordinates [& args] - `(cc/using-coordinates ~@args)) + , -(defmacro define-coordinates [& args] - `(cc/define-coordinates ~@args)) + And internally binds, for each pair: (take `[x y]` and `m/R2-rect` as + examples): + + - The coordinate system symbol `R2-rect` to a new version of the coordinate + system with its `coordinate-prototype` replaced by the one you supplied. + That's `(up x y)` in this example. + + - the entries `x` and `y` to coordinate functions, i.e., functions from manifold + point to this particular coordinate + + - `d:dx` and `d:dy` vector field procedures (I'm fuzzy here!) + + - `dx` and `dy` 1-forms for each coordinate (fuzzy here too!) + + Example: + + ```clojure + (let-coordinates [[x y] R2-rect + [r theta] R2-polar] + ;; bindings: + ;; R2-rect, x, y, d:dx, d:dy, dx, dy + ;; R2-polar, r, theta, d:dr, d:dtheta, dr, dtheta + body...) + ```" + [bindings & body] + `(cc/let-coordinates ~bindings ~@body)) + +(u/sci-macro using-coordinates + "[[using-coordinates]] wraps [[let-coordinates]] and allows you to supply a + single coordinate prototype and a single coordinate system. + See [[let-coordinates]] for details about what symbols are bound inside the + body. + + Example: + + ```clojure + (using-coordinates (up x y) R2-rect + body...) + ```" + [coordinate-prototype coordinate-system & body] + `(cc/using-coordinates ~coordinate-prototype + ~coordinate-system + ~@body)) + +(u/sci-macro define-coordinates + "Given 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, i.e., 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] + `(cc/define-coordinates ~coordinate-prototype ~coordinate-system)) (defn ref "A shim so that ref can act like nth in SICM contexts, as clojure core ref @@ -307,6 +364,8 @@ make-constant-vector-field Jacobian] + [emmy.calculus.coordinate coordinate-functions] + [emmy.calculus.connection make-Christoffel-1 metric->Christoffel-1 metric->Christoffel-2 diff --git a/src/emmy/numerical/quadrature/common.cljc b/src/emmy/numerical/quadrature/common.cljc index 90fa0a32..f614c6dc 100644 --- a/src/emmy/numerical/quadrature/common.cljc +++ b/src/emmy/numerical/quadrature/common.cljc @@ -6,7 +6,8 @@ - code to wrap a sequence of progressively better estimates in a common `integrator` interface - data structures implementing various integration intervals." (:refer-clojure :exclude [infinite?]) - (:require [emmy.util.stream :as us] + (:require [emmy.util :as u] + [emmy.util.stream :as us] [taoensso.timbre :as log]) #?(:cljs (:require-macros [emmy.numerical.quadrature.common]))) @@ -166,11 +167,11 @@ attr)] [(with-meta name attr) body]))) -(defmacro defintegrator +(u/sci-macro defintegrator "Helper macro for defining integrators." [sym & body] - (let [meta {:arglists (list 'quote '([f a b] [f a b opts]))} - [sym body] (name-with-attributes sym body meta) + (let [meta {:arglists (list 'quote '([f a b] [f a b opts]))} + [sym body] (name-with-attributes sym body meta) {:keys [area-fn seq-fn]} (apply hash-map body)] (assert seq-fn (str "defintegrator " sym ": seq-fn cannot be nil")) (assert area-fn (str "defintegrator " sym ": area-fn cannot be nil")) diff --git a/src/emmy/pattern/rule.cljc b/src/emmy/pattern/rule.cljc index 47d52acc..3b45072f 100644 --- a/src/emmy/pattern/rule.cljc +++ b/src/emmy/pattern/rule.cljc @@ -76,7 +76,7 @@ (m/matcher form pred) (m/matcher form)))) -(defmacro pattern +(u/sci-macro pattern "Takes an unevaluated pattern form (or matcher combinator) and an optional predicate `pred`, and returns a matcher appropriate for passing to [[rule*]]." ([form] @@ -87,7 +87,7 @@ ~(ps/compile-pattern form) ~@(when pred [pred])))) -(defmacro consequence +(u/sci-macro consequence "Accepts a skeleton expression `form` and returns a function from a pattern matcher's binding map to a data structure of identical shape to `skel`, with: @@ -108,7 +108,7 @@ `(fn [~sym] ~(c/compile-skeleton sym form)))) -(defmacro template +(u/sci-macro template "Provided with a single `form`, [[template]] is similar to Clojure's `unquote` facility, except that symbols are not prefixed by namespace. For example: @@ -167,7 +167,7 @@ `(rule* (pattern ~p ~pred) (consequence ~skeleton)))) -(defmacro rule +(u/sci-macro rule "Accepts either: - A pattern written using the syntax from `emmy.pattern.syntax` and a consequence @@ -532,7 +532,7 @@ (attempt (apply choice rules))) -(defmacro ruleset +(u/sci-macro ruleset "Accepts triplets of the form: diff --git a/src/emmy/sci.cljc b/src/emmy/sci.cljc index f8fd2a5a..fe883723 100644 --- a/src/emmy/sci.cljc +++ b/src/emmy/sci.cljc @@ -3,134 +3,89 @@ (ns emmy.sci (:refer-clojure :exclude [ns-map]) (:require [emmy.env] - [emmy.sci.macros :as macros] - [emmy.util :as u] + [emmy.util :refer [copy-ns]] [sci.core :as sci] - [sci.ctx-store])) - -(def macro? (comp :macro meta)) -(def dynamic? (comp :dynamic meta)) - -(defn ns-macros - "Given a map of symbol => var, returns a sequence of the symbols associated with - macro value." - [sym->var] - (mapcat (fn [[sym var]] - (if (macro? var) [sym] [])) - sym->var)) - -(defn sci-ns - "Given a map of symbol => var, returns a map of symbol => var with: - - - any pair removed whose value is a macro (tagged with `:macro true` metadata) - - all other values resolved" - [sym->var] - (letfn [(process [[sym var]] - (cond - ;; Inside SCI, macros are replaced by rewritten-as-functions - ;; versions of themselves, with additional slots for `&form` and - ;; `&env`. We exclude them here so they can be replaced later. - (macro? var) [] - - ;; Keep dynamic variables as unresolved vars, so that they can - ;; at least be inspected (at which point they'll reveal any - ;; rebindings applied by the system) - (dynamic? var) [[sym var]] - - ;; by default, the SCI environment holds values, not the vars - ;; that they were attached to in non-SCI land. - :else [[sym @var]]))] - (into {} (mapcat process) sym->var))) - -(def ns->publics - "Map whose values are the symbols of of all namespaces explicitly - checked and whitelisted for SCI compilation and interesting enough in their own - right to expose to a user by default. Each value is the sym->var map for the - corresponding namespace." - {'emmy.algebra.fold (ns-publics 'emmy.algebra.fold) - 'emmy.complex (ns-publics 'emmy.complex) - 'emmy.differential (ns-publics 'emmy.differential) - 'emmy.env (ns-publics 'emmy.env) - 'emmy.expression (ns-publics 'emmy.expression) - 'emmy.function (ns-publics 'emmy.function) - 'emmy.generic (ns-publics 'emmy.generic) - 'emmy.matrix (ns-publics 'emmy.matrix) - 'emmy.modint (ns-publics 'emmy.modint) - 'emmy.numsymb (ns-publics 'emmy.numsymb) - 'emmy.operator (ns-publics 'emmy.operator) - 'emmy.pattern.consequence (ns-publics 'emmy.pattern.consequence) - 'emmy.pattern.match (ns-publics 'emmy.pattern.match) - 'emmy.pattern.rule (ns-publics 'emmy.pattern.rule) - 'emmy.pattern.syntax (ns-publics 'emmy.pattern.syntax) - 'emmy.polynomial (ns-publics 'emmy.polynomial) - 'emmy.polynomial.factor (ns-publics 'emmy.polynomial.factor) - 'emmy.polynomial.gcd (ns-publics 'emmy.polynomial.gcd) - 'emmy.polynomial.interpolate (ns-publics 'emmy.polynomial.interpolate) - 'emmy.polynomial.richardson (ns-publics 'emmy.polynomial.richardson) - 'emmy.quaternion (ns-publics 'emmy.quaternion) - 'emmy.ratio (ns-publics 'emmy.ratio) - 'emmy.rational-function (ns-publics 'emmy.rational-function) - 'emmy.rational-function.interpolate (ns-publics 'emmy.rational-function.interpolate) - 'emmy.series (ns-publics 'emmy.series) - 'emmy.simplify (ns-publics 'emmy.simplify) - 'emmy.simplify.rules (ns-publics 'emmy.simplify.rules) - 'emmy.structure (ns-publics 'emmy.structure) - 'emmy.util (ns-publics 'emmy.util) - 'emmy.value (ns-publics 'emmy.value) - 'emmy.abstract.function (ns-publics 'emmy.abstract.function) - 'emmy.abstract.number (ns-publics 'emmy.abstract.number) - 'emmy.calculus.basis (ns-publics 'emmy.calculus.basis) - 'emmy.calculus.connection (ns-publics 'emmy.calculus.connection) - 'emmy.calculus.coordinate (ns-publics 'emmy.calculus.coordinate) - 'emmy.calculus.covariant (ns-publics 'emmy.calculus.covariant) - 'emmy.calculus.curvature (ns-publics 'emmy.calculus.curvature) - 'emmy.calculus.derivative (ns-publics 'emmy.calculus.derivative) - 'emmy.calculus.form-field (ns-publics 'emmy.calculus.form-field) - 'emmy.calculus.frame (ns-publics 'emmy.calculus.frame) - 'emmy.calculus.hodge-star (ns-publics 'emmy.calculus.hodge-star) - 'emmy.calculus.indexed (ns-publics 'emmy.calculus.indexed) - 'emmy.calculus.manifold (ns-publics 'emmy.calculus.manifold) - 'emmy.calculus.metric (ns-publics 'emmy.calculus.metric) - 'emmy.calculus.map (ns-publics 'emmy.calculus.map) - 'emmy.calculus.vector-calculus (ns-publics 'emmy.calculus.vector-calculus) - 'emmy.calculus.vector-field (ns-publics 'emmy.calculus.vector-field) - 'emmy.expression.analyze (ns-publics 'emmy.expression.analyze) - 'emmy.expression.compile (ns-publics 'emmy.expression.compile) - 'emmy.expression.cse (ns-publics 'emmy.expression.cse) - 'emmy.expression.render (ns-publics 'emmy.expression.render) - 'emmy.mechanics.lagrange (ns-publics 'emmy.mechanics.lagrange) - 'emmy.mechanics.hamilton (ns-publics 'emmy.mechanics.hamilton) - 'emmy.mechanics.noether (ns-publics 'emmy.mechanics.noether) - 'emmy.mechanics.rigid (ns-publics 'emmy.mechanics.rigid) - 'emmy.mechanics.rotation (ns-publics 'emmy.mechanics.rotation) - 'emmy.mechanics.routhian (ns-publics 'emmy.mechanics.routhian) - 'emmy.mechanics.time-evolution (ns-publics 'emmy.mechanics.time-evolution) - 'emmy.numerical.derivative (ns-publics 'emmy.numerical.derivative) - 'emmy.numerical.minimize (ns-publics 'emmy.numerical.minimize) - 'emmy.numerical.ode (ns-publics 'emmy.numerical.ode) - 'emmy.numerical.quadrature (ns-publics 'emmy.numerical.quadrature) - 'emmy.numerical.multimin.nelder-mead (ns-publics 'emmy.numerical.multimin.nelder-mead) - 'emmy.numerical.unimin.bracket (ns-publics 'emmy.numerical.unimin.bracket) - 'emmy.numerical.unimin.brent (ns-publics 'emmy.numerical.unimin.brent) - 'emmy.numerical.unimin.golden (ns-publics 'emmy.numerical.unimin.golden) - 'emmy.special.elliptic (ns-publics 'emmy.special.elliptic) - 'emmy.special.factorial (ns-publics 'emmy.special.factorial) - 'emmy.sr.boost (ns-publics 'emmy.sr.boost) - 'emmy.sr.frames (ns-publics 'emmy.sr.frames) - 'emmy.util.aggregate (ns-publics 'emmy.util.aggregate) - 'emmy.util.def (ns-publics 'emmy.util.def) - 'emmy.util.logic (ns-publics 'emmy.util.logic) - 'emmy.util.permute (ns-publics 'emmy.util.permute) - 'emmy.util.stream (ns-publics 'emmy.util.stream)}) + [sci.ctx-store]) + #?(:cljs (:require-macros [emmy.sci]))) (def namespaces - "SCI namespace map generated from `ns->publics`. Consumers wishing to use a more - minimal SCI environment should select their desired namespaces from this map. - - Since in normal (not self-hosted) ClojureScript `ns-publics` does not include - macros, they are added explicitly." - (let [ns-map (u/map-vals sci-ns ns->publics)] - (merge-with merge ns-map macros/ns-bindings))) + "SCI namespace map. Consumers wishing to use a more + minimal SCI environment should select their desired namespaces from this map." + {'emmy.algebra.fold (copy-ns emmy.algebra.fold (sci/create-ns 'emmy.algebra.fold)) + 'emmy.complex (copy-ns emmy.complex (sci/create-ns 'emmy.complex)) + 'emmy.differential (copy-ns emmy.differential (sci/create-ns 'emmy.differential)) + 'emmy.env (copy-ns emmy.env (sci/create-ns 'emmy.env)) + 'emmy.expression (copy-ns emmy.expression (sci/create-ns 'emmy.expression)) + 'emmy.function (copy-ns emmy.function (sci/create-ns 'emmy.function)) + 'emmy.generic (copy-ns emmy.generic (sci/create-ns 'emmy.generic)) + 'emmy.matrix (copy-ns emmy.matrix (sci/create-ns 'emmy.matrix)) + 'emmy.modint (copy-ns emmy.modint (sci/create-ns 'emmy.modint)) + 'emmy.numsymb (copy-ns emmy.numsymb (sci/create-ns 'emmy.numsymb)) + 'emmy.operator (copy-ns emmy.operator (sci/create-ns 'emmy.operator)) + 'emmy.pattern.consequence (copy-ns emmy.pattern.consequence (sci/create-ns 'emmy.pattern.consequence)) + 'emmy.pattern.match (copy-ns emmy.pattern.match (sci/create-ns 'emmy.pattern.match)) + 'emmy.pattern.rule (copy-ns emmy.pattern.rule (sci/create-ns 'emmy.pattern.rule)) + 'emmy.pattern.syntax (copy-ns emmy.pattern.syntax (sci/create-ns 'emmy.pattern.syntax)) + 'emmy.polynomial (copy-ns emmy.polynomial (sci/create-ns 'emmy.polynomial)) + 'emmy.polynomial.factor (copy-ns emmy.polynomial.factor (sci/create-ns 'emmy.polynomial.factor)) + 'emmy.polynomial.gcd (copy-ns emmy.polynomial.gcd (sci/create-ns 'emmy.polynomial.gcd)) + 'emmy.polynomial.interpolate (copy-ns emmy.polynomial.interpolate (sci/create-ns 'emmy.polynomial.interpolate)) + 'emmy.polynomial.richardson (copy-ns emmy.polynomial.richardson (sci/create-ns 'emmy.polynomial.richardson)) + 'emmy.quaternion (copy-ns emmy.quaternion (sci/create-ns 'emmy.quaternion)) + 'emmy.ratio (copy-ns emmy.ratio (sci/create-ns 'emmy.ratio)) + 'emmy.rational-function (copy-ns emmy.rational-function (sci/create-ns 'emmy.rational-function)) + 'emmy.rational-function.interpolate (copy-ns emmy.rational-function.interpolate (sci/create-ns 'emmy.rational-function.interpolate)) + 'emmy.series (copy-ns emmy.series (sci/create-ns 'emmy.series)) + 'emmy.simplify (copy-ns emmy.simplify (sci/create-ns 'emmy.simplify)) + 'emmy.simplify.rules (copy-ns emmy.simplify.rules (sci/create-ns 'emmy.simplify.rules)) + 'emmy.structure (copy-ns emmy.structure (sci/create-ns 'emmy.structure)) + 'emmy.util (copy-ns emmy.util (sci/create-ns 'emmy.util)) + 'emmy.value (copy-ns emmy.value (sci/create-ns 'emmy.value)) + 'emmy.abstract.function (copy-ns emmy.abstract.function (sci/create-ns 'emmy.abstract.function)) + 'emmy.abstract.number (copy-ns emmy.abstract.number (sci/create-ns 'emmy.abstract.number)) + 'emmy.calculus.basis (copy-ns emmy.calculus.basis (sci/create-ns 'emmy.calculus.basis)) + 'emmy.calculus.connection (copy-ns emmy.calculus.connection (sci/create-ns 'emmy.calculus.connection)) + 'emmy.calculus.coordinate (copy-ns emmy.calculus.coordinate (sci/create-ns 'emmy.calculus.coordinate)) + 'emmy.calculus.covariant (copy-ns emmy.calculus.covariant (sci/create-ns 'emmy.calculus.covariant)) + 'emmy.calculus.curvature (copy-ns emmy.calculus.curvature (sci/create-ns 'emmy.calculus.curvature)) + 'emmy.calculus.derivative (copy-ns emmy.calculus.derivative (sci/create-ns 'emmy.calculus.derivative)) + 'emmy.calculus.form-field (copy-ns emmy.calculus.form-field (sci/create-ns 'emmy.calculus.form-field)) + 'emmy.calculus.frame (copy-ns emmy.calculus.frame (sci/create-ns 'emmy.calculus.frame)) + 'emmy.calculus.hodge-star (copy-ns emmy.calculus.hodge-star (sci/create-ns 'emmy.calculus.hodge-star)) + 'emmy.calculus.indexed (copy-ns emmy.calculus.indexed (sci/create-ns 'emmy.calculus.indexed)) + 'emmy.calculus.manifold (copy-ns emmy.calculus.manifold (sci/create-ns 'emmy.calculus.manifold)) + 'emmy.calculus.metric (copy-ns emmy.calculus.metric (sci/create-ns 'emmy.calculus.metric)) + 'emmy.calculus.map (copy-ns emmy.calculus.map (sci/create-ns 'emmy.calculus.map)) + 'emmy.calculus.vector-calculus (copy-ns emmy.calculus.vector-calculus (sci/create-ns 'emmy.calculus.vector-calculus)) + 'emmy.calculus.vector-field (copy-ns emmy.calculus.vector-field (sci/create-ns 'emmy.calculus.vector-field)) + 'emmy.expression.analyze (copy-ns emmy.expression.analyze (sci/create-ns 'emmy.expression.analyze)) + 'emmy.expression.compile (copy-ns emmy.expression.compile (sci/create-ns 'emmy.expression.compile)) + 'emmy.expression.cse (copy-ns emmy.expression.cse (sci/create-ns 'emmy.expression.cse)) + 'emmy.expression.render (copy-ns emmy.expression.render (sci/create-ns 'emmy.expression.render)) + 'emmy.mechanics.lagrange (copy-ns emmy.mechanics.lagrange (sci/create-ns 'emmy.mechanics.lagrange)) + 'emmy.mechanics.hamilton (copy-ns emmy.mechanics.hamilton (sci/create-ns 'emmy.mechanics.hamilton)) + 'emmy.mechanics.noether (copy-ns emmy.mechanics.noether (sci/create-ns 'emmy.mechanics.noether)) + 'emmy.mechanics.rigid (copy-ns emmy.mechanics.rigid (sci/create-ns 'emmy.mechanics.rigid)) + 'emmy.mechanics.rotation (copy-ns emmy.mechanics.rotation (sci/create-ns 'emmy.mechanics.rotation)) + 'emmy.mechanics.routhian (copy-ns emmy.mechanics.routhian (sci/create-ns 'emmy.mechanics.routhian)) + 'emmy.mechanics.time-evolution (copy-ns emmy.mechanics.time-evolution (sci/create-ns 'emmy.mechanics.time-evolution)) + 'emmy.numerical.derivative (copy-ns emmy.numerical.derivative (sci/create-ns 'emmy.numerical.derivative)) + 'emmy.numerical.minimize (copy-ns emmy.numerical.minimize (sci/create-ns 'emmy.numerical.minimize)) + 'emmy.numerical.ode (copy-ns emmy.numerical.ode (sci/create-ns 'emmy.numerical.ode)) + 'emmy.numerical.quadrature (copy-ns emmy.numerical.quadrature (sci/create-ns 'emmy.numerical.quadrature)) + 'emmy.numerical.multimin.nelder-mead (copy-ns emmy.numerical.multimin.nelder-mead (sci/create-ns 'emmy.numerical.multimin.nelder-mead)) + 'emmy.numerical.unimin.bracket (copy-ns emmy.numerical.unimin.bracket (sci/create-ns 'emmy.numerical.unimin.bracket)) + 'emmy.numerical.unimin.brent (copy-ns emmy.numerical.unimin.brent (sci/create-ns 'emmy.numerical.unimin.brent)) + 'emmy.numerical.unimin.golden (copy-ns emmy.numerical.unimin.golden (sci/create-ns 'emmy.numerical.unimin.golden)) + 'emmy.special.elliptic (copy-ns emmy.special.elliptic (sci/create-ns 'emmy.special.elliptic)) + 'emmy.special.factorial (copy-ns emmy.special.factorial (sci/create-ns 'emmy.special.factorial)) + 'emmy.sr.boost (copy-ns emmy.sr.boost (sci/create-ns 'emmy.sr.boost)) + 'emmy.sr.frames (copy-ns emmy.sr.frames (sci/create-ns 'emmy.sr.frames)) + 'emmy.util.aggregate (copy-ns emmy.util.aggregate (sci/create-ns 'emmy.util.aggregate)) + 'emmy.util.def (copy-ns emmy.util.def (sci/create-ns 'emmy.util.def)) + 'emmy.util.logic (copy-ns emmy.util.logic (sci/create-ns 'emmy.util.logic)) + 'emmy.util.permute (copy-ns emmy.util.permute (sci/create-ns 'emmy.util.permute)) + 'emmy.util.stream (copy-ns emmy.util.stream (sci/create-ns 'emmy.util.stream))}) (def config "Default sci context options required (currently only `:namespace` diff --git a/src/emmy/sci/macros.cljc b/src/emmy/sci/macros.cljc deleted file mode 100644 index d44771ab..00000000 --- a/src/emmy/sci/macros.cljc +++ /dev/null @@ -1,199 +0,0 @@ -#_"SPDX-License-Identifier: GPL-3.0" - -(ns emmy.sci.macros - "This namespace contains reimplementations of various macros from emmy, - defined in the form required by SCI." - (:require [emmy.abstract.function :as af] - [emmy.algebra.fold :as fold] - [emmy.calculus.coordinate :as cc] - [emmy.calculus.form-field :as ff] - [emmy.calculus.manifold :as m] - [emmy.calculus.vector-field :as vf] - [emmy.pattern.consequence :as pc] - [emmy.pattern.rule :as r] - [emmy.pattern.syntax :as ps] - [emmy.util :as u])) - -;; ## Pattern Matching Macros - -(defn pattern - "Originally defined in `emmy.pattern.rule`." - ([_ _ form] - `(r/pattern* - ~(ps/compile-pattern form))) - ([_ _ form pred] - `(r/pattern* - ~(ps/compile-pattern form) - ~@(when pred [pred])))) - -(defn consequence - "Originally defined in `emmy.pattern.rule`." - [_ _ form] - (let [sym (gensym)] - `(fn [~sym] - ~(pc/compile-skeleton sym form)))) - -(defn template - "Originally defined in `emmy.pattern.rule`." - ([_ _ form] - (pc/compile-skeleton (gensym) form)) - ([_ _ m form] - (let [sym (gensym)] - `(let [~sym ~m] - ~(pc/compile-skeleton sym form))))) - -(defn rule - ([_ _ pattern consequent-fn] - (r/compile-rule pattern consequent-fn)) - ([_ _ pattern pred skeleton] - (r/compile-rule pattern pred skeleton))) - -(defn ruleset - "Originally defined in `emmy.pattern.rule`." - [_ _ & patterns-and-consequences] - {:pre (zero? (mod (count patterns-and-consequences) 3))} - (let [inputs (partition 3 patterns-and-consequences) - rules (map #(apply r/compile-rule %) inputs)] - `(r/ruleset* ~@rules))) - -;; ## Fold Macros - -(defn kbk-n - "Originally defined in `emmy.algebra.fold`." - [_ _ n] - `(fn ~@(fold/kbk-n-body n))) - -(defn fork - "Originally defined in `emmy.util.def`." - [_ _&env & {:keys [cljs clj]}] - (if (contains? _&env '&env) - `(if (:ns ~'&env) ~cljs ~clj) - (if #?(:clj (:ns _&env) :cljs true) - cljs - clj))) - -;; ## Emmy Macros - -(defn literal-function - "Originally defined in `emmy.env`." - ([_ _ f] `(af/literal-function ~f)) - ([_ _ f sicm-signature] - (if (and (list? sicm-signature) - (= '-> (first sicm-signature))) - `(af/literal-function ~f '~sicm-signature) - `(af/literal-function ~f ~sicm-signature))) - ([_ _ f domain range] - `(af/literal-function ~f ~domain ~range))) - -(defn with-literal-functions - "Originally defined in `emmy.abstract.function`." - [_ _ litfns & body] - (let [pairs (af/binding-pairs litfns) - bindings (into [] cat pairs)] - `(let ~bindings ~@body))) - -(defn let-coordinates - "Originally defined in `emmy.calculus.coordinate`." - [_ _ bindings & body] - (when-not (even? (count bindings)) - (u/illegal "let-coordinates requires an even number of bindings")) - (let [pairs (partition 2 bindings) - prototypes (map first pairs) - c-systems (map second pairs) - system-names (map (comp symbol name) c-systems) - coordinate-names (mapcat cc/symbols-from-prototype prototypes) - coordinate-vector-field-names (map vf/coordinate-name->vf-name coordinate-names) - coordinate-form-field-names (map ff/coordinate-name->ff-name coordinate-names)] - `(let [[~@system-names :as c-systems#] - (mapv m/with-coordinate-prototype - ~(into [] c-systems) - ~(mapv cc/quotify-coordinate-prototype prototypes)) - - ~(into [] coordinate-names) - (flatten - (map cc/coordinate-functions c-systems#)) - - ~(into [] coordinate-vector-field-names) - (flatten - (map vf/coordinate-system->vector-basis c-systems#)) - - ~(into [] coordinate-form-field-names) - (flatten - (map ff/coordinate-system->oneform-basis c-systems#))] - ~@body))) - -(defn using-coordinates - "Originally defined in `emmy.calculus.coordinate`." - [env form coordinate-prototype coordinate-system & body] - (apply let-coordinates - env form - [coordinate-prototype coordinate-system] - body)) - -(defn define-coordinates - "Originally defined in `emmy.calculus.coordinate`." - [_ _ coordinate-prototype coordinate-system] - (let [sys-name (symbol (name coordinate-system)) - coord-names (cc/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 (fn [sym form] - `(do (clojure.core/ns-unmap *ns* '~sym) - (clojure.core/intern *ns* '~sym ~form)))] - `(let [~sys-sym (m/with-coordinate-prototype - ~coordinate-system - ~(cc/quotify-coordinate-prototype coordinate-prototype))] - ~(bind sys-name sys-sym) - (let [~value-sym - (into [] (flatten - [(cc/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)))))) - -(defn- tag-as-macro [f] - (vary-meta f assoc :sci/macro true)) - -(def all - {'kbk-n (tag-as-macro kbk-n) - 'literal-function (tag-as-macro literal-function) - 'with-literal-functions (tag-as-macro with-literal-functions) - 'let-coordinates (tag-as-macro let-coordinates) - 'using-coordinates (tag-as-macro using-coordinates) - 'define-coordinates (tag-as-macro define-coordinates) - 'fork (tag-as-macro fork)}) - -(def pattern-macros - {'pattern (tag-as-macro pattern) - 'consequence (tag-as-macro consequence) - 'template (tag-as-macro template) - 'rule (tag-as-macro rule) - 'ruleset (tag-as-macro ruleset)}) - -(def ns-bindings - {'emmy.pattern.rule pattern-macros - - 'emmy.env - (select-keys all ['literal-function - 'with-literal-functions - 'let-coordinates - 'using-coordinates - 'define-coordinates]) - - 'emmy.abstract.function - (select-keys all ['with-literal-functions]) - - 'emmy.algebra.fold - (select-keys all ['kbk-n]) - - 'emmy.calculus.coordinate - (select-keys all ['let-coordinates 'using-coordinates - 'define-coordinates]) - - 'emmy.util.def - (select-keys all ['fork])}) diff --git a/src/emmy/sr/frames.cljc b/src/emmy/sr/frames.cljc index f2bd2d5c..439fc400 100644 --- a/src/emmy/sr/frames.cljc +++ b/src/emmy/sr/frames.cljc @@ -75,7 +75,6 @@ ;; ### The background frame (defn base-frame-point [_ this-frame _] - #_{:clj-kondo/ignore [:redundant-fn-wrapper]} (fn [coords] {:pre [(SR-coordinates? coords) (= this-frame (cf/frame-owner coords))]} diff --git a/src/emmy/util.cljc b/src/emmy/util.cljc index 980dfeb0..3a0f110f 100644 --- a/src/emmy/util.cljc +++ b/src/emmy/util.cljc @@ -11,7 +11,9 @@ #?(:clj (:import (clojure.lang BigInt) (java.util UUID) - (java.util.concurrent TimeoutException)))) + (java.util.concurrent TimeoutException))) + #?(:cljs + (:require-macros [emmy.util]))) (defn counted "Takes a function and returns a pair of: @@ -135,3 +137,34 @@ in `clojure.core` vs. `cljs.core` is unimportant" [x] (w/postwalk (fn [s] (if (qualified-symbol? s) (symbol (name s)) s)) x)) + +(defmacro sci-macro + "Like `defmacro` but when emitting cljs, emits a function + with &env and &form prepended to arglists and :sci/macro metadata, + so that the macro can be imported into sci using copy-var." + [name & body] + (if (:ns &env) + (let [[doc body] (if (string? (first body)) + [(first body) (rest body)] + [nil body]) + [options body] (if (map? (first body)) + [(first body) (rest body)] + [nil body]) + arities (if (vector? (first body)) (list body) body) + arities (map (fn [[argv & body]] + (list (into '[&form &env] argv) + `(let [~'&env (assoc ~'&env :sci? true)] + ~@body))) arities)] + `(defn ~(vary-meta name assoc :sci/macro true) + ~@(when doc [doc]) + ~@(when options [options]) + ~@arities)) + `(~'clojure.core/defmacro ~name ~@body))) + +(defmacro copy-ns + ([ns-sym sci-ns] `(copy-ns ~ns-sym ~sci-ns nil)) + ([ns-sym sci-ns opts] + (list 'sci.core/copy-ns + ns-sym + sci-ns + (merge {:copy-meta [:doc :arglists :macro :sci/macro :imported-from]} opts)))) diff --git a/src/emmy/util/def.cljc b/src/emmy/util/def.cljc index fcb048b2..a2b351c9 100644 --- a/src/emmy/util/def.cljc +++ b/src/emmy/util/def.cljc @@ -1,18 +1,19 @@ #_"SPDX-License-Identifier: GPL-3.0" (ns emmy.util.def - (:require [emmy.util :as u] - #?(:cljs [cljs.analyzer.api :as aa])) - #?(:clj - (:import (clojure.lang Keyword RT))) + (:require [cljs.analyzer.api :as aa] + [emmy.util :as u]) #?(:cljs - (:require-macros [emmy.util.def]))) + (:require-macros [emmy.util.def])) + #?(:clj + (:import (clojure.lang Keyword RT)))) -(defmacro ^:no-doc fork +(u/sci-macro fork "I borrowed this lovely, mysterious macro from `macrovich`: - https://github.com/cgrand/macrovich. This allows us to fork behavior inside of - a macro at macroexpansion time, not at read time." + https://github.com/cgrand/macrovich. This allows us to fork behavior inside + of a macro at macroexpansion time, not at read time." [& {:keys [cljs clj]}] + #_{:clj-kondo/ignore [:unresolved-symbol]} (if (contains? &env '&env) `(if (:ns ~'&env) ~cljs ~clj) (if #?(:clj (:ns &env) :cljs true) @@ -47,7 +48,7 @@ (alter-var-root dst (constantly @src)) (alter-meta! dst merge (dissoc (meta src) :name)))))) -(defmacro defgeneric +(u/sci-macro defgeneric "Defines a multifn using the provided symbol. Arranges for the multifn to answer the :arity message, reporting either `[:exactly a]` or `[:between a b]` according to the arguments given. @@ -66,21 +67,21 @@ Any remaining options are passed along to `defmulti`." {:arglists '([name arities docstring? attr-map? & options])} [f arities & options] - (let [[a b] (if (vector? arities) arities [arities]) - arity (if b [:between a b] [:exactly a]) - docstring (if (string? (first options)) - (str "generic " f ".\n\n" (first options)) - (str "generic " f)) - options (if (string? (first options)) - (next options) - options) + (let [[a b] (if (vector? arities) arities [arities]) + arity (if b [:between a b] [:exactly a]) + docstring (if (string? (first options)) + (str "generic " f ".\n\n" (first options)) + (str "generic " f)) + options (if (string? (first options)) + (next options) + options) [attr options] (if (map? (first options)) [(first options) (next options)] [{} options]) - kwd-klass (fork :clj Keyword :cljs 'cljs.core/Keyword) - attr (assoc attr - :arity arity - :name (:name attr `'~f))] + kwd-klass (fork :clj Keyword :cljs 'cljs.core/Keyword) + attr (assoc attr + :arity arity + :name (:name attr `'~f))] `(do (defmulti ~f ~docstring @@ -117,12 +118,27 @@ :clj `(do - (def ~n ~@vr) + (def ~n @~vr) (alter-meta! (var ~n) merge (dissoc (meta ~vr) :name)) (.setMacro (var ~n)) (link-vars ~vr (var ~n)) ~vr))))) +(defn update-some [m fns] + (reduce-kv (fn [m k f] + (if-some [v (get m k)] + (assoc m k (f v)) + m)) m fns)) + +(defn var-meta [env sym] + (let [vr #?(:clj (if (:ns env) + (aa/resolve env sym) + (resolve sym)) + :cljs (aa/resolve env sym))] + (if (map? vr) + vr + (meta vr)))) + (defmacro import-def "Given a regular def'd var from another namespace, defined a new var with the same name in the current namespace. @@ -140,23 +156,23 @@ ([sym] `(import-def ~sym nil)) ([sym var-name] - (let [vr #?(:clj (resolve sym) :cljs (aa/resolve &env sym)) - m (meta vr) - n (or var-name (:name m)) - n (with-meta n (if (:dynamic m) {:dynamic true} {}))] - (when-not vr + (let [m (var-meta &env sym) + n (or var-name (-> (:name m) name symbol)) + quoted-meta (-> (select-keys m [:dynamic :doc :arglists]) + (update-some {:arglists #(list 'quote %)}) + (assoc :imported-from (list 'quote (:name m))))] + (when-not m (u/illegal (str "Don't recognize " sym))) (when (:macro m) (u/illegal (str "Calling import-def on a macro: " sym))) - (fork - :cljs `(def ~n ~sym) - :clj - `(do - (def ~n @~vr) - (alter-meta! (var ~n) merge (dissoc (meta ~vr) :name)) - (link-vars ~vr (var ~n)) - ~vr))))) + (if (:ns &env) + `(def ~(with-meta n quoted-meta) ~sym) + `(let [v# (var ~sym)] + (def ~n ~sym) + (alter-meta! (var ~n) merge (dissoc (meta v#) :name)) + (link-vars v# (var ~n)) + v#))))) (defmacro import-vars "import multiple defs from multiple namespaces. works for vars and fns, macros @@ -194,19 +210,17 @@ `(do ~@(map (fn [sym] - (let [vr #?(:clj (resolve sym) :cljs (aa/resolve &env sym)) - m (meta vr)] + (let [m (var-meta &env sym)] (cond - (nil? vr) `(throw - (ex-info (format "`%s` does not exist" '~sym) {})) + (nil? m) `(throw + (ex-info (format "`%s` does not exist" '~sym) {})) (:macro m) `(import-macro ~sym) - :else `(import-def ~sym)))) + :else `(import-def ~sym)))) imports))))) -#_{:clj-kondo/ignore [:redundant-fn-wrapper]} -(defn careful-def - "Given some namespace `ns`, returns a function of some binding symbol and a form - to bind. The function returns either +(u/sci-macro careful-def + "Given some namespace `ns`, returns a function of some binding symbol and a + form to bind. The function returns either - A form like `(def ~sym ~form)`, if `sym` is not currently bound into `ns` @@ -220,32 +234,33 @@ (In ClojureScript, only forms like `(def ~sym ~form)` are emitted, since the compiler does not currently error in case 2 and already handles emitting the warning for us.)" - [#?(:clj ns :cljs _)] - #?(: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] - `(.println - (RT/errPrintWriter) - (str "WARNING: " - '~sym - " already refers to: " - ~(nsm sym) - " 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)))))) + [sym form] + (let [value-sym (gensym (str sym "-value")) + #?@(:clj + [ns-sym (symbol (str *ns*)) + nsm (ns-map *ns*) + remote? (fn [sym] + (when-let [v (nsm sym)] + (not= *ns* (:ns (meta v))))) + warn (fn [sym] + `(.println + (RT/errPrintWriter) + (str "WARNING: " + '~sym + " already refers to: " + ~(nsm sym) + " in namespace: " + '~ns-sym + ", being replaced by: " + ~(str "#'" ns-sym "/" sym))))])] + (if (or (:sci? &env) #?(:clj (not (:ns &env)))) + `(do + #?(:clj ~(when (remote? sym) + (warn sym))) + ;; ns-unmap only works at top level + (def ~value-sym ~form) + (ns-unmap *ns* '~sym) + (def ~sym ~value-sym) + (ns-unmap *ns* '~value-sym) + (var ~sym)) + `(def ~sym ~form)))) diff --git a/test/emmy/pattern/rule_test.cljc b/test/emmy/pattern/rule_test.cljc index 1a257569..5478613b 100644 --- a/test/emmy/pattern/rule_test.cljc +++ b/test/emmy/pattern/rule_test.cljc @@ -37,14 +37,11 @@ {'?x 1 '?y 2 'y 3})) "consequence can splice in a matching symbol"))) -#_{:clj-kondo/ignore [:redundant-fn-wrapper]} (deftest template-tests - ;; `f` is here to check the linter. - (let [f identity] - (is (= '(+ 1 {}) - (r/template (+ 1 (? (fn [m] (f m)))))) - "one-arg template works even with a binding form inside expecting a map. - In this case the map will ALWAYS be equal to {}"))) + (is (= '(+ 1 {}) + (r/template (+ 1 (? ~identity)))) + "one-arg template works even with a binding form inside expecting a map. + In this case the map will ALWAYS be equal to {}")) (deftest rule-tests (testing "pattern* builds a matcher" diff --git a/test/emmy/series_test.cljc b/test/emmy/series_test.cljc index 4559f538..e66a1004 100644 --- a/test/emmy/series_test.cljc +++ b/test/emmy/series_test.cljc @@ -272,7 +272,15 @@ (testing "a series of fns is a fn too" (let [nats*index-series (-> (fn [i] (g/* i nats)) (s/generate ::s/series))] - (take 6 (nats*index-series 'x)))))) + (is (= '(0 + 1 + (+ (* 2 x) 2) + (+ (* 3 (expt x 2)) (* 4 x) 3) + (+ (* 4 (expt x 3)) (* 6 (expt x 2)) (* 6 x) 4) + (+ (* 5 (expt x 4)) (* 8 (expt x 3)) (* 9 (expt x 2)) (* 8 x) 5)) + (v/freeze + (g/simplify + (take 6 (nats*index-series 'x)))))))))) (deftest series-specific-tests (let [Q (s/power-series 4) diff --git a/test/emmy/sicm/ch3_test.cljc b/test/emmy/sicm/ch3_test.cljc index 19f7444c..eca6abdf 100644 --- a/test/emmy/sicm/ch3_test.cljc +++ b/test/emmy/sicm/ch3_test.cljc @@ -209,88 +209,88 @@ " const _61 = [_08, _33, _60];" " return _61;"]))] (c/compile-state-fn (fn [] sysder) [] top-state - {:mode :js - :gensym-fn (a/monotonic-symbol-generator 2)}))))) + {:mode :js + :gensym-fn (a/monotonic-symbol-generator 2)})))))) - (deftest section-3-5 - (testing "p.221" - (let [H ((e/Lagrangian->Hamiltonian - (driven/L 'm 'l 'g 'a 'omega)) - (up 't 'theta 'p_theta))] - (is (= '(/ (+ (* (/ -1 2) - (expt a 2) (expt l 2) (expt m 2) - (expt omega 2) - (expt (sin (* omega t)) 2) - (expt (cos theta) 2)) - (* a g (expt l 2) (expt m 2) (cos (* omega t))) - (* a l m omega p_theta (sin (* omega t)) (sin theta)) - (* -1 g (expt l 3) (expt m 2) (cos theta)) - (* (/ 1 2) (expt p_theta 2))) - (* (expt l 2) m)) - (simplify H)))) - (let [sysder (simplify - ((e/Hamiltonian->state-derivative - (e/Lagrangian->Hamiltonian - (driven/L 'm 'l 'g 'a 'omega))) - (up 't 'theta 'p_theta)))] - (is (= '(up 1 - (/ (+ (* a l m omega (sin (* omega t)) (sin theta)) p_theta) - (* (expt l 2) m)) - (/ (+ (* -1 (expt a 2) l m (expt omega 2) (expt (sin (* omega t)) 2) (sin theta) (cos theta)) - (* -1 a omega p_theta (sin (* omega t)) (cos theta)) - (* -1 g (expt l 2) m (sin theta))) - l)) - sysder)) +(deftest section-3-5 + (testing "p.221" + (let [H ((e/Lagrangian->Hamiltonian + (driven/L 'm 'l 'g 'a 'omega)) + (up 't 'theta 'p_theta))] + (is (= '(/ (+ (* (/ -1 2) + (expt a 2) (expt l 2) (expt m 2) + (expt omega 2) + (expt (sin (* omega t)) 2) + (expt (cos theta) 2)) + (* a g (expt l 2) (expt m 2) (cos (* omega t))) + (* a l m omega p_theta (sin (* omega t)) (sin theta)) + (* -1 g (expt l 3) (expt m 2) (cos theta)) + (* (/ 1 2) (expt p_theta 2))) + (* (expt l 2) m)) + (simplify H)))) + (let [sysder (simplify + ((e/Hamiltonian->state-derivative + (e/Lagrangian->Hamiltonian + (driven/L 'm 'l 'g 'a 'omega))) + (up 't 'theta 'p_theta)))] + (is (= '(up 1 + (/ (+ (* a l m omega (sin (* omega t)) (sin theta)) p_theta) + (* (expt l 2) m)) + (/ (+ (* -1 (expt a 2) l m (expt omega 2) (expt (sin (* omega t)) 2) (sin theta) (cos theta)) + (* -1 a omega p_theta (sin (* omega t)) (cos theta)) + (* -1 g (expt l 2) m (sin theta))) + l)) + sysder)) - (is (= ["[y01, y02, y03]" - "_" - (maybe-defloatify - (s/join "\n" [" const _04 = 1.0;" - " const _05 = a * l;" - " const _06 = _05 * m;" - " const _07 = _06 * omega;" - " const _08 = omega * y01;" - " const _09 = Math.sin(_08);" - " const _10 = _07 * _09;" - " const _11 = Math.sin(y02);" - " const _12 = _10 * _11;" - " const _13 = _12 + y03;" - " const _14 = 2.0;" - " const _15 = Math.pow(l, _14);" - " const _16 = _15 * m;" - " const _17 = _13 / _16;" - " const _18 = -1.0;" - " const _19 = Math.pow(a, _14);" - " const _20 = _18 * _19;" - " const _21 = _20 * l;" - " const _22 = _21 * m;" - " const _23 = Math.pow(omega, _14);" - " const _24 = _22 * _23;" - " const _25 = Math.pow(_09, _14);" - " const _26 = _24 * _25;" - " const _27 = _26 * _11;" - " const _28 = Math.cos(y02);" - " const _29 = _27 * _28;" - " const _30 = _18 * a;" - " const _31 = _30 * omega;" - " const _32 = _31 * y03;" - " const _33 = _32 * _09;" - " const _34 = _33 * _28;" - " const _35 = _29 + _34;" - " const _36 = _18 * g;" - " const _37 = _36 * _15;" - " const _38 = _37 * m;" - " const _39 = _38 * _11;" - " const _40 = _35 + _39;" - " const _41 = _40 / l;" - " const _42 = [_04, _17, _41];" - " return _42;"]))] - (c/compile-state-fn - (fn [] - (e/Hamiltonian->state-derivative - (e/Lagrangian->Hamiltonian - (driven/L 'm 'l 'g 'a 'omega)))) - [] - (up 't 'theta 'p_theta) - {:mode :js - :gensym-fn (a/monotonic-symbol-generator 2)}))))))) + (is (= ["[y01, y02, y03]" + "_" + (maybe-defloatify + (s/join "\n" [" const _04 = 1.0;" + " const _05 = a * l;" + " const _06 = _05 * m;" + " const _07 = _06 * omega;" + " const _08 = omega * y01;" + " const _09 = Math.sin(_08);" + " const _10 = _07 * _09;" + " const _11 = Math.sin(y02);" + " const _12 = _10 * _11;" + " const _13 = _12 + y03;" + " const _14 = 2.0;" + " const _15 = Math.pow(l, _14);" + " const _16 = _15 * m;" + " const _17 = _13 / _16;" + " const _18 = -1.0;" + " const _19 = Math.pow(a, _14);" + " const _20 = _18 * _19;" + " const _21 = _20 * l;" + " const _22 = _21 * m;" + " const _23 = Math.pow(omega, _14);" + " const _24 = _22 * _23;" + " const _25 = Math.pow(_09, _14);" + " const _26 = _24 * _25;" + " const _27 = _26 * _11;" + " const _28 = Math.cos(y02);" + " const _29 = _27 * _28;" + " const _30 = _18 * a;" + " const _31 = _30 * omega;" + " const _32 = _31 * y03;" + " const _33 = _32 * _09;" + " const _34 = _33 * _28;" + " const _35 = _29 + _34;" + " const _36 = _18 * g;" + " const _37 = _36 * _15;" + " const _38 = _37 * m;" + " const _39 = _38 * _11;" + " const _40 = _35 + _39;" + " const _41 = _40 / l;" + " const _42 = [_04, _17, _41];" + " return _42;"]))] + (c/compile-state-fn + (fn [] + (e/Hamiltonian->state-derivative + (e/Lagrangian->Hamiltonian + (driven/L 'm 'l 'g 'a 'omega)))) + [] + (up 't 'theta 'p_theta) + {:mode :js + :gensym-fn (a/monotonic-symbol-generator 2)})))))) diff --git a/test/emmy/sicm/ch5_test.cljc b/test/emmy/sicm/ch5_test.cljc index 96922d29..598f199b 100644 --- a/test/emmy/sicm/ch5_test.cljc +++ b/test/emmy/sicm/ch5_test.cljc @@ -146,7 +146,6 @@ (simplify (- (omega zeta1 zeta2) (omega (* DCs zeta1) (* DCs zeta2))))))))) -#_{:clj-kondo/ignore [:unused-binding]} (deftest section-5-7 (let [;; going further means solving exercise 5.22. ;; XXX at the moment, nothing below is tested, because we have to think @@ -170,9 +169,9 @@ (((C alpha omega omega0) (- t (first state0))) state0)))) sol ((solution 'α 'ω 'ω_0) (up 't_0 'q_0 'p_0)) solution-C (sol 't) - q (ref solution-C 0) - p (ref solution-C 1) - Dsol ((D sol) 't)])) + _q (ref solution-C 0) + _p (ref solution-C 1) + _Dsol ((D sol) 't)])) (deftest section-5-10 (letfn [(H-harmonic [m k] diff --git a/test/emmy/tex_web_test.clj b/test/emmy/tex_web_test.clj index 9fad6862..b79cd1be 100644 --- a/test/emmy/tex_web_test.clj +++ b/test/emmy/tex_web_test.clj @@ -1,6 +1,5 @@ #_"SPDX-License-Identifier: GPL-3.0" -#_{:clj-kondo/ignore [:refer-all]} (ns emmy.tex-web-test (:refer-clojure :exclude [+ - * / = compare ref partial zero? numerator denominator]) (:require [emmy.env :as e :refer :all] diff --git a/test/emmy/util/def_test.cljc b/test/emmy/util/def_test.cljc new file mode 100644 index 00000000..e145ac5a --- /dev/null +++ b/test/emmy/util/def_test.cljc @@ -0,0 +1,11 @@ +(ns emmy.util.def-test + (:require [clojure.test :refer [deftest is]] + [emmy.util :as u] + [emmy.util.def :as d])) + +(d/import-def u/keyset keyset) +(d/import-vars [emmy.util map-vals]) + +(deftest target + (is (= #{:a :b} (keyset {:a 1 :b 2}))) + (is (= {:a 1} (map-vals inc {:a 0})))) diff --git a/test/emmy/value_test.cljc b/test/emmy/value_test.cljc index e3f5bfe6..58f3e4dc 100644 --- a/test/emmy/value_test.cljc +++ b/test/emmy/value_test.cljc @@ -18,7 +18,6 @@ (read-string {:readers {'emmy/bigint u/parse-bigint}} (pr-str #emmy/bigint 10)))) - #_{:clj-kondo/ignore [:unused-binding]} (let [one-e-40 (apply str "1" (repeat 40 "0"))] (is (= #?(:clj (bigint 1e40) :cljs (list 'emmy.util/bigint one-e-40))