diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2018-04-06 06:49:23 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2018-04-06 06:49:23 -0700 |
commit | 8a9159263d4ca1b174a60476e3863c45d9e63cc1 (patch) | |
tree | 102511afd760aaf388c753a10f273a5a64bfd829 | |
parent | 668b7ab58822dd14ac54061373a09a1311748acf (diff) | |
download | txr-8a9159263d4ca1b174a60476e3863c45d9e63cc1.tar.gz txr-8a9159263d4ca1b174a60476e3863c45d9e63cc1.tar.bz2 txr-8a9159263d4ca1b174a60476e3863c45d9e63cc1.zip |
stdlib: all code read under sys package.
Another part of the preparation for an upcoming change.
All library code is now read in the sys package, so any
symbols that are interned (local variables and whatnot)
are in sys and will not be exposed to user code.
We have to overcome some annoyances to achieve this:
- We have to stay away from the symbols exp or var,
because they are now sys:exp and sys:var with their
special meaning.
- Instances in which a symbol of the same name exists
in both sys and usr present a problem; the plain
symbol now is the usr one. For instance rplaca
will refer to sys:rplaca, so a small amount of
code has to explicitly use usr:rplaca.
* Makefile (COMPILE_TL): Change to the sys package before
compiling library code.
* lisplib.c (lisplib_try_load): Bind *package* to the system
package.
* share/txr/stdlib/asm.tl, share/txr/stdlib/compiler.tl:
Remove in-package macro invocation; we don't need this since
all files are loaded or compiled in the sys package.
* share/txr/stdlib/build.tl, share/txr/stdlib/cadr.tl,
share/txr/stdlib/conv.tl, share/txr/stdlib/doloop.tl,
share/txr/stdlib/error.tl, share/txr/stdlib/error.tl,
share/txr/stdlib/except.tl, share/txr/stdlib/ffi.tl,
share/txr/stdlib/getopts.tl, share/txr/stdlib/getput.tl,
share/txr/stdlib/hash.tl, share/txr/stdlib/ifa.tl,
share/txr/stdlib/keyparams.tl, share/txr/stdlib/op.tl,
share/txr/stdlib/package.tl, share/txr/stdlib/path-test.tl,
share/txr/stdlib/place.tl, share/txr/stdlib/pmac.tl,
share/txr/stdlib/socket.tl, share/txr/stdlib/stream-wrap.tl,
share/txr/stdlib/struct.tl, share/txr/stdlib/tagbody.tl,
share/txr/stdlib/termios.tl, share/txr/stdlib/trace.tl
share/txr/stdlib/txr-case.tl, share/txr/stdlib/type.tl,
share/txr/stdlib/ver.tl, share/txr/stdlib/with-resources.tl,
share/txr/stdlib/with-stream.tl, share/txr/stdlib/yield.tl:
Deal with the various usr versus sys symbol issues.
-rw-r--r-- | Makefile | 3 | ||||
-rw-r--r-- | lisplib.c | 2 | ||||
-rw-r--r-- | share/txr/stdlib/asm.tl | 2 | ||||
-rw-r--r-- | share/txr/stdlib/awk.tl | 20 | ||||
-rw-r--r-- | share/txr/stdlib/build.tl | 14 | ||||
-rw-r--r-- | share/txr/stdlib/compiler.tl | 2 | ||||
-rw-r--r-- | share/txr/stdlib/error.tl | 4 | ||||
-rw-r--r-- | share/txr/stdlib/except.tl | 2 | ||||
-rw-r--r-- | share/txr/stdlib/ifa.tl | 4 | ||||
-rw-r--r-- | share/txr/stdlib/keyparams.tl | 10 | ||||
-rw-r--r-- | share/txr/stdlib/path-test.tl | 8 | ||||
-rw-r--r-- | share/txr/stdlib/trace.tl | 4 | ||||
-rw-r--r-- | share/txr/stdlib/type.tl | 4 | ||||
-rw-r--r-- | share/txr/stdlib/with-resources.tl | 14 | ||||
-rw-r--r-- | share/txr/stdlib/with-stream.tl | 6 | ||||
-rw-r--r-- | share/txr/stdlib/yield.tl | 4 |
16 files changed, 50 insertions, 53 deletions
@@ -144,7 +144,8 @@ endef define COMPILE_TL $(call ABBREV,TXR) -$(call SH,$(TXR) -e "(compile-file \"$<\" \"$@.tmp\")") +$(call SH,$(TXR) -e \ + "(progn (in-package sys) (compile-file \"$<\" \"$@.tmp\"))") $(call SH,mv $@.tmp $@) endef @@ -763,7 +763,7 @@ val lisplib_try_load(val sym) debug_state_t ds = debug_set_state(opt_dbg_autoload ? 0 : -1, opt_dbg_autoload); val saved_dyn_env = dyn_env; dyn_env = make_env(nil, nil, dyn_env); - env_vbind(dyn_env, package_s, user_package); + env_vbind(dyn_env, package_s, system_package); env_vbind(dyn_env, package_alist_s, packages); funcall(fun); dyn_env = saved_dyn_env; diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index da456654..14f0e402 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -24,8 +24,6 @@ ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -(in-package sys) - (defstruct oc-base nil (:method synerr (me fmt . args) (error `opcode @{me.symbol}: @fmt` . args)) diff --git a/share/txr/stdlib/awk.tl b/share/txr/stdlib/awk.tl index f657e72d..949991ea 100644 --- a/share/txr/stdlib/awk.tl +++ b/share/txr/stdlib/awk.tl @@ -370,7 +370,7 @@ (macrolet ((next () '(return-from :awk-rec)) (again () '(return-from :awk-rec :awk-again)) (next-file () '(return-from :awk-file)) - (sys:rng (form from-expr to-expr :env e) + (sys:rng-if (form from-expr to-expr :env e) ^(sys:rng-impl ,form (sys:awk-test ,from-expr ,(qref ,awc rng-rec-temp)) (sys:awk-test ,to-expr ,(qref ,awc rng-rec-temp)))) @@ -439,15 +439,15 @@ (t t)))))) (qref ,awc rng-exprs)))) rng-temp))) - (rng (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (-rng (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (rng- (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (-rng- (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (--rng (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (--rng- (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (rng+ (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (-rng+ (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) - (--rng+ (:form form from-expr to-expr) ^(sys:rng ,form ,from-expr ,to-expr)) + (rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (-rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (-rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (--rng (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (--rng- (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (-rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) + (--rng+ (:form form from-expr to-expr) ^(sys:rng-if ,form ,from-expr ,to-expr)) (ff (. opip-args) ^(symacrolet ((f (rslot ,',aws-sym 'fields 'f-to-rec))) (set f [(opip ,*opip-args) f]))) diff --git a/share/txr/stdlib/build.tl b/share/txr/stdlib/build.tl index fdee5c86..6fc3c83b 100644 --- a/share/txr/stdlib/build.tl +++ b/share/txr/stdlib/build.tl @@ -32,17 +32,17 @@ bc.tail (last bc.head))) (:method add (self . items) - (set self.tail (last (rplacd self.tail (copy items))))) + (set self.tail (last (usr:rplacd self.tail (copy items))))) (:method add* (self . items) (let ((ic (copy items)) (h self.head)) - (rplacd (last ic) (cdr h)) - (rplacd h ic))) + (usr:rplacd (last ic) (cdr h)) + (usr:rplacd h ic))) (:method pend (self . lists) (while lists - (set self.tail (last (rplacd self.tail (copy (car lists))))) + (set self.tail (last (usr:rplacd self.tail (copy (car lists))))) (set lists (cdr lists)))) (:method pend* (self . lists) @@ -50,13 +50,13 @@ (nh (cons nil nil)) (tl nh)) (while lists - (set tl (last (rplacd tl (copy (car lists))))) + (set tl (last (usr:rplacd tl (copy (car lists))))) (set lists (cdr lists))) - (rplacd tl (cdr h)) + (usr:rplacd tl (cdr h)) (set self.head nh))) (:method ncon (self . lists) - (set self.tail (last (rplacd self.tail (nconc . lists))))) + (set self.tail (last (usr:rplacd self.tail (nconc . lists))))) (:method ncon* (self . lists) (let ((h self.head)) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 39fc1340..47d77d7f 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -24,8 +24,6 @@ ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -(in-package sys) - (defstruct (frag oreg code : fvars ffuns) nil oreg code diff --git a/share/txr/stdlib/error.tl b/share/txr/stdlib/error.tl index 1e9ec191..b58c93f9 100644 --- a/share/txr/stdlib/error.tl +++ b/share/txr/stdlib/error.tl @@ -37,14 +37,14 @@ (defun compile-warning (ctx fmt . args) (let ((loc (sys:loc ctx)) (name (sys:ctx-name ctx))) - (catch + (usr:catch (throwf 'warning `@loc~s: @fmt` name . args) (continue ())))) (defun compile-defr-warning (ctx tag fmt . args) (let ((loc (sys:loc ctx)) (name (sys:ctx-name ctx))) - (catch + (usr:catch (throw 'defr-warning (fmt `@loc~s: @fmt` name . args) tag) (continue ())))) diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index 82d19eea..02b36cd6 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -27,7 +27,7 @@ (defun sys:handle-bad-syntax (item) (throwf 'eval-error "~s: bad clause syntax: ~s" 'handle item)) -(defmacro catch (:form form :env e try-form . catch-clauses) +(defmacro usr:catch (:form form :env e try-form . catch-clauses) (let ((catch-syms [mapcar car catch-clauses]) (sys-catch-clauses (mapcar (do mac-param-bind @1 (type args . body) @1 (tree-bind (args-ex . body-ex) diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl index 253f2688..8639956b 100644 --- a/share/txr/stdlib/ifa.tl +++ b/share/txr/stdlib/ifa.tl @@ -25,8 +25,8 @@ ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (defmacro ifa (:env e test then : else) - (flet ((candidate-p (expr) - (not (or (constantp expr e) (symbolp expr))))) + (flet ((candidate-p (form) + (not (or (constantp form e) (symbolp form))))) (cond ((or (atom test) (null (cdr test))) ^(let ((it ,test)) (if it ,then ,else))) diff --git a/share/txr/stdlib/keyparams.tl b/share/txr/stdlib/keyparams.tl index a2cb5998..192b7aec 100644 --- a/share/txr/stdlib/keyparams.tl +++ b/share/txr/stdlib/keyparams.tl @@ -63,7 +63,7 @@ (eff-param (append before-key rest-param))) (each ((key-spec key-params)) (tree-case key-spec - ((var init var-p . junk) + ((sym init var-p . junk) (when (consp junk) (compile-error form "superfluous forms in ~s" key-spec)) (when junk @@ -71,15 +71,15 @@ (unless (bindable var-p) (compile-error form "~s isn't a bindable symbol" var-p)) :) - ((var init . more) + ((sym init . more) (unless (listp more) (compile-error form "invalid dotted form ~s" key-spec)) :) - ((var . more) + ((sym . more) (unless (listp more) (compile-error form "invalid dotted form ~s" key-spec)) - (unless (bindable var) - (compile-error form "~s isn't a bindable symbol" var))))) + (unless (bindable sym) + (compile-error form "~s isn't a bindable symbol" sym))))) (let* ((key-params-p [keep-if third key-params]) (key-vars [mapcar first key-params]) (key-vars-p [mapcar third key-params-p]) diff --git a/share/txr/stdlib/path-test.tl b/share/txr/stdlib/path-test.tl index 754bb6e1..795c7453 100644 --- a/share/txr/stdlib/path-test.tl +++ b/share/txr/stdlib/path-test.tl @@ -27,9 +27,9 @@ (defun sys:do-path-test (statfun path testfun) [testfun (if (stringp path) (ignerr [statfun path]) path)]) -(defmacro sys:path-test ((var statfun path) . body) +(defmacro sys:path-test ((sym statfun path) . body) ^[sys:do-path-test ,statfun ,path - (lambda (,var) (when ,var ,*body))]) + (lambda (,sym) (when ,sym ,*body))]) (defun sys:path-test-mode (statfun path mask) (sys:path-test (s statfun path) @@ -134,9 +134,9 @@ (and (not (rest g.mem)) (equal (getpwuid euid).name (first g.mem))))))))) -(defmacro sys:path-examine ((var statfun path) . body) +(defmacro sys:path-examine ((sym statfun path) . body) ^[sys:do-path-test ,statfun ,path - (lambda (,var) ,*body)]) + (lambda (,sym) ,*body)]) (defun path-newer (path-0 path-1) (sys:path-examine (s0 stat path-0) diff --git a/share/txr/stdlib/trace.tl b/share/txr/stdlib/trace.tl index 385f16e4..44dba55f 100644 --- a/share/txr/stdlib/trace.tl +++ b/share/txr/stdlib/trace.tl @@ -112,8 +112,8 @@ (sys:untrace (list name)))) (continue ()))))) -(defmacro trace (. names) +(defmacro usr:trace (. names) ^(sys:trace ',names)) -(defmacro untrace (. names) +(defmacro usr:untrace (. names) ^(sys:untrace ',names)) diff --git a/share/txr/stdlib/type.tl b/share/txr/stdlib/type.tl index 45f023c8..dc52957a 100644 --- a/share/txr/stdlib/type.tl +++ b/share/txr/stdlib/type.tl @@ -24,7 +24,7 @@ ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -(defmacro typecase (expr . clauses) +(defmacro typecase (form . clauses) (let* ((val (gensym)) (cond-pairs (collect-each ((cl clauses)) (tree-case cl @@ -35,5 +35,5 @@ (else (throwf 'eval-error "~s: bad clause syntax: ~s" 'typecase cl)))))) - ^(let ((,val ,expr)) + ^(let ((,val ,form)) (cond ,*cond-pairs)))) diff --git a/share/txr/stdlib/with-resources.tl b/share/txr/stdlib/with-resources.tl index fec00c37..273fbd9d 100644 --- a/share/txr/stdlib/with-resources.tl +++ b/share/txr/stdlib/with-resources.tl @@ -26,17 +26,17 @@ (defmacro with-resources (res-bindings . body) (tree-case res-bindings - (((var init cleanup) . rest) - ^(let ((,var ,init)) - (when ,var + (((sym init cleanup) . rest) + ^(let ((,sym ,init)) + (when ,sym (unwind-protect (with-resources ,rest ,*body) ,cleanup)))) - (((var init) . rest) - ^(let ((,var ,init)) + (((sym init) . rest) + ^(let ((,sym ,init)) (with-resources ,rest ,*body))) - ((var . rest) - ^(let (,var) + ((sym . rest) + ^(let (,sym) (with-resources ,rest ,*body))) (nil ^(progn ,*body)) diff --git a/share/txr/stdlib/with-stream.tl b/share/txr/stdlib/with-stream.tl index 9edca2c0..e150cae2 100644 --- a/share/txr/stdlib/with-stream.tl +++ b/share/txr/stdlib/with-stream.tl @@ -51,8 +51,8 @@ ^(let ((,stream (make-buf-stream ,buf))) ,*body)) -(defmacro with-stream ((var stream) . body) - ^(let ((,var ,stream)) +(defmacro with-stream ((sym stream) . body) + ^(let ((,sym ,stream)) (unwind-protect (progn ,*body) - (close-stream ,var)))) + (close-stream ,sym)))) diff --git a/share/txr/stdlib/yield.tl b/share/txr/stdlib/yield.tl index b8672818..3ab74745 100644 --- a/share/txr/stdlib/yield.tl +++ b/share/txr/stdlib/yield.tl @@ -84,7 +84,7 @@ ^(yield-from nil ,form) ^(yield-from nil))) -(defmacro suspend (:form form name var . body) - ^(sys:capture-cont ',name (lambda (,var) +(defmacro suspend (:form form name sym . body) + ^(sys:capture-cont ',name (lambda (,sym) (sys:abscond-from ,name (progn ,*body))) ',form)) |