diff options
| -rw-r--r-- | autoload.c | 17 | ||||
| -rw-r--r-- | stdlib/csort.tl | 43 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 4 | ||||
| -rw-r--r-- | tests/012/sort.tl | 25 | ||||
| -rw-r--r-- | txr.1 | 29 |
5 files changed, 116 insertions, 2 deletions
@@ -955,6 +955,22 @@ static val load_args_instantiate(void) return nil; } +static val csort_set_entries(val fun) +{ + val name[] = { + lit("csort"), lit("cnsort"), lit("cssort"), lit("csnsort"), + nil + }; + autoload_set(al_fun, name, fun); + return nil; +} + +static val csort_instantiate(void) +{ + load(scat2(stdlib_path, lit("csort"))); + return nil; +} + val autoload_reg(val (*instantiate)(void), val (*set_entries)(val)) { @@ -1024,6 +1040,7 @@ void autoload_init(void) autoload_reg(constfun_instantiate, constfun_set_entries); autoload_reg(expander_let_instantiate, expander_let_set_entries); autoload_reg(load_args_instantiate, load_args_set_entries); + autoload_reg(csort_instantiate, csort_set_entries); reg_fun(intern(lit("autoload-try-fun"), system_package), func_n1(autoload_try_fun)); } diff --git a/stdlib/csort.tl b/stdlib/csort.tl new file mode 100644 index 00000000..44715236 --- /dev/null +++ b/stdlib/csort.tl @@ -0,0 +1,43 @@ +;; Copyright 2023 +;; Kaz Kylheku <kaz@kylheku.com> +;; 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. + +(defmacro cached-sort-body (sort-fn) + ^(if (eq key-fun :) + (,sort-fn seq less-fun key-fun) + (,sort-fn seq less-fun (hash-map key-fun seq :eq-based)))) + +(defun csort (seq : (less-fun :) (key-fun :)) + (cached-sort-body sort)) + +(defun cnsort (seq : (less-fun :) (key-fun :)) + (cached-sort-body nsort)) + +(defun cssort (seq : (less-fun :) (key-fun :)) + (cached-sort-body ssort)) + +(defun csnsort (seq : (less-fun :) (key-fun :)) + (cached-sort-body snsort)) diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl index 4d4ee04d..47930ce8 100644 --- a/stdlib/doc-syms.tl +++ b/stdlib/doc-syms.tl @@ -350,6 +350,7 @@ ("closure" "N-0216EF16") ("cmp-str" "N-0143A273") ("cmspar" "N-01B1B5DF") + ("cnsort" "N-02102493") ("coded-length" "N-0167F423") ("coll" "D-0058") ("collect" "D-000E") @@ -447,6 +448,9 @@ ("cs7" "N-01B1B5DF") ("cs8" "N-01B1B5DF") ("csize" "N-01B1B5DF") + ("csnsort" "N-02102493") + ("csort" "N-02102493") + ("cssort" "N-02102493") ("cstopb" "N-01B1B5DF") ("cum-norm-dist" "N-03AB449B") ("cxr" "N-01DA4F04") diff --git a/tests/012/sort.tl b/tests/012/sort.tl index 241b0c45..4989a74b 100644 --- a/tests/012/sort.tl +++ b/tests/012/sort.tl @@ -27,7 +27,18 @@ (sort vec) vec (sort svec) vec (sort vec (fun greater)) (reverse vec) - (sort svec (fun greater)) (reverse vec))) + (sort svec (fun greater)) (reverse vec)) + (mvtest + (csort list) list + (csort slist) list + (csort list (fun greater)) (reverse list) + (csort slist (fun greater)) (reverse list)) + (mvtest + (csort vec) vec + (csort svec) vec + (csort vec (fun greater)) (reverse vec) + (csort svec (fun greater)) (reverse vec))) + (test (ssort ()) nil) @@ -56,4 +67,14 @@ (ssort vec) vec (ssort svec) vec (ssort vec (fun greater)) (reverse vec) - (ssort svec (fun greater)) (reverse vec))) + (ssort svec (fun greater)) (reverse vec)) + (mvtest + (cssort list) list + (cssort slist) list + (cssort list (fun greater)) (reverse list) + (cssort slist (fun greater)) (reverse list)) + (mvtest + (cssort vec) vec + (cssort svec) vec + (cssort vec (fun greater)) (reverse vec) + (cssort svec (fun greater)) (reverse vec))) @@ -38068,6 +38068,35 @@ was introduced in \*(TX 238. Prior to that version, behaved like .codn nsort . +.coNP Functions @, csort @, cnsort @ cssort and @ csnsort +.synb +.mets (csort < sequence >> [ lessfun <> [ keyfun ]]) +.mets (cnsort < sequence >> [ lessfun <> [ keyfun ]]) +.mets (cssort < sequence >> [ lessfun <> [ keyfun ]]) +.mets (csnsort < sequence >> [ lessfun <> [ keyfun ]]) +.syne +.desc +The functions +.codn csort , +.codn cnsort , +.code cssort +and +.code csnsort +are caching counterparts of, respectively, +.codn sort , +.codn nsort , +.code ssort +and +.codn snsort . +They have exactly the same argument syntax and semantics. + +Caching refers to eliminating repeated calls to +.meta keyfun +for the same element of +.metn sequence , +in order to reduce the execution time, at the cost of +using more storage. + .coNP Function @ grade .synb .mets (grade < sequence >> [ lessfun <> [ keyfun ]]) |