From 58a0cd8afc5518cf97141de8992d8929eedb455e Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Mon, 4 Jan 2021 06:35:10 -0700 Subject: [PATCH 1/8] muck with sci --- src/sicmutils/env.cljc | 6 +++++- src/sicmutils/env/sci.cljc | 28 ++++++++++++++++++++++++---- src/sicmutils/env/sci/macros.cljc | 5 +++-- 3 files changed, 32 insertions(+), 7 deletions(-) diff --git a/src/sicmutils/env.cljc b/src/sicmutils/env.cljc index de92adb70..d5343554c 100644 --- a/src/sicmutils/env.cljc +++ b/src/sicmutils/env.cljc @@ -340,7 +340,11 @@ zero-like one-like identity-like numerical? freeze kind kind-predicate]) -;; Macros. These work with Potemkin's import, but not with the Clojure version. +;; Macros. These work with Potemkin's import, but not with the Clojure +;; version... which tells me that these are currently NOT going to work in +;; Clojurescript mode, for self-hosted Clojurescript. Figure this out! +;; +;; TODO how do you import a macro in self-hosted cljs? #?(:clj (import-vars [sicmutils.calculus.coordinate let-coordinates using-coordinates])) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index 5f6c62046..c775595d1 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -1,3 +1,22 @@ +;; +;; Copyright © 2020 Sam Ritchie. +;; This work is based on the Scmutils system of MIT/GNU Scheme: +;; Copyright © 2002 Massachusetts Institute of Technology +;; +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or (at +;; your option) any later version. +;; +;; This software is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this code; if not, see . +;; + (ns sicmutils.env.sci (:refer-clojure :exclude [eval]) (:require [clojure.set :as set] @@ -7,10 +26,11 @@ [sicmutils.abstract.function :as af] [sicmutils.calculus.coordinate :as cc])) -(defn ->sci-var [[var-name the-var]] - [var-name (cond-> (deref the-var) - (-> the-var meta :macro) - (with-meta {:sci/macro true}))]) +(defn ->sci-var [[var-name var]] + (let [macro? (:macro (meta var))] + [var-name (if macro? + (with-meta @var {:sci/macro true}) + @var)])) (defn ->sci-ns [publics] (into {} (map ->sci-var) publics)) diff --git a/src/sicmutils/env/sci/macros.cljc b/src/sicmutils/env/sci/macros.cljc index e5cefd638..f4916afd3 100644 --- a/src/sicmutils/env/sci/macros.cljc +++ b/src/sicmutils/env/sci/macros.cljc @@ -12,7 +12,8 @@ (= '-> (first sicm-signature))) `(af/literal-function ~f '~sicm-signature) `(af/literal-function ~f ~sicm-signature))) - ([_ _ f domain range] `(af/literal-function ~f ~domain ~range))) + ([_ _ f domain range] + `(af/literal-function ~f ~domain ~range))) (defn with-literal-functions [_ _ & args] @@ -31,7 +32,7 @@ `(let [[~@c-systems :as c-systems#] (mapv m/with-coordinate-prototype ~c-systems - ~(mapv #(sicmutils.calculus.coordinate/quotify-coordinate-prototype identity %) prototypes)) + ~(mapv #(#'sicmutils.calculus.coordinate/quotify-coordinate-prototype identity %) prototypes)) c-fns# (map coordinate-functions c-systems#) c-vfs# (map vf/coordinate-basis-vector-fields c-systems#) c-ffs# (map ff/coordinate-basis-oneform-fields c-systems#) From 19f3b60a493ed1c02c53ae9a08a5c0e9eb1912e9 Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Wed, 6 Jan 2021 06:42:02 -0700 Subject: [PATCH 2/8] macros work --- src/sicmutils/env/sci.cljc | 116 +++++++++++++++++--------- src/sicmutils/env/sci/macros.cljc | 36 ++++++-- src/sicmutils/mechanics/hamilton.cljc | 6 +- src/sicmutils/util.cljc | 6 ++ 4 files changed, 112 insertions(+), 52 deletions(-) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index c775595d1..caf633935 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -21,48 +21,65 @@ (:refer-clojure :exclude [eval]) (:require [clojure.set :as set] [sci.core :as sci] + [sicmutils.env] [sicmutils.env.sci.macros :as macros] - [sicmutils.env :as env] - [sicmutils.abstract.function :as af] - [sicmutils.calculus.coordinate :as cc])) + [sicmutils.util :as u])) -(defn ->sci-var [[var-name var]] - (let [macro? (:macro (meta var))] - [var-name (if macro? - (with-meta @var {:sci/macro true}) - @var)])) +(def macro? (comp :macro meta)) -(defn ->sci-ns [publics] - (into {} (map ->sci-var) publics)) +(defn resolve-publics [m-or-sym] + (if (symbol? m-or-sym) + (ns-publics m-or-sym) + m-or-sym)) + +(defn ns-macros + "Returns a sequence of all macros in the supplied namespace sym->var mapping. + + You can also provide the name of a namespace as a symbol." + [m-or-sym] + (mapcat (fn [[sym var]] + (if (macro? var) [sym] [])) + (resolve-publics m-or-sym))) + +(defn sci-ns + "Returns a new map identical to the supplied namespace binding map `sym->var`, + with any macro value removed and all var-values resolved." + [m-or-sym] + (letfn [(process [[sym var]] + (if-not (macro? var) + [[sym @var]] + (if-let [sci-macro (macros/all sym)] + [[sym sci-macro]] + [])))] + (let [sym->var (resolve-publics m-or-sym)] + (into {} (mapcat process) sym->var)))) (def namespaces - {'sicmutils.env (-> 'sicmutils.env - ns-publics - (dissoc 'literal-function - 'with-literal-functions - 'bootstrap-repl! - 'let-coordinates - 'using-coordinates) - ->sci-ns - - (merge (select-keys macros/all ['literal-function - 'with-literal-functions - 'let-coordinates - 'using-coordinates]))) - 'sicmutils.abstract.function (-> 'sicmutils.abstract.function ns-publics ->sci-ns) - 'sicmutils.calculus.coordinate (-> 'sicmutils.calculus.coordinate - ns-publics - ->sci-ns - (merge (select-keys macros/all ['let-coordinates - 'using-coordinates])))}) - -(def opts {:namespaces (set/rename-keys namespaces {'sicmutils.env 'user})}) - -(def ctx (sci/init opts)) + #{'sicmutils.env + 'sicmutils.generic + 'sicmutils.abstract.function + 'sicmutils.calculus.coordinate + 'sicmutils.function + 'sicmutils.operator + 'sicmutils.series + 'sicmutils.structure + 'sicmutils.matrix + 'sicmutils.calculus.manifold + 'sicmutils.calculus.vector-field + 'sicmutils.calculus.form-field}) + +(def context-opts + {:namespaces + (-> (u/keys->map sci-ns namespaces) + (set/rename-keys + {'sicmutils.env 'user}))}) + +(def context + (sci/init context-opts)) (comment (defn eval [form] - (sci/eval-string* ctx (pr-str form))) + (sci/eval-form (sci/fork context) form)) (eval '(simplify (+ (square (sin 'x)) (square (cos 'x))))) @@ -71,16 +88,33 @@ (square (cos 'x)))))) (eval '(literal-function 'U)) + + (eval '(do (require '[sicmutils.operator :as o]) + o/identity-operator)) + + (eval '(let-coordinates [[x y] R2-rect + [r theta] R2-polar] + (let [p ((point R2-rect) (up 1 2))] + [(= 1 (x p)) + (= 2 (y p)) + (= (sqrt 5) (r p)) + (= (atan 2) (theta p))]))) + + (eval '(using-coordinates + [x y] R2-rect + (let [p ((point R2-rect) (up 1 2))] + [(= 1 (x p)) + (= 2 (y p))]))) + (eval '(do (defn L-central-polar [m U] (fn [[_ [r] [rdot φdot]]] (- (* 1/2 m (+ (square rdot) (square (* r φdot)))) (U r)))) - (let [potential-fn (literal-function 'U) - L (L-central-polar 'm potential-fn) - state (up (literal-function 'r) - (literal-function 'φ))] - (->TeX - (simplify - (((Lagrange-equations L) state) 't))))))) + (with-literal-functions [U r φ] + (let [L (L-central-polar 'm U) + state (up r φ)] + (->TeX + (simplify + (((Lagrange-equations L) state) 't)))))))) diff --git a/src/sicmutils/env/sci/macros.cljc b/src/sicmutils/env/sci/macros.cljc index f4916afd3..ab73cb9ab 100644 --- a/src/sicmutils/env/sci/macros.cljc +++ b/src/sicmutils/env/sci/macros.cljc @@ -1,6 +1,7 @@ (ns sicmutils.env.sci.macros (:require [sicmutils.abstract.function :as af #?@(:cljs [:include-macros true])] [sicmutils.calculus.coordinate :as cc #?@(:cljs [:include-macros true])] + [sicmutils.calculus.manifold :as m] [sicmutils.calculus.vector-field :as vf] [sicmutils.calculus.form-field :as ff] [sicmutils.util :as u])) @@ -16,8 +17,22 @@ `(af/literal-function ~f ~domain ~range))) (defn with-literal-functions - [_ _ & args] - `(af/with-literal-functions ~@args)) + [_ _ litfns & body] + `(let ~(vec (interleave + (map (fn [s] + (if (symbol? s) s (first s))) + litfns) + (map (fn [s] + (cond (symbol? s) + `(af/literal-function (quote ~s)) + (and (sequential? s) + (= (count s) 3)) + `(af/literal-function (quote ~(first s)) + ~(second s) + ~(nth s 2)) + :else (u/illegal (str "unknown literal function type" s)))) + litfns))) + ~@body)) (defn let-coordinates [_ _ bindings & body] @@ -33,7 +48,7 @@ (mapv m/with-coordinate-prototype ~c-systems ~(mapv #(#'sicmutils.calculus.coordinate/quotify-coordinate-prototype identity %) prototypes)) - c-fns# (map coordinate-functions c-systems#) + c-fns# (map cc/coordinate-functions c-systems#) c-vfs# (map vf/coordinate-basis-vector-fields c-systems#) c-ffs# (map ff/coordinate-basis-oneform-fields c-systems#) ~(vec coordinate-names) (flatten c-fns#) @@ -42,14 +57,17 @@ ~@body))) (defn using-coordinates - [_ _ coordinate-prototype coordinate-system & body] - `(let-coordinates [~coordinate-prototype ~coordinate-system] ~@body)) + [env form coordinate-prototype coordinate-system & body] + (apply let-coordinates + env form + [coordinate-prototype coordinate-system] + body)) -(defn macrofy [f] +(defn- macrofy [f] (with-meta f {:sci/macro true})) (def all - {'literal-function (macrofy literal-function) + {'literal-function (macrofy literal-function) 'with-literal-functions (macrofy with-literal-functions) - 'let-coordinates (macrofy let-coordinates) - 'using-coordinates (macrofy using-coordinates)}) + 'let-coordinates (macrofy let-coordinates) + 'using-coordinates (macrofy using-coordinates)}) diff --git a/src/sicmutils/mechanics/hamilton.cljc b/src/sicmutils/mechanics/hamilton.cljc index 709a20780..6ed025789 100644 --- a/src/sicmutils/mechanics/hamilton.cljc +++ b/src/sicmutils/mechanics/hamilton.cljc @@ -83,7 +83,8 @@ v (/ (- w b) M)] (- (* w v) (F v)))))) -(def Legendre-transform (make-operator Legendre-transform-fn "Legendre-transform")) +(def Legendre-transform + (make-operator Legendre-transform-fn 'Legendre-transform)) (defn ^:private Lagrangian->Hamiltonian-fn [Lagrangian] @@ -91,7 +92,8 @@ (let [L #(Lagrangian (up t q %))] ((Legendre-transform L) p)))) -(def Lagrangian->Hamiltonian (make-operator Lagrangian->Hamiltonian-fn 'Lagrangian->Hamiltonian)) +(def Lagrangian->Hamiltonian + (make-operator Lagrangian->Hamiltonian-fn 'Lagrangian->Hamiltonian)) (defn Poisson-bracket [f g] diff --git a/src/sicmutils/util.cljc b/src/sicmutils/util.cljc index e4cf855dc..0aa7afbac 100644 --- a/src/sicmutils/util.cljc +++ b/src/sicmutils/util.cljc @@ -62,6 +62,12 @@ (defn keyset [m] (into #{} (keys m))) +(defn keys->map + "Returns a map generated by applying the supplied `f` to each entry in the + supplied set of keys." + [f keyset] + (into {} (map (fn [x] [x (f x)])) keyset)) + (defn bigint [x] #?(:clj (core-bigint x) :cljs (js/BigInt x))) From f73e26faa45a2f9bc7881b2683a7c812b6235c49 Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Wed, 6 Jan 2021 07:33:14 -0700 Subject: [PATCH 3/8] new macros --- src/sicmutils/abstract/function.cljc | 34 +++--- src/sicmutils/calculus/coordinate.cljc | 8 +- src/sicmutils/env.cljc | 1 + src/sicmutils/env/sci.cljc | 119 ++++++++++----------- src/sicmutils/env/sci/macros.cljc | 59 ++++++---- test/sicmutils/env/sci_test.cljc | 91 ++++++++++++++++ test/sicmutils/expression/render_test.cljc | 2 +- 7 files changed, 208 insertions(+), 106 deletions(-) create mode 100644 test/sicmutils/env/sci_test.cljc diff --git a/src/sicmutils/abstract/function.cljc b/src/sicmutils/abstract/function.cljc index 5d3ae50ef..3e042a433 100644 --- a/src/sicmutils/abstract/function.cljc +++ b/src/sicmutils/abstract/function.cljc @@ -166,22 +166,26 @@ :else (u/illegal (str "WTF range" range))))) +(defn binding-pairs [litfns] + (letfn [(extract-sym [entry] + (if (symbol? entry) entry (first entry))) + (entry->fn [entry] + (cond (symbol? entry) (literal-function entry) + + (and (sequential? entry) (= (count entry) 3)) + (let [[sym domain range] entry] + (literal-function sym domain range)) + + :else (u/illegal (str "unknown literal function type" entry))))] + (mapv (fn [entry] + [(extract-sym entry) + (entry->fn entry)]) + litfns))) + (defmacro with-literal-functions [litfns & body] - `(let ~(vec (interleave - (map (fn [s] - (if (symbol? s) s (first s))) - litfns) - (map (fn [s] - (cond (symbol? s) - `(literal-function (quote ~s)) - (and (sequential? s) - (= (count s) 3)) - `(literal-function (quote ~(first s)) - ~(second s) - ~(nth s 2)) - :else (u/illegal (str "unknown literal function type" s)))) - litfns))) - ~@body)) + (let [pairs (binding-pairs litfns) + bindings (into [] cat pairs)] + `(let ~bindings ~@body))) ;; ## Differentiation of literal functions diff --git a/src/sicmutils/calculus/coordinate.cljc b/src/sicmutils/calculus/coordinate.cljc index 90c4e1ced..47acf67fe 100644 --- a/src/sicmutils/calculus/coordinate.cljc +++ b/src/sicmutils/calculus/coordinate.cljc @@ -34,9 +34,11 @@ #(m/point->coords coordinate-system %))) (s/structure->access-chains prototype)))) -(defn ^:private quotify-coordinate-prototype +(defn quotify-coordinate-prototype "Scmutils wants to allow forms like this: + (using-coordinates (up x y) R2-rect ...) + Note that x, y are unquoted. This function converts such an unquoted for into a quoted one that could be evaluated to return an up-tuple of the symbols: (up 'x 'y) @@ -66,9 +68,9 @@ [bindings & body] (when-not (even? (count bindings)) (u/illegal "let-coordinates requires an even number of bindings")) - (let [pairs (partition 2 bindings) + (let [pairs (partition 2 bindings) prototypes (map first pairs) - c-systems (mapv second pairs) + c-systems (mapv second pairs) coordinate-names (mapcat 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)] diff --git a/src/sicmutils/env.cljc b/src/sicmutils/env.cljc index d5343554c..7dc6c3037 100644 --- a/src/sicmutils/env.cljc +++ b/src/sicmutils/env.cljc @@ -48,6 +48,7 @@ [sicmutils.numerical.quadrature] [sicmutils.mechanics.lagrange] [sicmutils.mechanics.hamilton] + [sicmutils.mechanics.rigid] [sicmutils.mechanics.rotation] [sicmutils.calculus.basis] [sicmutils.calculus.covariant] diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index caf633935..020c6903c 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -1,5 +1,5 @@ ;; -;; Copyright © 2020 Sam Ritchie. +;; Copyright © 2020 Colin Smith. ;; This work is based on the Scmutils system of MIT/GNU Scheme: ;; Copyright © 2002 Massachusetts Institute of Technology ;; @@ -18,32 +18,39 @@ ;; (ns sicmutils.env.sci - (:refer-clojure :exclude [eval]) - (:require [clojure.set :as set] - [sci.core :as sci] + (:require [sci.core :as sci] [sicmutils.env] [sicmutils.env.sci.macros :as macros] [sicmutils.util :as u])) (def macro? (comp :macro meta)) -(defn resolve-publics [m-or-sym] +(defn resolve-publics + "Idempotent version of `ns-publics`. All three forms are identical for a + namespace symbol: + + (ns-publics sym) + (resolve-publics sym) + (resolve-publics (resolve-publics sym))" + [m-or-sym] (if (symbol? m-or-sym) (ns-publics m-or-sym) m-or-sym)) (defn ns-macros - "Returns a sequence of all macros in the supplied namespace sym->var mapping. - - You can also provide the name of a namespace as a symbol." + "Given a namespace symbol (or a map of symbol => var), returns a sequence of the + symbols associated with macro value." [m-or-sym] (mapcat (fn [[sym var]] (if (macro? var) [sym] [])) (resolve-publics m-or-sym))) (defn sci-ns - "Returns a new map identical to the supplied namespace binding map `sym->var`, - with any macro value removed and all var-values resolved." + "Given a namespace symbol (or 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" [m-or-sym] (letfn [(process [[sym var]] (if-not (macro? var) @@ -54,67 +61,51 @@ (let [sym->var (resolve-publics m-or-sym)] (into {} (mapcat process) sym->var)))) -(def namespaces +(def ^{:doc "Set of all namespaces explicitly checked and whitelisted for SCI +compilation and interesting enough in their own right to expose to a user by +default."} + namespaces #{'sicmutils.env 'sicmutils.generic - 'sicmutils.abstract.function - 'sicmutils.calculus.coordinate 'sicmutils.function 'sicmutils.operator 'sicmutils.series 'sicmutils.structure 'sicmutils.matrix + 'sicmutils.abstract.function + 'sicmutils.calculus.basis + 'sicmutils.calculus.coordinate + 'sicmutils.calculus.covariant + 'sicmutils.calculus.derivative + 'sicmutils.calculus.form-field 'sicmutils.calculus.manifold + 'sicmutils.calculus.map 'sicmutils.calculus.vector-field - 'sicmutils.calculus.form-field}) - -(def context-opts - {:namespaces - (-> (u/keys->map sci-ns namespaces) - (set/rename-keys - {'sicmutils.env 'user}))}) - -(def context + 'sicmutils.mechanics.lagrange + 'sicmutils.mechanics.hamilton + 'sicmutils.mechanics.rigid + 'sicmutils.mechanics.rotation + 'sicmutils.numerical.derivative + 'sicmutils.numerical.quadrature + 'sicmutils.numerical.ode + 'sicmutils.numerical.minimize + 'sicmutils.numerical.interpolate.polynomial + 'sicmutils.numerical.interpolate.rational + 'sicmutils.numerical.interpolate.richardson + 'sicmutils.numerical.multimin.nelder-mead + 'sicmutils.numerical.unimin.bracket + 'sicmutils.numerical.unimin.brent + 'sicmutils.numerical.unimin.golden}) + +(def ^{:doc "Default sci context options required (currently only `:namespace` + bindings) required to evaluate SICMUtils forms from inside of an SCI + context. Pass these to `sci/init` to generate an sci context."} + context-opts + (let [ns-map (u/keys->map sci-ns namespaces)] + {:namespaces + (assoc ns-map 'user (ns-map 'sicmutils.env))})) + +(def ^{:doc "sci context (currently only `:namespace` bindings) required to + evaluate SICMUtils forms via SCI"} + context (sci/init context-opts)) - -(comment - (defn eval [form] - (sci/eval-form (sci/fork context) form)) - - (eval '(simplify (+ (square (sin 'x)) - (square (cos 'x))))) - - (eval '(->TeX (simplify (+ (square (sin (square 'x))) - (square (cos 'x)))))) - - (eval '(literal-function 'U)) - - (eval '(do (require '[sicmutils.operator :as o]) - o/identity-operator)) - - (eval '(let-coordinates [[x y] R2-rect - [r theta] R2-polar] - (let [p ((point R2-rect) (up 1 2))] - [(= 1 (x p)) - (= 2 (y p)) - (= (sqrt 5) (r p)) - (= (atan 2) (theta p))]))) - - (eval '(using-coordinates - [x y] R2-rect - (let [p ((point R2-rect) (up 1 2))] - [(= 1 (x p)) - (= 2 (y p))]))) - - (eval '(do (defn L-central-polar [m U] - (fn [[_ [r] [rdot φdot]]] - (- (* 1/2 m - (+ (square rdot) - (square (* r φdot)))) - (U r)))) - (with-literal-functions [U r φ] - (let [L (L-central-polar 'm U) - state (up r φ)] - (->TeX - (simplify - (((Lagrange-equations L) state) 't)))))))) diff --git a/src/sicmutils/env/sci/macros.cljc b/src/sicmutils/env/sci/macros.cljc index ab73cb9ab..f0a44d208 100644 --- a/src/sicmutils/env/sci/macros.cljc +++ b/src/sicmutils/env/sci/macros.cljc @@ -1,12 +1,34 @@ +;; +;; Copyright © 2020 Colin Smith. +;; This work is based on the Scmutils system of MIT/GNU Scheme: +;; Copyright © 2002 Massachusetts Institute of Technology +;; +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or (at +;; your option) any later version. +;; +;; This software is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this code; if not, see . +;; + (ns sicmutils.env.sci.macros - (:require [sicmutils.abstract.function :as af #?@(:cljs [:include-macros true])] - [sicmutils.calculus.coordinate :as cc #?@(:cljs [:include-macros true])] + "This namespace contains reimplementations of various macros from sicmutils, + defined in the form required by SCI." + (:require [sicmutils.abstract.function :as af] + [sicmutils.calculus.coordinate :as cc] [sicmutils.calculus.manifold :as m] [sicmutils.calculus.vector-field :as vf] [sicmutils.calculus.form-field :as ff] [sicmutils.util :as u])) (defn literal-function + "Originally defined in `sicmutils.env`." ([_ _ f] `(af/literal-function ~f)) ([_ _ f sicm-signature] (if (and (list? sicm-signature) @@ -17,24 +39,14 @@ `(af/literal-function ~f ~domain ~range))) (defn with-literal-functions + "Originally defined in `sicmutils.abstract.function`." [_ _ litfns & body] - `(let ~(vec (interleave - (map (fn [s] - (if (symbol? s) s (first s))) - litfns) - (map (fn [s] - (cond (symbol? s) - `(af/literal-function (quote ~s)) - (and (sequential? s) - (= (count s) 3)) - `(af/literal-function (quote ~(first s)) - ~(second s) - ~(nth s 2)) - :else (u/illegal (str "unknown literal function type" s)))) - litfns))) - ~@body)) + (let [pairs (af/binding-pairs litfns) + bindings (into [] cat pairs)] + `(let ~bindings ~@body))) (defn let-coordinates + "Originally defined in `sicmutils.calculus.coordinate`." [_ _ bindings & body] (when-not (even? (count bindings)) (u/illegal "let-coordinates requires an even number of bindings")) @@ -47,7 +59,7 @@ `(let [[~@c-systems :as c-systems#] (mapv m/with-coordinate-prototype ~c-systems - ~(mapv #(#'sicmutils.calculus.coordinate/quotify-coordinate-prototype identity %) prototypes)) + ~(mapv #(cc/quotify-coordinate-prototype identity %) prototypes)) c-fns# (map cc/coordinate-functions c-systems#) c-vfs# (map vf/coordinate-basis-vector-fields c-systems#) c-ffs# (map ff/coordinate-basis-oneform-fields c-systems#) @@ -57,17 +69,18 @@ ~@body))) (defn using-coordinates + "Originally defined in `sicmutils.calculus.coordinate`." [env form coordinate-prototype coordinate-system & body] (apply let-coordinates env form [coordinate-prototype coordinate-system] body)) -(defn- macrofy [f] +(defn- tag-as-macro [f] (with-meta f {:sci/macro true})) (def all - {'literal-function (macrofy literal-function) - 'with-literal-functions (macrofy with-literal-functions) - 'let-coordinates (macrofy let-coordinates) - 'using-coordinates (macrofy using-coordinates)}) + {'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)}) diff --git a/test/sicmutils/env/sci_test.cljc b/test/sicmutils/env/sci_test.cljc new file mode 100644 index 000000000..03680fa66 --- /dev/null +++ b/test/sicmutils/env/sci_test.cljc @@ -0,0 +1,91 @@ +;; +;; Copyright © 2020 Colin Smith. +;; This work is based on the Scmutils system of MIT/GNU Scheme: +;; Copyright © 2002 Massachusetts Institute of Technology +;; +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or (at +;; your option) any later version. +;; +;; This software is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this code; if not, see . +;; + +(ns sicmutils.env.sci-test + (:refer-clojure :exclude [eval]) + (:require [clojure.test :refer [is deftest testing]] + [sci.core :as sci] + [sicmutils.env :as e] + [sicmutils.env.sci :as es] + [sicmutils.operator :as o])) + +(defn eval [form] + (sci/eval-form (sci/fork es/context) form)) + +(deftest basic-sci-tests + (is (= 1 (eval '(simplify (+ (square (sin 'x)) + (square (cos 'x)))))) + "simplifications work inside sci") + + (is (= "{\\cos}^{2}\\left(x\\right) + {\\sin}^{2}\\left({x}^{2}\\right)" + (eval '(->TeX + (simplify (+ (square (sin (square 'x))) + (square (cos 'x)))))))) + + (is (= (e/literal-function 'U) + (eval '(literal-function 'U))) + "Literal functions use value equality.") + + (is (= o/identity-operator + (eval + '(do (require '[sicmutils.operator :as o]) + o/identity-operator))) + "can sci internally require namespaces?") + + (is (= '(* 10 face) + (eval + '(do (require '[sicmutils.env :as e]) + (e/simplify (e/* 'face 10))))) + "sicmutils.env is available as a namespace and also included as the + default bindings in `user`.") + + (testing "sci-specific macro definitions" + (is (= [true true true true] + (eval '(let-coordinates [[x y] R2-rect + [r theta] R2-polar] + (let [p ((point R2-rect) (up 1 2))] + [(= 1 (x p)) + (= 2 (y p)) + (= (sqrt 5) (r p)) + (= (atan 2) (theta p))])))) + "let-coordinates macro works") + + (is (= [true true] + (eval '(using-coordinates + [x y] R2-rect + (let [p ((point R2-rect) (up 1 2))] + [(= 1 (x p)) + (= 2 (y p))])))) + "using-coordinates works") + + (testing "internal defn, funky symbols, internal with-literal-functions macro" + (is (= "down(- m (Dφ(t))² r(t) + m D²r(t) + DU(r(t)), 2 m Dφ(t) r(t) Dr(t) + m (r(t))² D²φ(t))" + (eval + '(do (defn L-central-polar [m U] + (fn [[_ [r] [rdot φdot]]] + (- (* 1/2 m + (+ (square rdot) + (square (* r φdot)))) + (U r)))) + (with-literal-functions [U r φ] + (let [L (L-central-polar 'm U) + state (up r φ)] + (->infix + (simplify + (((Lagrange-equations L) state) 't)))))))))))) diff --git a/test/sicmutils/expression/render_test.cljc b/test/sicmutils/expression/render_test.cljc index ffe66e408..a1adf07ea 100644 --- a/test/sicmutils/expression/render_test.cljc +++ b/test/sicmutils/expression/render_test.cljc @@ -102,7 +102,7 @@ (is (= "x^y" (s->infix (expt 'x 'y))))) (deftest more-with-D - (af/with-literal-functions [f g [p [] 0]] + (af/with-literal-functions [f g] (is (= "f(s)" (s->infix (f 's)))) (is (= "(f + g)(x, y)" (->infix '((+ f g) x y)))) (is (= "f(x) g(x)" (s->infix ((* f g) 'x)))) From c283e31c34c2c60fafea5e7617667492b57867a3 Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Thu, 7 Jan 2021 11:02:54 -0700 Subject: [PATCH 4/8] fix sci --- src/sicmutils/abstract/function.cljc | 4 +- src/sicmutils/calculus/coordinate.cljc | 6 +- src/sicmutils/env.cljc | 20 +++--- src/sicmutils/env/sci.cljc | 96 +++++++++++--------------- src/sicmutils/util.cljc | 6 -- test/sicmutils/env/sci_test.cljc | 2 +- test/sicmutils/runner.cljs | 4 ++ 7 files changed, 59 insertions(+), 79 deletions(-) diff --git a/src/sicmutils/abstract/function.cljc b/src/sicmutils/abstract/function.cljc index 3e042a433..e08dd1ce6 100644 --- a/src/sicmutils/abstract/function.cljc +++ b/src/sicmutils/abstract/function.cljc @@ -170,11 +170,11 @@ (letfn [(extract-sym [entry] (if (symbol? entry) entry (first entry))) (entry->fn [entry] - (cond (symbol? entry) (literal-function entry) + (cond (symbol? entry) `(literal-function (quote ~entry)) (and (sequential? entry) (= (count entry) 3)) (let [[sym domain range] entry] - (literal-function sym domain range)) + `(literal-function (quote ~sym) ~domain ~range)) :else (u/illegal (str "unknown literal function type" entry))))] (mapv (fn [entry] diff --git a/src/sicmutils/calculus/coordinate.cljc b/src/sicmutils/calculus/coordinate.cljc index 47acf67fe..e04c7eb87 100644 --- a/src/sicmutils/calculus/coordinate.cljc +++ b/src/sicmutils/calculus/coordinate.cljc @@ -36,9 +36,7 @@ (defn quotify-coordinate-prototype "Scmutils wants to allow forms like this: - (using-coordinates (up x y) R2-rect ...) - Note that x, y are unquoted. This function converts such an unquoted for into a quoted one that could be evaluated to return an up-tuple of the symbols: (up 'x 'y) @@ -68,9 +66,9 @@ [bindings & body] (when-not (even? (count bindings)) (u/illegal "let-coordinates requires an even number of bindings")) - (let [pairs (partition 2 bindings) + (let [pairs (partition 2 bindings) prototypes (map first pairs) - c-systems (mapv second pairs) + c-systems (mapv second pairs) coordinate-names (mapcat 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)] diff --git a/src/sicmutils/env.cljc b/src/sicmutils/env.cljc index 7dc6c3037..5d3bfbcf3 100644 --- a/src/sicmutils/env.cljc +++ b/src/sicmutils/env.cljc @@ -56,7 +56,7 @@ [sicmutils.calculus.form-field] [sicmutils.calculus.manifold] [sicmutils.calculus.map] - [sicmutils.calculus.coordinate] + [sicmutils.calculus.coordinate :as cc] [sicmutils.calculus.vector-field])) #?(:clj @@ -84,10 +84,15 @@ `(af/literal-function ~f ~sicm-signature))) ([f domain range] `(af/literal-function ~f ~domain ~range))) -(defmacro with-literal-functions - [& args] +(defmacro with-literal-functions [& args] `(af/with-literal-functions ~@args)) +(defmacro let-coordinates [& args] + `(cc/let-coordinates ~@args)) + +(defmacro using-coordinates [& args] + `(cc/using-coordinates ~@args)) + (def print-expression simp/print-expression) (defn ref @@ -340,12 +345,3 @@ [sicmutils.value exact? zero? one? identity? zero-like one-like identity-like numerical? freeze kind kind-predicate]) - -;; Macros. These work with Potemkin's import, but not with the Clojure -;; version... which tells me that these are currently NOT going to work in -;; Clojurescript mode, for self-hosted Clojurescript. Figure this out! -;; -;; TODO how do you import a macro in self-hosted cljs? -#?(:clj - (import-vars - [sicmutils.calculus.coordinate let-coordinates using-coordinates])) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index 020c6903c..c9080c5ec 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -25,83 +25,71 @@ (def macro? (comp :macro meta)) -(defn resolve-publics - "Idempotent version of `ns-publics`. All three forms are identical for a - namespace symbol: - - (ns-publics sym) - (resolve-publics sym) - (resolve-publics (resolve-publics sym))" - [m-or-sym] - (if (symbol? m-or-sym) - (ns-publics m-or-sym) - m-or-sym)) - (defn ns-macros - "Given a namespace symbol (or a map of symbol => var), returns a sequence of the - symbols associated with macro value." - [m-or-sym] + "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] [])) - (resolve-publics m-or-sym))) + sym->var)) (defn sci-ns - "Given a namespace symbol (or a map of symbol => var), returns a map of symbol - => var with: + "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" - [m-or-sym] + [sym->var] (letfn [(process [[sym var]] (if-not (macro? var) [[sym @var]] (if-let [sci-macro (macros/all sym)] [[sym sci-macro]] [])))] - (let [sym->var (resolve-publics m-or-sym)] - (into {} (mapcat process) sym->var)))) + (into {} (mapcat process) sym->var))) (def ^{:doc "Set of all namespaces explicitly checked and whitelisted for SCI compilation and interesting enough in their own right to expose to a user by default."} - namespaces - #{'sicmutils.env - 'sicmutils.generic - 'sicmutils.function - 'sicmutils.operator - 'sicmutils.series - 'sicmutils.structure - 'sicmutils.matrix - 'sicmutils.abstract.function - 'sicmutils.calculus.basis - 'sicmutils.calculus.coordinate - 'sicmutils.calculus.covariant - 'sicmutils.calculus.derivative - 'sicmutils.calculus.form-field - 'sicmutils.calculus.manifold - 'sicmutils.calculus.map - 'sicmutils.calculus.vector-field - 'sicmutils.mechanics.lagrange - 'sicmutils.mechanics.hamilton - 'sicmutils.mechanics.rigid - 'sicmutils.mechanics.rotation - 'sicmutils.numerical.derivative - 'sicmutils.numerical.quadrature - 'sicmutils.numerical.ode - 'sicmutils.numerical.minimize - 'sicmutils.numerical.interpolate.polynomial - 'sicmutils.numerical.interpolate.rational - 'sicmutils.numerical.interpolate.richardson - 'sicmutils.numerical.multimin.nelder-mead - 'sicmutils.numerical.unimin.bracket - 'sicmutils.numerical.unimin.brent - 'sicmutils.numerical.unimin.golden}) + ns-map + {'sicmutils.env (ns-publics 'sicmutils.env) + 'sicmutils.generic (ns-publics 'sicmutils.generic) + 'sicmutils.function (ns-publics 'sicmutils.function) + 'sicmutils.operator (ns-publics 'sicmutils.operator) + 'sicmutils.series (ns-publics 'sicmutils.series) + 'sicmutils.structure (ns-publics 'sicmutils.structure) + 'sicmutils.matrix (ns-publics 'sicmutils.matrix) + 'sicmutils.abstract.function (ns-publics 'sicmutils.abstract.function) + 'sicmutils.calculus.basis (ns-publics 'sicmutils.calculus.basis) + 'sicmutils.calculus.coordinate (ns-publics 'sicmutils.calculus.coordinate) + 'sicmutils.calculus.covariant (ns-publics 'sicmutils.calculus.covariant) + 'sicmutils.calculus.derivative (ns-publics 'sicmutils.calculus.derivative) + 'sicmutils.calculus.form-field (ns-publics 'sicmutils.calculus.form-field) + 'sicmutils.calculus.manifold (ns-publics 'sicmutils.calculus.manifold) + 'sicmutils.calculus.map (ns-publics 'sicmutils.calculus.map) + 'sicmutils.calculus.vector-field (ns-publics 'sicmutils.calculus.vector-field) + 'sicmutils.mechanics.lagrange (ns-publics 'sicmutils.mechanics.lagrange) + 'sicmutils.mechanics.hamilton (ns-publics 'sicmutils.mechanics.hamilton) + 'sicmutils.mechanics.rigid (ns-publics 'sicmutils.mechanics.rigid) + 'sicmutils.mechanics.rotation (ns-publics 'sicmutils.mechanics.rotation) + 'sicmutils.numerical.derivative (ns-publics 'sicmutils.numerical.derivative) + 'sicmutils.numerical.quadrature (ns-publics 'sicmutils.numerical.quadrature) + 'sicmutils.numerical.ode (ns-publics 'sicmutils.numerical.ode) + 'sicmutils.numerical.minimize (ns-publics 'sicmutils.numerical.minimize) + 'sicmutils.numerical.interpolate.polynomial (ns-publics 'sicmutils.numerical.interpolate.polynomial) + 'sicmutils.numerical.interpolate.rational (ns-publics 'sicmutils.numerical.interpolate.rational) + 'sicmutils.numerical.interpolate.richardson (ns-publics 'sicmutils.numerical.interpolate.richardson) + 'sicmutils.numerical.multimin.nelder-mead (ns-publics 'sicmutils.numerical.multimin.nelder-mead) + 'sicmutils.numerical.unimin.bracket (ns-publics 'sicmutils.numerical.unimin.bracket) + 'sicmutils.numerical.unimin.brent (ns-publics 'sicmutils.numerical.unimin.brent) + 'sicmutils.numerical.unimin.golden (ns-publics 'sicmutils.numerical.unimin.golden)}) (def ^{:doc "Default sci context options required (currently only `:namespace` bindings) required to evaluate SICMUtils forms from inside of an SCI context. Pass these to `sci/init` to generate an sci context."} context-opts - (let [ns-map (u/keys->map sci-ns namespaces)] + (let [ns-map (into {} + (map (fn [[k v]] [k (sci-ns v)])) + ns-map)] {:namespaces (assoc ns-map 'user (ns-map 'sicmutils.env))})) diff --git a/src/sicmutils/util.cljc b/src/sicmutils/util.cljc index 0aa7afbac..e4cf855dc 100644 --- a/src/sicmutils/util.cljc +++ b/src/sicmutils/util.cljc @@ -62,12 +62,6 @@ (defn keyset [m] (into #{} (keys m))) -(defn keys->map - "Returns a map generated by applying the supplied `f` to each entry in the - supplied set of keys." - [f keyset] - (into {} (map (fn [x] [x (f x)])) keyset)) - (defn bigint [x] #?(:clj (core-bigint x) :cljs (js/BigInt x))) diff --git a/test/sicmutils/env/sci_test.cljc b/test/sicmutils/env/sci_test.cljc index 03680fa66..839e1b1ab 100644 --- a/test/sicmutils/env/sci_test.cljc +++ b/test/sicmutils/env/sci_test.cljc @@ -79,7 +79,7 @@ (eval '(do (defn L-central-polar [m U] (fn [[_ [r] [rdot φdot]]] - (- (* 1/2 m + (- (* (/ 1 2) m (+ (square rdot) (square (* r φdot)))) (U r)))) diff --git a/test/sicmutils/runner.cljs b/test/sicmutils/runner.cljs index 45034a28e..264b6b134 100644 --- a/test/sicmutils/runner.cljs +++ b/test/sicmutils/runner.cljs @@ -14,6 +14,8 @@ sicmutils.calculus.map-test sicmutils.calculus.vector-field-test + sicmutils.env.sci-test + sicmutils.examples.central-potential-test sicmutils.examples.double-pendulum-test sicmutils.examples.driven-pendulum-test @@ -107,6 +109,8 @@ 'sicmutils.calculus.map-test 'sicmutils.calculus.vector-field-test + 'sicmutils.env.sci-test + 'sicmutils.examples.central-potential-test 'sicmutils.examples.double-pendulum-test 'sicmutils.examples.driven-pendulum-test From e8ccd73c5e388a54b3a74e6fe4fa0679cb62b322 Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Thu, 7 Jan 2021 11:05:35 -0700 Subject: [PATCH 5/8] update docstring --- src/sicmutils/env/sci.cljc | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index c9080c5ec..e642edfd8 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -47,9 +47,10 @@ [])))] (into {} (mapcat process) sym->var))) -(def ^{:doc "Set of all namespaces explicitly checked and whitelisted for SCI -compilation and interesting enough in their own right to expose to a user by -default."} +(def ^{:doc "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."} ns-map {'sicmutils.env (ns-publics 'sicmutils.env) 'sicmutils.generic (ns-publics 'sicmutils.generic) From cee96df0c290270e6ac94190586f789284d6becf Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Thu, 7 Jan 2021 12:01:08 -0700 Subject: [PATCH 6/8] final sci shenanigans --- src/sicmutils/env/sci.cljc | 22 +++++++++++++++++++--- src/sicmutils/expression/compile.cljc | 8 +++----- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index e642edfd8..edc3ffeba 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -24,6 +24,7 @@ [sicmutils.util :as u])) (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 @@ -40,11 +41,23 @@ - all other values resolved" [sym->var] (letfn [(process [[sym var]] - (if-not (macro? var) - [[sym @var]] + (cond + ;; Inside SCI, macros are replaced by rewritten-as-functions + ;; versions of themselves, with additional slots for `&form` and + ;; `&env`. + (macro? var) (if-let [sci-macro (macros/all sym)] [[sym sci-macro]] - [])))] + []) + + ;; 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 ^{:doc "Map whose values are the symbols of of all namespaces explicitly @@ -57,6 +70,7 @@ corresponding namespace."} 'sicmutils.function (ns-publics 'sicmutils.function) 'sicmutils.operator (ns-publics 'sicmutils.operator) 'sicmutils.series (ns-publics 'sicmutils.series) + 'sicmutils.simplify (ns-publics 'sicmutils.simplify) 'sicmutils.structure (ns-publics 'sicmutils.structure) 'sicmutils.matrix (ns-publics 'sicmutils.matrix) 'sicmutils.abstract.function (ns-publics 'sicmutils.abstract.function) @@ -68,6 +82,8 @@ corresponding namespace."} 'sicmutils.calculus.manifold (ns-publics 'sicmutils.calculus.manifold) 'sicmutils.calculus.map (ns-publics 'sicmutils.calculus.map) 'sicmutils.calculus.vector-field (ns-publics 'sicmutils.calculus.vector-field) + 'sicmutils.expression.compile (ns-publics 'sicmutils.expression.compile) + 'sicmutils.expression.render (ns-publics 'sicmutils.expression.render) 'sicmutils.mechanics.lagrange (ns-publics 'sicmutils.mechanics.lagrange) 'sicmutils.mechanics.hamilton (ns-publics 'sicmutils.mechanics.hamilton) 'sicmutils.mechanics.rigid (ns-publics 'sicmutils.mechanics.rigid) diff --git a/src/sicmutils/expression/compile.cljc b/src/sicmutils/expression/compile.cljc index e2566e7df..35e43a6b7 100644 --- a/src/sicmutils/expression/compile.cljc +++ b/src/sicmutils/expression/compile.cljc @@ -463,7 +463,6 @@ cache, see `compile-state-fn`." [f params initial-state] (let [sw (us/stopwatch) - mode *mode* generic-params (for [_ params] (gensym 'p)) generic-state (struct/mapr (fn [_] (gensym 'y)) initial-state) g (apply f generic-params) @@ -473,7 +472,7 @@ compile-state-native compile-state-sci) compiled-fn (compiler generic-params generic-state body)] - (log/info "compiled state function in" (us/repr sw)) + (log/info "compiled state function in" (us/repr sw) "with mode" *mode*) compiled-fn)) (defn compile-state-fn @@ -543,14 +542,13 @@ cache, see `compile-univariate-fn`." [f] (let [sw (us/stopwatch) - mode *mode* var (gensym 'x) body (cse-form (g/simplify (f var))) - compiled (if (= mode :native) + compiled (if (native?) (compile-native var body) (compile-sci var body))] - (log/info "compiled univariate function in " (us/repr sw) " with mode " mode) + (log/info "compiled univariate function in" (us/repr sw) "with mode" *mode*) compiled)) (defn compile-univariate-fn From 857cf899061957f84761ae3857dc899a1761f52a Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Thu, 7 Jan 2021 13:39:26 -0700 Subject: [PATCH 7/8] tidy macros --- src/sicmutils/env/sci.cljc | 12 +++++------- src/sicmutils/env/sci/macros.cljc | 9 +++++++++ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index edc3ffeba..d87c94df1 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -44,11 +44,8 @@ (cond ;; Inside SCI, macros are replaced by rewritten-as-functions ;; versions of themselves, with additional slots for `&form` and - ;; `&env`. - (macro? var) - (if-let [sci-macro (macros/all sym)] - [[sym sci-macro]] - []) + ;; `&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 @@ -106,9 +103,10 @@ corresponding namespace."} context-opts (let [ns-map (into {} (map (fn [[k v]] [k (sci-ns v)])) - ns-map)] + ns-map) + with-macros (merge-with merge ns-map macros/ns-bindings)] {:namespaces - (assoc ns-map 'user (ns-map 'sicmutils.env))})) + (assoc with-macros 'user (with-macros 'sicmutils.env))})) (def ^{:doc "sci context (currently only `:namespace` bindings) required to evaluate SICMUtils forms via SCI"} diff --git a/src/sicmutils/env/sci/macros.cljc b/src/sicmutils/env/sci/macros.cljc index f0a44d208..929128a48 100644 --- a/src/sicmutils/env/sci/macros.cljc +++ b/src/sicmutils/env/sci/macros.cljc @@ -84,3 +84,12 @@ 'with-literal-functions (tag-as-macro with-literal-functions) 'let-coordinates (tag-as-macro let-coordinates) 'using-coordinates (tag-as-macro using-coordinates)}) + +(def ns-bindings + {'sicmutils.env all + + 'sicmutils.abstract.function + (select-keys all ['with-literal-functions]) + + 'sicmutils.calculus.coordinate + (select-keys all ['let-coordinates 'using-coordinates])}) From 04c3cd2130a6981610318e547abb779cceaa95df Mon Sep 17 00:00:00 2001 From: Sam Ritchie Date: Thu, 7 Jan 2021 14:53:12 -0700 Subject: [PATCH 8/8] remove user --- src/sicmutils/env/sci.cljc | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/sicmutils/env/sci.cljc b/src/sicmutils/env/sci.cljc index d87c94df1..f0573b51f 100644 --- a/src/sicmutils/env/sci.cljc +++ b/src/sicmutils/env/sci.cljc @@ -105,8 +105,7 @@ corresponding namespace."} (map (fn [[k v]] [k (sci-ns v)])) ns-map) with-macros (merge-with merge ns-map macros/ns-bindings)] - {:namespaces - (assoc with-macros 'user (with-macros 'sicmutils.env))})) + {:namespaces with-macros})) (def ^{:doc "sci context (currently only `:namespace` bindings) required to evaluate SICMUtils forms via SCI"}