From 938f75d31e59c47a24aa16b5d3fcfd3f30cd4a80 Mon Sep 17 00:00:00 2001 From: jackyansongli Date: Fri, 1 Nov 2024 15:57:39 -0500 Subject: [PATCH 1/3] [jl/goldfish:bump to 17.10.8] --- .../plugins/goldfish/goldfish/liii/base.scm | 23 ++- .../plugins/goldfish/goldfish/liii/base64.scm | 136 ++++++++++++++++++ .../goldfish/goldfish/liii/bitwise.scm | 6 +- .../plugins/goldfish/goldfish/liii/list.scm | 6 +- TeXmacs/plugins/goldfish/goldfish/liii/os.scm | 18 ++- .../plugins/goldfish/goldfish/liii/string.scm | 8 +- .../plugins/goldfish/goldfish/liii/vector.scm | 2 +- .../plugins/goldfish/goldfish/scheme/base.scm | 23 +-- .../goldfish/goldfish/srfi/srfi-133.scm | 29 +++- .../goldfish/goldfish/srfi/srfi-151.scm | 20 ++- TeXmacs/plugins/goldfish/src/goldfish.hpp | 18 ++- 11 files changed, 247 insertions(+), 42 deletions(-) create mode 100644 TeXmacs/plugins/goldfish/goldfish/liii/base64.scm diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/base.scm b/TeXmacs/plugins/goldfish/goldfish/liii/base.scm index cd14b6d8e5..aefb779f6c 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/base.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/base.scm @@ -24,11 +24,8 @@ ; R7RS 5: Program Structure define-values define-record-type ; R7RS 6.2: Numbers - square - exact inexact - floor s7-floor ceiling s7-ceiling truncate s7-truncate round s7-round - floor-quotient - gcd lcm s7-lcm + square exact inexact floor s7-floor ceiling s7-ceiling truncate s7-truncate + round s7-round floor-quotient gcd lcm s7-lcm ; R7RS 6.3: Booleans boolean=? ; R7RS 6.4: list @@ -42,18 +39,14 @@ ; R7RS 6.7: String string-copy ; R7RS 6.8 Vector - vector->string string->vector - vector-copy vector-copy! vector-fill! + vector->string string->vector vector-copy vector-copy! vector-fill! ; R7RS 6.9 Bytevectors - bytevector? make-bytevector bytevector bytevector-length - bytevector-u8-ref bytevector-u8-set! bytevector-append - utf8->string string->utf8 u8-string-length u8-substring + bytevector? make-bytevector bytevector bytevector-length bytevector-u8-ref + bytevector-u8-set! bytevector-append utf8->string string->utf8 u8-string-length + u8-substring ; Input and Output - call-with-port port? binary-port? textual-port? - input-port-open? output-port-open? - open-binary-input-file open-binary-output-file - close-port - eof-object + call-with-port port? binary-port? textual-port? input-port-open? output-port-open? + open-binary-input-file open-binary-output-file close-port eof-object ; Control flow string-map vector-map string-for-each vector-for-each ; Exception diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm b/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm new file mode 100644 index 0000000000..12dd4ad303 --- /dev/null +++ b/TeXmacs/plugins/goldfish/goldfish/liii/base64.scm @@ -0,0 +1,136 @@ +; +; Copyright (C) 2024 The Goldfish Scheme Authors +; +; Licensed under the Apache License, Version 2.0 (the "License"); +; you may not use this file except in compliance with the License. +; You may obtain a copy of the License at +; +; http://www.apache.org/licenses/LICENSE-2.0 +; +; Unless required by applicable law or agreed to in writing, software +; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT +; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the +; License for the specific language governing permissions and limitations +; under the License. +; + +(define-library (liii base64) +(import (liii base) + (liii bitwise)) +(export + string-base64-encode bytevector-base64-encode base64-encode + string-base64-decode bytevector-base64-decode base64-decode +) +(begin +(define-constant BYTE2BASE64_BV + (string->utf8 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) + +(define-constant BASE64_PAD_BYTE + (char->integer #\=)) + +(define bytevector-base64-encode + (typed-lambda ((bv bytevector?)) + (define (encode b1 b2 b3) + (let* ((p1 b1) + (p2 (if b2 b2 0)) + (p3 (if b3 b3 0)) + (combined (bitwise-ior (ash p1 16) (ash p2 8) p3)) + (c1 (bitwise-and (ash combined -18) #x3F)) + (c2 (bitwise-and (ash combined -12) #x3F)) + (c3 (bitwise-and (ash combined -6) #x3F)) + (c4 (bitwise-and combined #x3F))) + (values + (BYTE2BASE64_BV c1) + (BYTE2BASE64_BV c2) + (if b2 (BYTE2BASE64_BV c3) BASE64_PAD_BYTE) + (if b3 (BYTE2BASE64_BV c4) BASE64_PAD_BYTE)))) + + (let* ((input-N (bytevector-length bv)) + (output-N (* 4 (ceiling (/ input-N 3)))) + (output (make-bytevector output-N))) + (let loop ((i 0) (j 0)) + (when (< i input-N) + (let* ((b1 (bv i)) + (b2 (if (< (+ i 1) input-N) (bv (+ i 1)) #f)) + (b3 (if (< (+ i 2) input-N) (bv (+ i 2)) #f))) + (receive (r1 r2 r3 r4) (encode b1 b2 b3) + (bytevector-u8-set! output j r1) + (bytevector-u8-set! output (+ j 1) r2) + (bytevector-u8-set! output (+ j 2) r3) + (bytevector-u8-set! output (+ j 3) r4) + (loop (+ i 3) (+ j 4)))))) + output))) + +(define string-base64-encode + (typed-lambda ((str string?)) + (utf8->string (bytevector-base64-encode (string->utf8 str))))) + +(define (base64-encode x) + (cond ((string? x) + (string-base64-encode x)) + ((bytevector? x) + (bytevector-base64-encode x)) + (else + (type-error "input must be string or bytevector")))) + +(define-constant BASE64_TO_BYTE_V + (let1 byte2base64-N (bytevector-length BYTE2BASE64_BV) + (let loop ((i 0) (v (make-vector 256 -1))) + (if (< i byte2base64-N) + (begin + (vector-set! v (BYTE2BASE64_BV i) i) + (loop (+ i 1) v)) + v)))) + +(define (bytevector-base64-decode bv) + (define (decode c1 c2 c3 c4) + (let* ((b1 (BASE64_TO_BYTE_V c1)) + (b2 (BASE64_TO_BYTE_V c2)) + (b3 (BASE64_TO_BYTE_V c3)) + (b4 (BASE64_TO_BYTE_V c4))) + (if (or (negative? b1) (negative? b2) + (and (negative? b3) (!= c3 BASE64_PAD_BYTE)) + (and (negative? b4) (!= c4 BASE64_PAD_BYTE))) + (value-error "Invalid base64 input") + (values + (bitwise-ior (ash b1 2) (ash b2 -4)) + (bitwise-and (bitwise-ior (ash b2 4) (ash b3 -2)) #xFF) + (bitwise-and (bitwise-ior (ash b3 6) b4) #xFF) + (if (negative? b3) 1 (if (negative? b4) 2 3)))))) + + (let* ((input-N (bytevector-length bv)) + (output-N (* input-N 3/4)) + (output (make-bytevector output-N))) + + (unless (zero? (modulo input-N 4)) + (value-error "length of the input bytevector must be 4X")) + + (let loop ((i 0) (j 0)) + (if (< i input-N) + (receive (r1 r2 r3 cnt) + (decode (bv i) (bv (+ i 1)) (bv (+ i 2)) (bv (+ i 3))) + (bytevector-u8-set! output j r1) + (when (>= cnt 2) + (bytevector-u8-set! output (+ j 1) r2)) + (when (>= cnt 3) + (bytevector-u8-set! output (+ j 2) r3)) + (loop (+ i 4) (+ j cnt))) + (let ((final (make-bytevector j))) + (vector-copy! final 0 output 0 j) + final))))) + +(define string-base64-decode + (typed-lambda ((str string?)) + (utf8->string (bytevector-base64-decode (string->utf8 str))))) + +(define (base64-decode x) + (cond ((string? x) + (string-base64-decode x)) + ((bytevector? x) + (bytevector-base64-decode x)) + (else + (type-error "input must be string or bytevector")))) + +) ; end of begin +) ; end of define-library + diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm b/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm index 9a5d7f306b..b6edc83b60 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/bitwise.scm @@ -19,13 +19,17 @@ (liii error)) (export ; from (srfi srfi-151) - bitwise-not bitwise-and bitwise-ior bitwise-xor + bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-or bitwise-nor bitwise-nand + bit-count arithmetic-shift ; S7 built-in lognot logand logior logxor ash ) (begin + +(define bitwise-or bitwise-ior) + ) ; end of begin ) ; end of library diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/list.scm b/TeXmacs/plugins/goldfish/goldfish/liii/list.scm index 6f995d4755..a934a3e79e 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/list.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/list.scm @@ -153,7 +153,11 @@ ((integer? depth) (flatten-depth lst depth)) (else - (error 'type-error "flatten: the second argument depth should be symbol `deepest' or a integer, which will be uesd as depth, but got a ~A" depth))) + (type-error + (string-append + "flatten: the second argument depth should be symbol " + "`deepest' or a integer, which will be uesd as depth," + " but got a ~A") depth))) ) ; end of (define* (flatten)) ) ; end of begin diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/os.scm b/TeXmacs/plugins/goldfish/goldfish/liii/os.scm index bcc2bd0600..8674ddcc6d 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/os.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/os.scm @@ -17,10 +17,13 @@ (define-library (liii os) (export os-arch os-type os-windows? os-linux? os-macos? os-temp-dir + os-sep pathsep os-call system mkdir chdir rmdir getenv unsetenv getcwd listdir access getlogin getpid) (import (scheme process-context) - (liii error)) + (liii base) + (liii error) + (liii string)) (begin (define (os-call command) @@ -47,8 +50,19 @@ (let ((name (os-type))) (and name (string=? name "Darwin")))) +(define (os-sep) + (if (os-windows?) + #\\ + #\/)) + +(define (pathsep) + (if (os-windows?) + #\; + #\:)) + (define (os-temp-dir) - (g_os-temp-dir)) + (let1 temp-dir (g_os-temp-dir) + (string-remove-suffix temp-dir (string (os-sep))))) (define (access path mode) (cond ((eq? mode 'F_OK) (g_access path 0)) diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/string.scm b/TeXmacs/plugins/goldfish/goldfish/liii/string.scm index 3a524034fa..0d494b89bc 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/string.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/string.scm @@ -26,13 +26,13 @@ string-take string-take-right string-drop string-drop-right string-pad string-pad-right string-trim string-trim-right string-trim-both - string-prefix? string-suffix? string-index string-index-right string-contains string-count string-upcase string-downcase string-reverse string-tokenize ; Liii extras + string-starts? string-ends? string-remove-prefix string-remove-suffix ) (import (srfi srfi-13) @@ -40,6 +40,12 @@ (liii error)) (begin +(define (string-starts? str prefix) + (string-prefix? prefix str)) + +(define (string-ends? str suffix) + (string-suffix? suffix str)) + (define string-remove-prefix (typed-lambda ((str string?) (prefix string?)) (if (string-prefix? prefix str) diff --git a/TeXmacs/plugins/goldfish/goldfish/liii/vector.scm b/TeXmacs/plugins/goldfish/goldfish/liii/vector.scm index 4049a98f8c..d4b91c46c6 100644 --- a/TeXmacs/plugins/goldfish/goldfish/liii/vector.scm +++ b/TeXmacs/plugins/goldfish/goldfish/liii/vector.scm @@ -28,7 +28,7 @@ vector-count vector-any vector-every vector-copy vector-copy! vector-index vector-index-right vector-partition - vector-swap!) + vector-swap! vector-cumulate reverse-list->vector) (begin ) ; end of begin diff --git a/TeXmacs/plugins/goldfish/goldfish/scheme/base.scm b/TeXmacs/plugins/goldfish/goldfish/scheme/base.scm index 77f4172863..edae90cc25 100644 --- a/TeXmacs/plugins/goldfish/goldfish/scheme/base.scm +++ b/TeXmacs/plugins/goldfish/goldfish/scheme/base.scm @@ -20,12 +20,8 @@ ; R7RS 5: Program Structure define-values define-record-type ; R7RS 6.2: Numbers - square - exact inexact - floor s7-floor ceiling s7-ceiling truncate s7-truncate round s7-round - floor-quotient - gcd lcm s7-lcm - boolean=? + square exact inexact floor s7-floor ceiling s7-ceiling truncate s7-truncate + round s7-round floor-quotient gcd lcm s7-lcm boolean=? ; R7RS 6.4: list pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr null? list? make-list list length append reverse list-tail @@ -37,18 +33,13 @@ ; R7RS 6.7: String string-copy ; R7RS 6.8: Vector - vector->string string->vector - vector-copy vector-copy! vector-fill! + vector->string string->vector vector-copy vector-copy! vector-fill! ; R7RS 6.9: Bytevectors - bytevector? make-bytevector bytevector bytevector-length - bytevector-u8-ref bytevector-u8-set! bytevector-append - utf8->string string->utf8 u8-string-length + bytevector? make-bytevector bytevector bytevector-length bytevector-u8-ref + bytevector-u8-set! bytevector-append utf8->string string->utf8 u8-string-length ; Input and Output - call-with-port port? binary-port? textual-port? - input-port-open? output-port-open? - open-binary-input-file open-binary-output-file - close-port - eof-object + call-with-port port? binary-port? textual-port? input-port-open? output-port-open? + open-binary-input-file open-binary-output-file close-port eof-object ; Control flow string-map vector-map string-for-each vector-for-each ; Exception diff --git a/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-133.scm b/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-133.scm index 8c17b7b6cd..13dcfd782b 100644 --- a/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-133.scm +++ b/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-133.scm @@ -21,7 +21,7 @@ vector-count vector-any vector-every vector-copy vector-copy! vector-index vector-index-right vector-partition - vector-swap!) + vector-swap! vector-cumulate reverse-list->vector) (begin (define (vector-empty? v) @@ -37,6 +37,23 @@ (loop (+ i 1) (+ count 1))) (else (loop (+ i 1) count))))) +; Return a new vector v-rst with same length of input vector vec. +; Every element of the result is the result the i-th iteration of fn cumu_i vec_i. +; Where fn should be a procedure with 2 args. +; The type of knil and vector could be different. +; In the i-th iteration, cumu_i = fn cumu_(i-1) vec_i, with cumu_0 = fn knil vec_0. + +(define vector-cumulate + (typed-lambda ((fn procedure?) knil (vec vector?)) + (let* ((len (vector-length vec)) + (v-rst (make-vector len))) + (let loop ((i 0) (lhs knil)) + (if (= i len) + v-rst + (let1 cumu-i (fn lhs (vec i)) + (begin + (vector-set! v-rst i cumu-i) + (loop (+ 1 i) cumu-i)))))))) ; TODO optional parameters (define (vector-any pred v) (let loop ((i 0)) @@ -89,6 +106,16 @@ (vector-set! vec j elem-i) )) +; Input a proper-list, return a vector with inversed order elements. +(define reverse-list->vector + (typed-lambda ((lst proper-list?)) + (let* ((len (length lst)) (v-rst (make-vector len))) + (let loop ((l lst) (i (- len 1))) + (if (null? l) v-rst + (begin + (vector-set! v-rst i (car l)) + (loop (cdr l) (- i 1)))))))) + ) ; end of begin ) ; end of define-library diff --git a/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-151.scm b/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-151.scm index fab14e83be..34e6b75ef0 100644 --- a/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-151.scm +++ b/TeXmacs/plugins/goldfish/goldfish/srfi/srfi-151.scm @@ -16,7 +16,7 @@ (define-library (srfi srfi-151) (export - bitwise-not bitwise-and bitwise-ior bitwise-xor + bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-nor bitwise-nand bit-count arithmetic-shift ) (begin @@ -29,6 +29,24 @@ (define bitwise-xor logxor) +(define (bitwise-nor a b) + (lognot (bitwise-ior a b))) + +(define (bitwise-nand a b) + (lognot (bitwise-and a b))) + +(define bit-count + (typed-lambda ((i integer?)) + (define (bit-count-positive i) + (let loop ((n i) (cnt 0)) + (if (= n 0) + cnt + (loop (logand n (- n 1)) (+ cnt 1))))) + + (cond ((zero? i) 0) + ((positive? i) (bit-count-positive i)) + (else (bit-count-positive (lognot i)))))) + (define arithmetic-shift ash) ) ; end of begin diff --git a/TeXmacs/plugins/goldfish/src/goldfish.hpp b/TeXmacs/plugins/goldfish/src/goldfish.hpp index b1d26ca12f..482ab0ec1d 100644 --- a/TeXmacs/plugins/goldfish/src/goldfish.hpp +++ b/TeXmacs/plugins/goldfish/src/goldfish.hpp @@ -38,7 +38,7 @@ #include #endif -#define GOLDFISH_VERSION "17.10.7" +#define GOLDFISH_VERSION "17.10.8" #define GOLDFISH_PATH_MAXN TB_PATH_MAXN static std::vector command_args= std::vector (); @@ -306,9 +306,21 @@ f_listdir (s7_scheme* sc, s7_pointer args) { tb_directory_walk (path_c, 0, tb_false, tb_directory_walk_func, &entries); int entries_N= entries.size (); - int path_N = string (path_c).size (); + string path_s= string (path_c); + int path_N= path_s.size(); + int path_slash_N= path_N; + char last_ch= path_s[path_N-1]; +#if defined(TB_CONFIG_OS_WINDOWS) + if (last_ch != '/' && last_ch != '\\') { + path_slash_N= path_slash_N + 1; + } +#else + if (last_ch != '/') { + path_slash_N= path_slash_N + 1; + } +#endif for (int i= 0; i < entries_N; i++) { - entries[i]= entries[i].substr (path_N + 1); + entries[i]= entries[i].substr (path_slash_N); } return string_vector_to_s7_vector (sc, entries); } From 86bf9558e5a7d3c759a28568e329fea77a42c002 Mon Sep 17 00:00:00 2001 From: jackyansongli Date: Fri, 1 Nov 2024 22:32:52 -0500 Subject: [PATCH 2/3] [jl/revise_71_41] --- TeXmacs/plugins/goldfish/goldfish/goldfish/repl.scm | 2 +- TeXmacs/tests/71_41.scm | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/TeXmacs/plugins/goldfish/goldfish/goldfish/repl.scm b/TeXmacs/plugins/goldfish/goldfish/goldfish/repl.scm index 70d0983144..94b009cfb4 100644 --- a/TeXmacs/plugins/goldfish/goldfish/goldfish/repl.scm +++ b/TeXmacs/plugins/goldfish/goldfish/goldfish/repl.scm @@ -50,7 +50,7 @@ (define (build-goldfish-result obj) (let ((output (object->string obj)) (leadings (list "(document" "(math" "(equation*" "(align" "(with" "(graphics"))) - (if (find (lambda (x) (string-prefix? x output)) leadings) + (if (find (lambda (x) (string-starts? x output)) leadings) output (string-append "(goldfish-result " (goldfish-quote output) ")")))) diff --git a/TeXmacs/tests/71_41.scm b/TeXmacs/tests/71_41.scm index 0f7fd11474..da37f470d1 100644 --- a/TeXmacs/tests/71_41.scm +++ b/TeXmacs/tests/71_41.scm @@ -16,11 +16,11 @@ ; override the subroutine (define (is-top-level2 x) - (string-prefix? "chapter" x)) + (string-starts? "chapter" x)) ; override the subroutine (define (is-current-tree2 t) - (string-suffix? "current" t)) + (string-ends? "current" t)) (define (test) (check (filter-sections From f81c08c305d82fa092e2b652ed6b93079ae4f2ad Mon Sep 17 00:00:00 2001 From: jackyansongli Date: Fri, 1 Nov 2024 23:54:46 -0500 Subject: [PATCH 3/3] [jl/fix_71_41_string-begin_bug] --- TeXmacs/tests/71_41.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/TeXmacs/tests/71_41.scm b/TeXmacs/tests/71_41.scm index da37f470d1..5943883067 100644 --- a/TeXmacs/tests/71_41.scm +++ b/TeXmacs/tests/71_41.scm @@ -16,11 +16,11 @@ ; override the subroutine (define (is-top-level2 x) - (string-starts? "chapter" x)) + (string-starts? x "chapter")) ; override the subroutine (define (is-current-tree2 t) - (string-ends? "current" t)) + (string-ends? t "current")) (define (test) (check (filter-sections