From 8adad0ccf4573be896f9b1bf6ebb340839948b97 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 18 Feb 2022 22:13:35 -0800 Subject: lisplib: rename to autoload. * Makefile (OBJS): rename lisplib.o to autoload.o. * lisplib.c: Renamed to autoload.c. (lisplib_init_tables): Renamed to autoload_init_tables. (lisplib_init): Renamed to autoload_init, and calls autoload_init_tables. (lisplib_try_load): Renamed to autoload_try. (autoload_try_fun, autoload_try_var, autloload_try_slot, autoload_try_struct, autoload_try_keyword): Follow rename. * lisplib.h: Renamed to autoload.h. (lisplib_init): Renamed to autoload_init. * eval.c: Include autoload.h. (eval_init): Follow rename of lisplib_init. * gencadr.txr: include "autoload.h" * cadr.c: Regenerated. --- Makefile | 2 +- autoload.c | 1148 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ autoload.h | 43 +++ cadr.c | 2 +- eval.c | 4 +- gencadr.txr | 2 +- lisplib.c | 1148 ----------------------------------------------------------- lisplib.h | 43 --- 8 files changed, 1196 insertions(+), 1196 deletions(-) create mode 100644 autoload.c create mode 100644 autoload.h delete mode 100644 lisplib.c delete mode 100644 lisplib.h diff --git a/Makefile b/Makefile index f3a7e63d..4c1533fd 100644 --- a/Makefile +++ b/Makefile @@ -53,7 +53,7 @@ EXTRA_OBJS-y := OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o OBJS += arith.o hash.o utf8.o filter.o eval.o parser.o rand.o combi.o sysif.o -OBJS += args.o lisplib.o cadr.o struct.o itypes.o buf.o jmp.o protsym.o ffi.o +OBJS += args.o autoload.o cadr.o struct.o itypes.o buf.o jmp.o protsym.o ffi.o OBJS += strudel.o vm.o chksum.o chksums/sha256.o chksums/crc32.o chksums/md5.o OBJS += tree.o time.o psquare.o OBJS += linenoise/linenoise.o diff --git a/autoload.c b/autoload.c new file mode 100644 index 00000000..f039cb3a --- /dev/null +++ b/autoload.c @@ -0,0 +1,1148 @@ +/* Copyright 2015-2022 + * Kaz Kylheku + * Vancouver, Canada + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, 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. + */ + +#include +#include +#include +#include +#include "config.h" +#include "lib.h" +#include "eval.h" +#include "stream.h" +#include "hash.h" +#include "gc.h" +#include "debug.h" +#include "txr.h" +#include "socket.h" +#include "autoload.h" + +int opt_dbg_autoload; +val trace_loaded; + +static val autoload_hash[al_max + 1]; + +static void autload_set_impl(al_ns_t ns, val *name, val fun, val package) +{ + for (; *name; name++) { + val sym = intern(*name, package); + + if (fun) + sethash(autoload_hash[ns], sym, fun); + else + remhash(autoload_hash[ns], sym); + } +} + +void autoload_set(al_ns_t ns, val *name, val fun) +{ + autload_set_impl(ns, name, fun, user_package); +} + +static void autoload_sys_set(al_ns_t ns, val *name, val fun) +{ + autload_set_impl(ns, name, fun, system_package); +} + +static void autoload_key_set(al_ns_t ns, val *name, val fun) +{ + autload_set_impl(ns, name, fun, keyword_package); +} + +static void intern_only(val *name) +{ + for (; *name; name++) + intern(*name, user_package); +} + +static val place_set_entries(val fun) +{ + val sys_name[] = { + lit("get-fun-getter-setter"), lit("get-mb"), lit("get-vb"), + lit("register-simple-accessor"), + nil + }; + val vname[] = { + lit("*place-clobber-expander*"), lit("*place-update-expander*"), + lit("*place-delete-expander*"), lit("*place-macro*"), + nil + }; + val name[] = { + lit("get-update-expander"), lit("get-clobber-expander"), + lit("get-delete-expander"), + lit("place-form-p"), + lit("rlet"), lit("slet"), lit("alet"), lit("with-gensyms"), + lit("call-update-expander"), lit("call-clobber-expander"), + lit("call-delete-expander"), + lit("with-update-expander"), lit("with-clobber-expander"), + lit("with-delete-expander"), + lit("set"), lit("pset"), lit("zap"), lit("flip"), lit("inc"), lit("dec"), + lit("pinc"), lit("pdec"), + lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"), + lit("test-set"), lit("test-clear"), lit("compare-swap"), + lit("test-inc"), lit("test-dec"), + lit("pushnew"), lit("del"), lit("lset"), lit("upd"), + lit("defplace"), lit("define-place-macro"), lit("define-modify-macro"), + lit("placelet"), lit("placelet*"), lit("read-once"), + lit("define-accessor"), lit("with-slots"), + nil + }; + + autoload_sys_set(al_fun, sys_name, fun); + autoload_set(al_var, vname, fun); + autoload_set(al_fun, name, fun); + return nil; +} + +static val place_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("place"))); + return nil; +} + +static val ver_set_entries(val fun) +{ + val vname[] = { lit("*lib-version*"), lit("lib-version"), nil }; + autoload_set(al_var, vname, fun); + return nil; +} + +static val ver_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("ver"))); + return nil; +} + +static val ifa_set_entries(val fun) +{ + val name[] = { + lit("ifa"), lit("whena"), lit("conda"), lit("condlet"), lit("it"), nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val ifa_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("ifa"))); + return nil; +} + +static val txr_case_set_entries(val fun) +{ + val name[] = { lit("txr-if"), lit("txr-when"), lit("txr-case"), nil }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val txr_case_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("txr-case"))); + return nil; +} + +static val with_resources_set_entries(val fun) +{ + val name[] = { + lit("with-resources"), + lit("with-objects"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val with_resources_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("with-resources"))); + return nil; +} + +static val path_test_set_entries(val fun) +{ + val name[] = { + lit("path-exists-p"), lit("path-file-p"), lit("path-dir-p"), + lit("path-symlink-p"), lit("path-blkdev-p"), lit("path-chrdev-p"), + lit("path-sock-p"), lit("path-pipe-p"), lit("path-pipe-p"), + lit("path-setgid-p"), lit("path-setuid-p"), lit("path-sticky-p"), + lit("path-mine-p"), lit("path-my-group-p"), lit("path-executable-to-me-p"), + lit("path-writable-to-me-p"), lit("path-readable-to-me-p"), + lit("path-read-writable-to-me-p"), + lit("path-newer"), lit("path-older"), + lit("path-same-object"), lit("path-private-to-me-p"), + lit("path-strictly-private-to-me-p"), + lit("path-dir-empty"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val path_test_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("path-test"))); + return nil; +} + +static val struct_set_entries(val fun) +{ + val sys_name[] = { + lit("define-method"), lit("rslotset"), nil + }; + val name[] = { + lit("defstruct"), lit("qref"), lit("uref"), lit("new"), lit("lnew"), + lit("new*"), lit("lnew*"), + lit("meth"), lit("umeth"), lit("usl"), lit("defmeth"), lit("rslot"), + lit("define-struct-clause"), nil + }; + val vname[] = { + lit("*struct-clause-expander*"), nil + }; + + autoload_sys_set(al_fun, sys_name, fun); + autoload_set(al_fun, name, fun); + autoload_set(al_var, vname, fun); + + if (fun) + sethash(autoload_hash[al_fun], struct_lit_s, fun); + else + remhash(autoload_hash[al_fun], struct_lit_s); + + return nil; +} + +static val struct_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("struct"))); + return nil; +} + +static val with_stream_set_entries(val fun) +{ + val name[] = { + lit("with-out-string-stream"), + lit("with-out-strlist-stream"), + lit("with-out-buf-stream"), + lit("with-in-string-stream"), + lit("with-in-string-byte-stream"), + lit("with-in-buf-stream"), + lit("with-stream"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val with_stream_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("with-stream"))); + return nil; +} + +static val hash_set_entries(val fun) +{ + val name[] = { lit("with-hash-iter"), nil }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val hash_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("hash"))); + return nil; +} + +static val except_set_entries(val fun) +{ + val name[] = { + lit("catch"), lit("catch*"), lit("catch**"), lit("handle"), lit("handle*"), + lit("ignwarn"), lit("macro-time-ignwarn"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val except_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("except"))); + return nil; +} + +static val type_set_entries(val fun) +{ + val name[] = { + lit("typecase"), lit("etypecase"), nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val type_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("type"))); + return nil; +} + +static val yield_set_entries(val fun) +{ + val sys_name[] = { + lit("obtain-impl"), nil + }; + val name[] = { + lit("obtain"), lit("obtain-block"), lit("yield-from"), lit("yield"), + lit("obtain*"), lit("obtain*-block"), + lit("suspend"), lit("hlet"), lit("hlet*"), + nil + }; + autoload_sys_set(al_fun, sys_name, fun); + autoload_set(al_fun, name, fun); + return nil; +} + +static val yield_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("yield"))); + return nil; +} + +#if HAVE_SOCKETS +static val sock_set_entries(val fun) +{ + val sname[] = { + lit("sockaddr"), lit("sockaddr-in"), lit("sockaddr-in6"), + lit("sockaddr-un"), lit("addrinfo"), + nil + }; + val vname[] = { + lit("af-unspec"), lit("af-unix"), lit("af-inet"), lit("af-inet6"), + lit("sock-stream"), lit("sock-dgram"), + lit("inaddr-any"), lit("inaddr-loopback"), + lit("in6addr-any"), lit("in6addr-loopback"), + lit("sock-nonblock"), lit("sock-cloexec"), + lit("ai-passive"), lit("ai-canonname"), lit("ai-numerichost"), + lit("ai-v4mapped"), lit("ai-all"), lit("ai-addrconfig"), + lit("ai-numericserv"), lit("sol-socket"), lit("ipproto-ip"), + lit("ipproto-ipv6"), lit("ipproto-tcp"), lit("ipproto-udp"), + lit("so-acceptconn"), lit("so-broadcast"), lit("so-debug"), + lit("so-dontroute"), lit("so-error"), lit("so-keepalive"), + lit("so-linger"), lit("so-oobinline"), lit("so-rcvbuf"), + lit("so-rcvlowat"), lit("so-rcvtimeo"), lit("so-reuseaddr"), + lit("so-sndbuf"), lit("so-sndlowat"), lit("so-sndtimeo"), + lit("so-type"), lit("ipv6-join-group"), lit("ipv6-leave-group"), + lit("ipv6-multicast-hops"), lit("ipv6-multicast-if"), + lit("ipv6-multicast-loop"), lit("ipv6-unicast-hops"), + lit("ipv6-v6only"), lit("tcp-nodelay"), + nil + }; + val name[] = { + lit("getaddrinfo"), + lit("str-inaddr"), lit("str-in6addr"), + lit("str-inaddr-net"), lit("str-in6addr-net"), + lit("inaddr-str"), lit("in6addr-str"), + lit("shut-rd"), lit("shut-wr"), lit("shut-rdwr"), + lit("open-socket"), lit("open-socket-pair"), + lit("sock-bind"), lit("sock-connect"), lit("sock-listen"), + lit("sock-accept"), lit("sock-shutdown"), lit("open-socket"), + lit("open-socket-pair"), lit("sock-send-timeout"), lit("sock-recv-timeout"), + lit("sock-opt"), lit("sock-set-opt"), + nil + }; + val name_noload[] = { + lit("family"), lit("addr"), lit("port"), lit("flow-info"), + lit("scope-id"), lit("prefix"), lit("path"), lit("flags"), lit("socktype"), + lit("protocol"), lit("canonname"), nil + }; + autoload_set(al_struct, sname, fun); + autoload_set(al_var, vname, fun); + autoload_set(al_fun, name, fun); + intern_only(name_noload); + return nil; +} + +static val sock_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + sock_load_init(); + load(scat2(stdlib_path, lit("socket"))); + return nil; +} + +#endif + +#if HAVE_TERMIOS + +static val termios_set_entries(val fun) +{ + val slname[] = { + lit("set-iflags"), lit("set-oflags"), lit("set-cflags"), lit("set-lflags"), + lit("clear-iflags"), lit("clear-oflags"), lit("clear-cflags"), lit("clear-lflags"), + lit("go-raw"), lit("go-cbreak"), lit("go-canon"), + lit("string-encode"), lit("string-decode"), nil + }; + autoload_set(al_slot, slname, fun); + return nil; +} + +static val termios_instantiate(val set_fun) +{ + funcall1(set_fun, nil); + load(scat2(stdlib_path, lit("termios"))); + return nil; +} + +#endif + +static val awk_set_entries(val fun) +{ + val sys_sname[] = { + lit("awk-state"), nil + }; + val name[] = { + lit("awk"), nil + }; + val name_noload[] = { + lit("rec"), lit("orec"), lit("f"), lit("nf"), lit("nr"), lit("fnr"), + lit("arg"), lit("fname"), lit("rs"), lit("krs"), lit("fs"), lit("ft"), + lit("fw"), lit("kfs"), lit("ofs"), lit("ors"), lit("next"), lit("again"), + lit("next-file"), lit("rng"), lit("-rng"), lit("rng-"), lit("-rng-"), + lit("--rng"), lit("--rng-"), lit("rng+"), lit("-rng+"), lit("--rng+"), + lit("ff"), lit("f"), lit("mf"), lit("fconv"), lit("->"), lit("->>"), + lit("<-"), lit("!>"), lit("= 185) + autoload_reg(op_instantiate, op_set_entries); + + autoload_reg(save_exe_instantiate, save_exe_set_entries); + autoload_reg(defset_instantiate, defset_set_entries); + autoload_reg(copy_file_instantiate, copy_file_set_entries); + autoload_reg(arith_each_instantiate, arith_each_set_entries); + autoload_reg(each_prod_instantiate, each_prod_set_entries); + autoload_reg(quips_instantiate, quips_set_entries); + autoload_reg(match_instantiate, match_set_entries); + autoload_reg(doc_instantiate, doc_set_entries); + autoload_reg(pic_instantiate, pic_set_entries); + autoload_reg(constfun_instantiate, constfun_set_entries); + + reg_fun(intern(lit("autoload-try-fun"), system_package), func_n1(autoload_try_fun)); +} + +static val autoload_try(al_ns_t ns, val sym) +{ + val fun = gethash(autoload_hash[ns], sym); + + if (fun) { + unsigned ds = debug_clear(opt_dbg_autoload ? 0 : DBG_ENABLE); + val saved_dyn_env = dyn_env; + dyn_env = make_env(nil, nil, dyn_env); + env_vbind(dyn_env, package_s, system_package); + env_vbind(dyn_env, package_alist_s, packages); + funcall(fun); + dyn_env = saved_dyn_env; + debug_restore(ds); + return t; + } + return nil; +} + +val autoload_try_fun(val sym) +{ + return autoload_try(al_fun, sym); +} + +val autoload_try_var(val sym) +{ + return autoload_try(al_var, sym); +} + +val autoload_try_fun_var(val sym) +{ + uses_or2; + return or2(autoload_try_fun(sym), + autoload_try_var(sym)); +} + +val autoload_try_slot(val sym) +{ + return autoload_try(al_slot, sym); +} + +val autoload_try_struct(val sym) +{ + return autoload_try(al_struct, sym); +} + +val autoload_try_keyword(val sym) +{ + return autoload_try(al_key, sym); +} diff --git a/autoload.h b/autoload.h new file mode 100644 index 00000000..23ad7883 --- /dev/null +++ b/autoload.h @@ -0,0 +1,43 @@ +/* Copyright 2015-2022 + * Kaz Kylheku + * Vancouver, Canada + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, 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. + */ + +typedef enum autoload_ns { + al_var, al_fun, al_slot, al_struct, al_key, al_max = al_key +} al_ns_t; + +extern val trace_loaded; +void autoload_init(void); +val autoload_try_fun(val sym); +val autoload_try_var(val sym); +val autoload_try_fun_var(val sym); +val autoload_try_slot(val sym); +val autoload_try_struct(val sym); +val autoload_try_keyword(val sym); +void autoload_set(al_ns_t ns, val *name, val fun); +val autoload_reg(val (*instantiate)(val), + val (*set_entries)(val)); diff --git a/cadr.c b/cadr.c index d0c7765a..2a2ce117 100644 --- a/cadr.c +++ b/cadr.c @@ -36,7 +36,7 @@ #include "lib.h" #include "eval.h" #include "stream.h" -#include "lisplib.h" +#include "autoload.h" #include "txr.h" #include "cadr.h" diff --git a/eval.c b/eval.c index 3c456fc1..bacee841 100644 --- a/eval.c +++ b/eval.c @@ -51,7 +51,7 @@ #include "match.h" #include "txr.h" #include "combi.h" -#include "lisplib.h" +#include "autoload.h" #include "struct.h" #include "cadr.h" #include "filter.h" @@ -7482,7 +7482,7 @@ void eval_init(void) uw_register_subtype(case_error_s, error_s); atexit(run_load_hooks_atexit); - lisplib_init(); + autoload_init(); } void eval_compat_fixup(int compat_ver) diff --git a/gencadr.txr b/gencadr.txr index 20e7b7bb..42a7f435 100644 --- a/gencadr.txr +++ b/gencadr.txr @@ -29,7 +29,7 @@ #include "lib.h" #include "eval.h" #include "stream.h" -#include "lisplib.h" +#include "autoload.h" #include "txr.h" #include "cadr.h" @ (repeat) diff --git a/lisplib.c b/lisplib.c deleted file mode 100644 index 2dbf4492..00000000 --- a/lisplib.c +++ /dev/null @@ -1,1148 +0,0 @@ -/* Copyright 2015-2022 - * Kaz Kylheku - * Vancouver, Canada - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, 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. - */ - -#include -#include -#include -#include -#include "config.h" -#include "lib.h" -#include "eval.h" -#include "stream.h" -#include "hash.h" -#include "gc.h" -#include "debug.h" -#include "txr.h" -#include "socket.h" -#include "lisplib.h" - -int opt_dbg_autoload; -val trace_loaded; - -static val autoload_hash[al_max + 1]; - -static void autload_set_impl(al_ns_t ns, val *name, val fun, val package) -{ - for (; *name; name++) { - val sym = intern(*name, package); - - if (fun) - sethash(autoload_hash[ns], sym, fun); - else - remhash(autoload_hash[ns], sym); - } -} - -void autoload_set(al_ns_t ns, val *name, val fun) -{ - autload_set_impl(ns, name, fun, user_package); -} - -static void autoload_sys_set(al_ns_t ns, val *name, val fun) -{ - autload_set_impl(ns, name, fun, system_package); -} - -static void autoload_key_set(al_ns_t ns, val *name, val fun) -{ - autload_set_impl(ns, name, fun, keyword_package); -} - -static void intern_only(val *name) -{ - for (; *name; name++) - intern(*name, user_package); -} - -static val place_set_entries(val fun) -{ - val sys_name[] = { - lit("get-fun-getter-setter"), lit("get-mb"), lit("get-vb"), - lit("register-simple-accessor"), - nil - }; - val vname[] = { - lit("*place-clobber-expander*"), lit("*place-update-expander*"), - lit("*place-delete-expander*"), lit("*place-macro*"), - nil - }; - val name[] = { - lit("get-update-expander"), lit("get-clobber-expander"), - lit("get-delete-expander"), - lit("place-form-p"), - lit("rlet"), lit("slet"), lit("alet"), lit("with-gensyms"), - lit("call-update-expander"), lit("call-clobber-expander"), - lit("call-delete-expander"), - lit("with-update-expander"), lit("with-clobber-expander"), - lit("with-delete-expander"), - lit("set"), lit("pset"), lit("zap"), lit("flip"), lit("inc"), lit("dec"), - lit("pinc"), lit("pdec"), - lit("push"), lit("pop"), lit("swap"), lit("shift"), lit("rotate"), - lit("test-set"), lit("test-clear"), lit("compare-swap"), - lit("test-inc"), lit("test-dec"), - lit("pushnew"), lit("del"), lit("lset"), lit("upd"), - lit("defplace"), lit("define-place-macro"), lit("define-modify-macro"), - lit("placelet"), lit("placelet*"), lit("read-once"), - lit("define-accessor"), lit("with-slots"), - nil - }; - - autoload_sys_set(al_fun, sys_name, fun); - autoload_set(al_var, vname, fun); - autoload_set(al_fun, name, fun); - return nil; -} - -static val place_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("place"))); - return nil; -} - -static val ver_set_entries(val fun) -{ - val vname[] = { lit("*lib-version*"), lit("lib-version"), nil }; - autoload_set(al_var, vname, fun); - return nil; -} - -static val ver_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("ver"))); - return nil; -} - -static val ifa_set_entries(val fun) -{ - val name[] = { - lit("ifa"), lit("whena"), lit("conda"), lit("condlet"), lit("it"), nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val ifa_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("ifa"))); - return nil; -} - -static val txr_case_set_entries(val fun) -{ - val name[] = { lit("txr-if"), lit("txr-when"), lit("txr-case"), nil }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val txr_case_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("txr-case"))); - return nil; -} - -static val with_resources_set_entries(val fun) -{ - val name[] = { - lit("with-resources"), - lit("with-objects"), - nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val with_resources_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("with-resources"))); - return nil; -} - -static val path_test_set_entries(val fun) -{ - val name[] = { - lit("path-exists-p"), lit("path-file-p"), lit("path-dir-p"), - lit("path-symlink-p"), lit("path-blkdev-p"), lit("path-chrdev-p"), - lit("path-sock-p"), lit("path-pipe-p"), lit("path-pipe-p"), - lit("path-setgid-p"), lit("path-setuid-p"), lit("path-sticky-p"), - lit("path-mine-p"), lit("path-my-group-p"), lit("path-executable-to-me-p"), - lit("path-writable-to-me-p"), lit("path-readable-to-me-p"), - lit("path-read-writable-to-me-p"), - lit("path-newer"), lit("path-older"), - lit("path-same-object"), lit("path-private-to-me-p"), - lit("path-strictly-private-to-me-p"), - lit("path-dir-empty"), - nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val path_test_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("path-test"))); - return nil; -} - -static val struct_set_entries(val fun) -{ - val sys_name[] = { - lit("define-method"), lit("rslotset"), nil - }; - val name[] = { - lit("defstruct"), lit("qref"), lit("uref"), lit("new"), lit("lnew"), - lit("new*"), lit("lnew*"), - lit("meth"), lit("umeth"), lit("usl"), lit("defmeth"), lit("rslot"), - lit("define-struct-clause"), nil - }; - val vname[] = { - lit("*struct-clause-expander*"), nil - }; - - autoload_sys_set(al_fun, sys_name, fun); - autoload_set(al_fun, name, fun); - autoload_set(al_var, vname, fun); - - if (fun) - sethash(autoload_hash[al_fun], struct_lit_s, fun); - else - remhash(autoload_hash[al_fun], struct_lit_s); - - return nil; -} - -static val struct_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("struct"))); - return nil; -} - -static val with_stream_set_entries(val fun) -{ - val name[] = { - lit("with-out-string-stream"), - lit("with-out-strlist-stream"), - lit("with-out-buf-stream"), - lit("with-in-string-stream"), - lit("with-in-string-byte-stream"), - lit("with-in-buf-stream"), - lit("with-stream"), - nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val with_stream_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("with-stream"))); - return nil; -} - -static val hash_set_entries(val fun) -{ - val name[] = { lit("with-hash-iter"), nil }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val hash_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("hash"))); - return nil; -} - -static val except_set_entries(val fun) -{ - val name[] = { - lit("catch"), lit("catch*"), lit("catch**"), lit("handle"), lit("handle*"), - lit("ignwarn"), lit("macro-time-ignwarn"), - nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val except_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("except"))); - return nil; -} - -static val type_set_entries(val fun) -{ - val name[] = { - lit("typecase"), lit("etypecase"), nil - }; - autoload_set(al_fun, name, fun); - return nil; -} - -static val type_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("type"))); - return nil; -} - -static val yield_set_entries(val fun) -{ - val sys_name[] = { - lit("obtain-impl"), nil - }; - val name[] = { - lit("obtain"), lit("obtain-block"), lit("yield-from"), lit("yield"), - lit("obtain*"), lit("obtain*-block"), - lit("suspend"), lit("hlet"), lit("hlet*"), - nil - }; - autoload_sys_set(al_fun, sys_name, fun); - autoload_set(al_fun, name, fun); - return nil; -} - -static val yield_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("yield"))); - return nil; -} - -#if HAVE_SOCKETS -static val sock_set_entries(val fun) -{ - val sname[] = { - lit("sockaddr"), lit("sockaddr-in"), lit("sockaddr-in6"), - lit("sockaddr-un"), lit("addrinfo"), - nil - }; - val vname[] = { - lit("af-unspec"), lit("af-unix"), lit("af-inet"), lit("af-inet6"), - lit("sock-stream"), lit("sock-dgram"), - lit("inaddr-any"), lit("inaddr-loopback"), - lit("in6addr-any"), lit("in6addr-loopback"), - lit("sock-nonblock"), lit("sock-cloexec"), - lit("ai-passive"), lit("ai-canonname"), lit("ai-numerichost"), - lit("ai-v4mapped"), lit("ai-all"), lit("ai-addrconfig"), - lit("ai-numericserv"), lit("sol-socket"), lit("ipproto-ip"), - lit("ipproto-ipv6"), lit("ipproto-tcp"), lit("ipproto-udp"), - lit("so-acceptconn"), lit("so-broadcast"), lit("so-debug"), - lit("so-dontroute"), lit("so-error"), lit("so-keepalive"), - lit("so-linger"), lit("so-oobinline"), lit("so-rcvbuf"), - lit("so-rcvlowat"), lit("so-rcvtimeo"), lit("so-reuseaddr"), - lit("so-sndbuf"), lit("so-sndlowat"), lit("so-sndtimeo"), - lit("so-type"), lit("ipv6-join-group"), lit("ipv6-leave-group"), - lit("ipv6-multicast-hops"), lit("ipv6-multicast-if"), - lit("ipv6-multicast-loop"), lit("ipv6-unicast-hops"), - lit("ipv6-v6only"), lit("tcp-nodelay"), - nil - }; - val name[] = { - lit("getaddrinfo"), - lit("str-inaddr"), lit("str-in6addr"), - lit("str-inaddr-net"), lit("str-in6addr-net"), - lit("inaddr-str"), lit("in6addr-str"), - lit("shut-rd"), lit("shut-wr"), lit("shut-rdwr"), - lit("open-socket"), lit("open-socket-pair"), - lit("sock-bind"), lit("sock-connect"), lit("sock-listen"), - lit("sock-accept"), lit("sock-shutdown"), lit("open-socket"), - lit("open-socket-pair"), lit("sock-send-timeout"), lit("sock-recv-timeout"), - lit("sock-opt"), lit("sock-set-opt"), - nil - }; - val name_noload[] = { - lit("family"), lit("addr"), lit("port"), lit("flow-info"), - lit("scope-id"), lit("prefix"), lit("path"), lit("flags"), lit("socktype"), - lit("protocol"), lit("canonname"), nil - }; - autoload_set(al_struct, sname, fun); - autoload_set(al_var, vname, fun); - autoload_set(al_fun, name, fun); - intern_only(name_noload); - return nil; -} - -static val sock_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - sock_load_init(); - load(scat2(stdlib_path, lit("socket"))); - return nil; -} - -#endif - -#if HAVE_TERMIOS - -static val termios_set_entries(val fun) -{ - val slname[] = { - lit("set-iflags"), lit("set-oflags"), lit("set-cflags"), lit("set-lflags"), - lit("clear-iflags"), lit("clear-oflags"), lit("clear-cflags"), lit("clear-lflags"), - lit("go-raw"), lit("go-cbreak"), lit("go-canon"), - lit("string-encode"), lit("string-decode"), nil - }; - autoload_set(al_slot, slname, fun); - return nil; -} - -static val termios_instantiate(val set_fun) -{ - funcall1(set_fun, nil); - load(scat2(stdlib_path, lit("termios"))); - return nil; -} - -#endif - -static val awk_set_entries(val fun) -{ - val sys_sname[] = { - lit("awk-state"), nil - }; - val name[] = { - lit("awk"), nil - }; - val name_noload[] = { - lit("rec"), lit("orec"), lit("f"), lit("nf"), lit("nr"), lit("fnr"), - lit("arg"), lit("fname"), lit("rs"), lit("krs"), lit("fs"), lit("ft"), - lit("fw"), lit("kfs"), lit("ofs"), lit("ors"), lit("next"), lit("again"), - lit("next-file"), lit("rng"), lit("-rng"), lit("rng-"), lit("-rng-"), - lit("--rng"), lit("--rng-"), lit("rng+"), lit("-rng+"), lit("--rng+"), - lit("ff"), lit("f"), lit("mf"), lit("fconv"), lit("->"), lit("->>"), - lit("<-"), lit("!>"), lit("= 185) - autoload_reg(op_instantiate, op_set_entries); - - autoload_reg(save_exe_instantiate, save_exe_set_entries); - autoload_reg(defset_instantiate, defset_set_entries); - autoload_reg(copy_file_instantiate, copy_file_set_entries); - autoload_reg(arith_each_instantiate, arith_each_set_entries); - autoload_reg(each_prod_instantiate, each_prod_set_entries); - autoload_reg(quips_instantiate, quips_set_entries); - autoload_reg(match_instantiate, match_set_entries); - autoload_reg(doc_instantiate, doc_set_entries); - autoload_reg(pic_instantiate, pic_set_entries); - autoload_reg(constfun_instantiate, constfun_set_entries); - - reg_fun(intern(lit("autoload-try-fun"), system_package), func_n1(autoload_try_fun)); -} - -static val lisplib_try_load(al_ns_t ns, val sym) -{ - val fun = gethash(autoload_hash[ns], sym); - - if (fun) { - unsigned ds = debug_clear(opt_dbg_autoload ? 0 : DBG_ENABLE); - val saved_dyn_env = dyn_env; - dyn_env = make_env(nil, nil, dyn_env); - env_vbind(dyn_env, package_s, system_package); - env_vbind(dyn_env, package_alist_s, packages); - funcall(fun); - dyn_env = saved_dyn_env; - debug_restore(ds); - return t; - } - return nil; -} - -val autoload_try_fun(val sym) -{ - return lisplib_try_load(al_fun, sym); -} - -val autoload_try_var(val sym) -{ - return lisplib_try_load(al_var, sym); -} - -val autoload_try_fun_var(val sym) -{ - uses_or2; - return or2(autoload_try_fun(sym), - autoload_try_var(sym)); -} - -val autoload_try_slot(val sym) -{ - return lisplib_try_load(al_slot, sym); -} - -val autoload_try_struct(val sym) -{ - return lisplib_try_load(al_struct, sym); -} - -val autoload_try_keyword(val sym) -{ - return lisplib_try_load(al_key, sym); -} diff --git a/lisplib.h b/lisplib.h deleted file mode 100644 index 6b4a81b0..00000000 --- a/lisplib.h +++ /dev/null @@ -1,43 +0,0 @@ -/* Copyright 2015-2022 - * Kaz Kylheku - * Vancouver, Canada - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, 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. - */ - -typedef enum autoload_ns { - al_var, al_fun, al_slot, al_struct, al_key, al_max = al_key -} al_ns_t; - -extern val trace_loaded; -void lisplib_init(void); -val autoload_try_fun(val sym); -val autoload_try_var(val sym); -val autoload_try_fun_var(val sym); -val autoload_try_slot(val sym); -val autoload_try_struct(val sym); -val autoload_try_keyword(val sym); -void autoload_set(al_ns_t ns, val *name, val fun); -val autoload_reg(val (*instantiate)(val), - val (*set_entries)(val)); -- cgit v1.2.3