Add chez-* wrapper modules: networking, compression, PCRE2, YAML, LevelDB
ober
15d18626e74de183c13d3a1524254c7b981ad2ae
--- a/Makefile +++ b/Makefile @@ -1,7 +1,11 @@ SCHEME = scheme LIBDIRS = lib +# External chez-* library paths for wrapper modules +CHEZ_EXT_LIBDIRS = $(HOME)/mine/chez-https/src:$(HOME)/mine/chez-ssl/src:$(HOME)/mine/chez-zlib/src:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-yaml:$(HOME)/mine/chez-leveldb +# Shared object paths for FFI-based chez-* libraries +CHEZ_EXT_LDPATH = $(HOME)/mine/chez-ssl:$(HOME)/mine/chez-zlib:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-leveldb -.PHONY: test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded clean +.PHONY: test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-wrappers clean test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded @@ -38,6 +42,24 @@ test-expanded: $(SCHEME) --libdirs $(LIBDIRS) --script tests/test-expanded-stdlib.ss; \ fi +test-wrappers: + @echo "--- Wrapper module tests ---" + @$(SCHEME) --libdirs "$(LIBDIRS):$(CHEZ_EXT_LIBDIRS)" --script tests/test-wrappers.ss 2>/dev/null || echo " yaml: SKIP (library not found)" + @LD_LIBRARY_PATH="$(CHEZ_EXT_LDPATH):$$LD_LIBRARY_PATH" \ + $(SCHEME) --libdirs "$(LIBDIRS):$(CHEZ_EXT_LIBDIRS)" --script tests/test-wrapper-zlib.ss 2>/dev/null \ + || echo " zlib: SKIP (requires chez_zlib_shim.so)" + @ln -sf $(HOME)/mine/chez-ssl/chez_ssl_shim.so ./chez_ssl_shim.so 2>/dev/null; \ + LD_LIBRARY_PATH="$(CHEZ_EXT_LDPATH):$$LD_LIBRARY_PATH" \ + $(SCHEME) --libdirs "$(LIBDIRS):$(CHEZ_EXT_LIBDIRS)" --script tests/test-wrapper-ssl.ss 2>/dev/null \ + && $(SCHEME) --libdirs "$(LIBDIRS):$(CHEZ_EXT_LIBDIRS)" --script tests/test-wrapper-request.ss 2>/dev/null; \ + rm -f ./chez_ssl_shim.so \ + || echo " ssl/request: SKIP (requires chez_ssl_shim.so)" + @LD_LIBRARY_PATH="$(CHEZ_EXT_LDPATH):$$LD_LIBRARY_PATH" CHEZ_PCRE2_LIB="$(HOME)/mine/chez-pcre2" \ + $(SCHEME) --libdirs "$(LIBDIRS):$(CHEZ_EXT_LIBDIRS)" --script tests/test-wrapper-pcre2.ss 2>/dev/null \ + || echo " pcre2: SKIP (requires pcre2_shim.so)" + +test-all: test test-wrappers + clean: find lib -name "*.so" -delete 2>/dev/null || true find lib -name "*.wpo" -delete 2>/dev/null || true --- a/README.md +++ b/README.md @@ -108,6 +108,17 @@ scheme --libdirs lib --script your-file.ss | `(std srfi srfi-13)` | SRFI-13 string operations | | `(std srfi srfi-19)` | Date/time handling | +### External Library Wrappers (require [chez-*](https://github.com/ober) libraries) +| Module | Wraps | Provides | +|--------|-------|----------| +| `(std net request)` | chez-https | `http-get`, `http-post`, `http-put`, `http-delete`, `url-encode` | +| `(std net httpd)` | chez-httpd | `httpd-start`, `httpd-route`, `http-respond-json`, etc. | +| `(std net ssl)` | chez-ssl | `ssl-connect`, `tcp-connect`, `tcp-listen`, TLS/TCP networking | +| `(std compress zlib)` | chez-zlib | `gzip-bytevector`, `gunzip-bytevector`, `deflate-bytevector` | +| `(std text yaml)` | chez-yaml | `yaml-load`, `yaml-dump`, `yaml-load-string`, `yaml-dump-string` | +| `(std db leveldb)` | chez-leveldb | `leveldb-open`, `leveldb-put`, `leveldb-get`, iterators, batches | +| `(std pcre2)` | chez-pcre2 | `pcre2-compile`, `pcre2-search`, `pcre2-replace`, JIT regex | + ### FFI (`(jerboa ffi)`) - `c-lambda` → `foreign-procedure` with automatic type translation - `define-c-lambda` — named FFI bindings @@ -130,14 +141,17 @@ One import for everything: ## Testing ```bash -make test +make test # Core tests (289 tests) +make test-wrappers # External library wrapper tests (27 tests) +make test-all # Both ``` -Runs 213 tests across reader, core macros, runtime, standard library, FFI, and module path mapping. +Runs 289 tests across reader, core macros, runtime, standard library, FFI, module paths, and expanded stdlib. Wrapper tests add 27 more for chez-* library integrations. ## Requirements - [Chez Scheme](https://cisco.github.io/ChezScheme/) 10.x (stock, unmodified) +- Optional: [chez-*](https://github.com/ober) libraries for networking, compression, PCRE2, YAML, LevelDB ## Project Structure @@ -162,12 +176,54 @@ lib/ alist.sls # :std/misc/alist ports.sls # :std/misc/ports channel.sls # :std/misc/channel + thread.sls # :std/misc/thread + process.sls # :std/misc/process + queue.sls # :std/misc/queue + bytes.sls # :std/misc/bytes + uuid.sls # :std/misc/uuid + repr.sls # :std/misc/repr + completion.sls # :std/misc/completion + text/ + json.sls # :std/text/json + base64.sls # :std/text/base64 + hex.sls # :std/text/hex + utf8.sls # :std/text/utf8 + csv.sls # :std/text/csv + xml.sls # :std/text/xml + yaml.sls # :std/text/yaml (wraps chez-yaml) + os/ + path.sls # :std/os/path + env.sls # :std/os/env + temporaries.sls # :std/os/temporaries + signal.sls # :std/os/signal + fdio.sls # :std/os/fdio + net/ + request.sls # :std/net/request (wraps chez-https) + httpd.sls # :std/net/httpd (wraps chez-httpd) + ssl.sls # :std/net/ssl (wraps chez-ssl) + compress/ + zlib.sls # :std/compress/zlib (wraps chez-zlib) + db/ + leveldb.sls # :std/db/leveldb (wraps chez-leveldb) + crypto/ + digest.sls # :std/crypto/digest + cli/ + getopt.sls # :std/cli/getopt + srfi/ + srfi-13.sls # :std/srfi/13 + srfi-19.sls # :std/srfi/19 + pregexp.sls # :std/pregexp + pcre2.sls # :std/pcre2 (wraps chez-pcre2) + test.sls # :std/test + logger.sls # :std/logger tests/ - test-reader.ss # 65 reader tests - test-core.ss # 68 core macro tests - test-stdlib.ss # 65 stdlib tests - test-ffi.ss # 7 FFI tests - test-modules.ss # 8 module path tests + test-reader.ss # 65 reader tests + test-core.ss # 68 core macro tests + test-stdlib.ss # 65 stdlib tests + test-ffi.ss # 7 FFI tests + test-modules.ss # 8 module path tests + test-expanded-stdlib.ss # 76 expanded stdlib tests + test-wrappers.ss # 27 wrapper module tests ``` ## What Gerbil Code Works new file mode 100644 --- /dev/null +++ b/lib/std/compress/zlib.sls @@ -0,0 +1,13 @@ +#!chezscheme +;;; :std/compress/zlib -- Compression (wraps chez-zlib) +;;; Requires: chez_zlib_shim.so (zlib) + +(library (std compress zlib) + (export + gzip-bytevector gunzip-bytevector + deflate-bytevector inflate-bytevector + gzip-data?) + + (import (chez-zlib)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/db/leveldb.sls @@ -0,0 +1,40 @@ +#!chezscheme +;;; :std/db/leveldb -- Key-value store (wraps chez-leveldb) +;;; Requires: leveldb_shim.so, libleveldb.so + +(library (std db leveldb) + (export + ;; Core operations + leveldb-open leveldb-close + leveldb-put leveldb-get leveldb-delete leveldb-key? + leveldb-write + ;; Write batches + leveldb-writebatch + leveldb-writebatch-put leveldb-writebatch-delete + leveldb-writebatch-clear leveldb-writebatch-append + leveldb-writebatch-destroy + ;; Iterators + leveldb-iterator leveldb-iterator-close + leveldb-iterator-valid? leveldb-iterator-seek-first + leveldb-iterator-seek-last leveldb-iterator-seek + leveldb-iterator-next leveldb-iterator-prev + leveldb-iterator-key leveldb-iterator-value + leveldb-iterator-error + ;; Convenience iteration + leveldb-fold leveldb-for-each + leveldb-fold-keys leveldb-for-each-keys + ;; Snapshots + leveldb-snapshot leveldb-snapshot-release + ;; Options + leveldb-options leveldb-default-options + leveldb-read-options leveldb-default-read-options + leveldb-write-options leveldb-default-write-options + ;; Database management + leveldb-compact-range leveldb-destroy-db leveldb-repair-db + leveldb-property leveldb-approximate-size + ;; Misc + leveldb-version leveldb? leveldb-error?) + + (import (leveldb)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/net/httpd.sls @@ -0,0 +1,21 @@ +#!chezscheme +;;; :std/net/httpd -- HTTP server (wraps chez-httpd) +;;; Requires: chez-https (for chez-httpd), chez-ssl (with chez_ssl_shim.so) + +(library (std net httpd) + (export + httpd-start httpd-start-https httpd-stop + httpd-config + httpd-route httpd-route-prefix httpd-route-static + make-router router-add! router-add-prefix! router-lookup + http-req-method http-req-path http-req-query + http-req-version http-req-headers http-req-header + http-req-body http-req-client-addr + http-respond http-respond-html http-respond-json + http-respond-error http-respond-redirect + http-respond-chunk-begin http-respond-chunk http-respond-chunk-end + http-respond-file) + + (import (chez-httpd)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/net/request.sls @@ -0,0 +1,15 @@ +#!chezscheme +;;; :std/net/request -- HTTP client (wraps chez-https) +;;; Requires: chez-https, chez-ssl (with chez_ssl_shim.so) + +(library (std net request) + (export + http-get http-post http-put http-delete http-head + request-status request-text request-content + request-headers request-header request-close + parse-url url-encode build-query-string + flatten-request-headers) + + (import (chez-https)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/net/ssl.sls @@ -0,0 +1,19 @@ +#!chezscheme +;;; :std/net/ssl -- TLS/TCP networking (wraps chez-ssl) +;;; Requires: chez_ssl_shim.so (OpenSSL) + +(library (std net ssl) + (export + ssl-init! ssl-cleanup! + ssl-connect ssl-write ssl-write-string + ssl-read ssl-read-all ssl-close + ssl-connection? + tcp-connect tcp-listen tcp-accept tcp-close + tcp-read tcp-write tcp-write-string tcp-read-all + tcp-set-timeout + ssl-server-ctx ssl-server-ctx-free ssl-server-accept + conn-wrap conn-write conn-write-string conn-read) + + (import (chez-ssl)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/pcre2.sls @@ -0,0 +1,33 @@ +#!chezscheme +;;; :std/pcre2 -- PCRE2 regular expressions (wraps chez-pcre2) +;;; Requires: pcre2_shim.so (libpcre2-8) + +(library (std pcre2) + (export + ;; Compilation + pcre2-compile pcre2-regex pcre2-release! + pcre-regex? pcre-match? + ;; Matching + pcre2-match pcre2-search pcre2-matches? + ;; Match access + pcre-match-group pcre-match-named + pcre-match-positions pcre-match->list pcre-match->alist + ;; Substitution + pcre2-replace pcre2-replace-all + ;; Iteration + pcre2-find-all pcre2-extract pcre2-fold + pcre2-split pcre2-partition + ;; Utilities + pcre2-quote + ;; Pregexp compatibility + pcre2-pregexp-match pcre2-pregexp-match-positions + pcre2-pregexp-replace pcre2-pregexp-replace* + pcre2-pregexp-quote + ;; Constants + PCRE2_CASELESS PCRE2_MULTILINE PCRE2_DOTALL + PCRE2_EXTENDED PCRE2_UTF PCRE2_UCP + PCRE2_ANCHORED PCRE2_UNGREEDY PCRE2_LITERAL) + + (import (chez-pcre2 pcre2)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/text/yaml.sls @@ -0,0 +1,13 @@ +#!chezscheme +;;; :std/text/yaml -- YAML parsing and emitting (wraps chez-yaml) +;;; Pure Scheme, no external dependencies. + +(library (std text yaml) + (export + yaml-load yaml-load-string + yaml-dump yaml-dump-string + yaml-key-format) + + (import (yaml)) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-wrapper-pcre2.ss @@ -0,0 +1,30 @@ +#!chezscheme +(import (chezscheme) (std pcre2)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) (set! pass-count (+ pass-count 1)) + (begin (set! fail-count (+ fail-count 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write result) + (display " expected ") (write exp) (newline))))])) + +(chk (pcre2-matches? "\\d+" "abc123") => #t) +(chk (pcre2-matches? "\\d+" "abc") => #f) +(chk (pcre2-extract "\\d+" "a1 b22 c333") => '("1" "22" "333")) +(chk (pcre2-split ",\\s*" "a, b, c") => '("a" "b" "c")) +(chk (pcre2-replace-all "o" "foobar" "0") => "f00bar") + +(let ([m (pcre2-search "h(e+)llo" "heeello")]) + (chk (pcre-match-group m 0) => "heeello") + (chk (pcre-match-group m 1) => "eee")) + +(display " pcre2: ") (display pass-count) (display " passed") +(when (> fail-count 0) (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1)) new file mode 100644 --- /dev/null +++ b/tests/test-wrapper-request.ss @@ -0,0 +1,18 @@ +#!chezscheme +(import (chezscheme) (std net request)) + +(define pass-count 0) +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) (set! pass-count (+ pass-count 1)) + (begin (display "FAIL: ") (write 'expr) (newline) (exit 1))))])) + +(chk (procedure? http-get) => #t) +(chk (procedure? http-post) => #t) +(chk (procedure? url-encode) => #t) +(chk (url-encode "hello world") => "hello%20world") +(chk (url-encode "a&b=c") => "a%26b%3Dc") + +(display " request: ") (display pass-count) (display " passed") (newline) new file mode 100644 --- /dev/null +++ b/tests/test-wrapper-ssl.ss @@ -0,0 +1,17 @@ +#!chezscheme +(import (chezscheme) (std net ssl)) + +(define pass-count 0) +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) (set! pass-count (+ pass-count 1)) + (begin (display "FAIL: ") (write 'expr) (newline) (exit 1))))])) + +(chk (procedure? ssl-init!) => #t) +(chk (procedure? ssl-connect) => #t) +(chk (procedure? tcp-connect) => #t) +(chk (procedure? conn-wrap) => #t) + +(display " ssl: ") (display pass-count) (display " passed") (newline) new file mode 100644 --- /dev/null +++ b/tests/test-wrapper-zlib.ss @@ -0,0 +1,34 @@ +#!chezscheme +(import (chezscheme) (std compress zlib)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin (set! fail-count (+ fail-count 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write result) + (display " expected ") (write exp) (newline))))])) + +(let* ([original (string->utf8 "Hello, Jerboa! Compression test.")] + [compressed (gzip-bytevector original)] + [decompressed (gunzip-bytevector compressed)]) + (chk (equal? original decompressed) => #t) + (chk (gzip-data? compressed) => #t) + (chk (gzip-data? original) => #f)) + +;; Deflate round-trip +(let* ([original (string->utf8 "deflate test data")] + [compressed (deflate-bytevector original)] + [decompressed (inflate-bytevector compressed)]) + (chk (equal? original decompressed) => #t)) + +(display " zlib: ") (display pass-count) (display " passed") +(when (> fail-count 0) (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1)) new file mode 100644 --- /dev/null +++ b/tests/test-wrappers.ss @@ -0,0 +1,59 @@ +#!chezscheme +;;; test-wrappers.ss -- Tests for chez-* wrapper modules +;;; Tests that wrapper modules load and re-export correctly. +;;; Each module is tested in a separate script invocation to handle +;;; missing dependencies gracefully. + +(import (chezscheme) + (std text yaml)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] + [exp expected]) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin + (set! fail-count (+ fail-count 1)) + (display "FAIL: ") + (write 'expr) + (display " => ") + (write result) + (display " expected ") + (write exp) + (newline))))])) + +;;; ---- std/text/yaml ---- +(let ([docs (yaml-load-string "name: test\nversion: 1\n")]) + (chk (list? docs) => #t) + (chk (> (length docs) 0) => #t)) + +(let ([result (yaml-dump-string '(1 2 3))]) + (chk (string? result) => #t)) + +(let ([result (yaml-dump-string "hello")]) + (chk (string? result) => #t)) + +;; Round-trip +(let* ([data '((1 2 3) "hello" #t)] + [yaml-str (yaml-dump-string data)] + [parsed (car (yaml-load-string yaml-str))]) + (chk (list? parsed) => #t)) + +;; Mapping with symbol keys +(parameterize ([yaml-key-format string->symbol]) + (let ([doc (car (yaml-load-string "foo: bar\nbaz: 42\n"))]) + (chk (hashtable? doc) => #t) + (chk (hashtable-ref doc 'foo #f) => "bar"))) + +;;; ---- Summary ---- +(newline) +(display "Wrapper tests (yaml): ") +(display pass-count) (display " passed, ") +(display fail-count) (display " failed") +(newline) +(when (> fail-count 0) (exit 1))