minimal live unstable library (#66)

- makefile: check-with-podman: run all tests against IMPLEMENTATION specified with an environment variable locally using the stable container from github; podman is favored because in my experience it is easier to work with than the docker cli, they are small differences with docker cli;

- create `live unstable` based on `json base`;

- clean a cyclone `cond-expand` thanks to an improvement upstream;

- minor adjustment, in `infinite?`: comparison between numbers is done with `=`;

- improve `pk` and special case it for loko;

- add `assume` based on SRFI-145;

- trivial improvements in README;

ref: https://srfi.schemers.org/srfi-145/
ref: #63

README.md

@@ -15,9 +15,9 @@ upon which one can build abstractions to solve (real world) problems.
 - Be a complement to [SRFI](https://srfi.schemers.org/),
   [R7RS](https://r7rs.org), and work together following the [goals set
   by the steering commitee, and R7RS-large working group
-  charter](http://scheme-reports.org/2010/working-group-2-charter.html)
+  charter](http://scheme-reports.org/2010/working-group-2-charter.html);
 
-- Release yearly stable versions:next, and first stable release
+- Release yearly stable versions: next, and **first stable release**
   planned in 2023;
 
 - Aim for portability across Scheme standards, Scheme implementations,

live.egg

@@ -45,8 +45,8 @@
      (component-dependencies)
      (csc-options "-R" "r7rs" "-X" "r7rs"))
    (extension
-     live.json.base
-     (source "live/json/base.sld")
+     live.unstable
+     (source "live/unstable.sld")
      (component-dependencies live.json.shim)
      (csc-options "-R" "r7rs" "-X" "r7rs"))
    (extension
@@ -59,7 +59,7 @@
      live.json.unstable
      (source "live/json/unstable.sld")
      (source-dependencies "live/json/body.scm")
-     (component-dependencies live.json.base live.json.shim)
+     (component-dependencies live.unstable live.json.shim)
      (csc-options "-R" "r7rs" "-X" "r7rs"))
    (extension
      live.list.unstable

live/json/unstable.chez.sls

@@ -7,6 +7,6 @@
           json-read
           json-write)
 
-  (import (live json base))
+  (import (live unstable))
 
   (include "body.scm"))

live/json/unstable.rkt

@@ -8,6 +8,6 @@
           json-read
           json-write)
 
-  (import (live json base))
+  (import (live unstable))
 
   (include "body.scm"))

live/json/unstable.scm

@@ -7,6 +7,6 @@
           json-read
           json-write)
 
-  (import (live json base))
+  (import (live unstable))
 
   (include "body.scm"))

live/json/unstable.sld

@@ -12,6 +12,6 @@
     (import (scheme base)))
    (else))
 
-  (import (live json base))
+  (import (live unstable))
 
   (include "body.scm"))

live/json/base.chez.sls → live/unstable.chez.sls

@@ -1,4 +1,4 @@
-(library (live json base)
+(library (live unstable)
   (export
    port?
    read
@@ -110,6 +110,14 @@
    exit)
   (import (rename (chezscheme) (define-record-type define-record-type*)))
 
+  (define-syntax assume
+    (syntax-rules ()
+      ((assume expression message)
+       (or expression
+           (error 'assume message (quote expression))))
+      ((assume . _)
+       (syntax-error "invalid assume syntax"))))
+
   (define (pk . args)
     (write args (current-error-port))
     (newline (current-error-port))

live/json/base.rkt → live/unstable.rkt

@@ -1,5 +1,5 @@
 #!r7rs
-(define-library (live json base)
+(define-library (live unstable)
   (export
    read
    quote
@@ -114,6 +114,14 @@
    (only (srfi/1) every))
   (begin
 
+  (define-syntax assume
+    (syntax-rules ()
+      ((assume expression message)
+       (or expression
+           (error 'assume message (quote expression))))
+      ((assume . _)
+       (syntax-error "invalid assume syntax"))))
+
     (define error
       (lambda (who . args)
         (apply error* (symbol->string who) args)))
@@ -146,5 +154,5 @@
 
     (define (infinite? x)
       (and (number? x)
-           (or (equal? x +inf.0)
-               (equal? x -inf.0))))))
+           (or (= x +inf.0)
+               (= x -inf.0))))))

live/json/base.scm → live/unstable.scm

@@ -1,4 +1,4 @@
-(define-library (live json base)
+(define-library (live unstable)
   (export
    read
    quote
@@ -127,7 +127,7 @@
 
     (define pk
       (lambda args
-        (display ";; ")
+        (display ";; " (current-error-port))
         (write args (current-error-port))
         (car (reverse args))))
 
@@ -139,5 +139,5 @@
 
     (define (infinite? x)
       (and (number? x)
-           (or (equal? x +inf.0)
-               (equal? x -inf.0))))))
+           (or (= x +inf.0)
+               (= x -inf.0))))))

live/json/base.sld → live/unstable.sld

@@ -1,5 +1,6 @@
-(define-library (live json base)
+(define-library (live unstable)
   (export
+   assume
    port?
    read
    let*
@@ -149,6 +150,14 @@
 
   (begin
 
+    (define-syntax assume
+      (syntax-rules ()
+        ((assume expression message)
+         (or expression
+             (error 'assume message (quote expression))))
+        ((assume . _)
+         (syntax-error "invalid assume syntax"))))
+
     (cond-expand
      ((or gambit loko mit gauche)
       (define every
@@ -158,83 +167,7 @@
               (if (p? (car x))
                   (every (cdr x))
                   #f)))))
-
-     (cyclone
-      (define * *)
-      (define + +)
-      (define - -)
-      (define / /)
-      (define < <)
-      (define <= <=)
-      (define = =)
-      (define > >)
-      (define >= >=)
-      (define apply apply)
-      (define boolean? boolean?)
-      (define bytevector bytevector)
-      (define bytevector-append bytevector-append)
-      (define bytevector-length bytevector-length)
-      (define bytevector-u8-ref bytevector-u8-ref)
-      (define bytevector-u8-set! bytevector-u8-set!)
-      (define bytevector? bytevector?)
-      (define caar caar)
-      (define cadr cadr)
-      (define car car)
-      (define cdar cdar)
-      (define cddr cddr)
-      (define cdr cdr)
-      (define char->integer char->integer)
-      (define char? char?)
-      (define close-input-port close-input-port)
-      (define close-output-port close-output-port)
-      (define close-port close-port)
-      (define command-line-arguments command-line-arguments)
-      (define cons cons)
-      (define delete-file delete-file)
-      (define eof-object? eof-object?)
-      (define eq? eq?)
-      (define equal? equal?)
-      (define eqv? eqv?)
-      (define error error)
-      (define exit exit)
-      (define file-exists? file-exists?)
-      (define integer->char integer->char)
-      (define integer? integer?)
-      (define length length)
-      (define list->string list->string)
-      (define list->vector list->vector)
-      (define make-bytevector make-bytevector)
-      (define make-vector make-vector)
-      (define null? null?)
-      (define number->string number->string)
-      (define number? number?)
-      (define open-input-file open-input-file)
-      (define open-output-file open-output-file)
-      (define pair? pair?)
-      (define peek-char peek-char)
-      (define port? port?)
-      (define procedure? procedure?)
-      (define read-char read-char)
-      (define real? real?)
-      (define set-car! set-car!)
-      (define set-cdr! set-cdr!)
-      (define string->number string->number)
-      (define string->symbol string->symbol)
-      (define string-append string-append)
-      (define string-cmp string-cmp)
-      (define string-length string-length)
-      (define string-ref string-ref)
-      (define string-set! string-set!)
-      (define string? string?)
-      (define substring substring)
-      (define symbol->string symbol->string)
-      (define symbol? symbol?)
-      (define system system)
-      (define vector-length vector-length)
-      (define vector-ref vector-ref)
-      (define vector-set! vector-set!)
-      (define vector? vector?))
-
+     (chicken)
      (else))
 
     (cond-expand
@@ -270,12 +203,20 @@
     (define (void)
       (when #f #f))
 
-    (define pk
-      (lambda args
-        ;; TODO: FIXME: Loko does like current-error-port
-        (display ";; " #;(current-error-port))
-        (write args #;(current-error-port))
-        (car (reverse args))))
+    (cond-expand
+     (loko
+      (define pk
+        (lambda args
+          (display ";; ")
+          (write args)
+          (car (reverse args)))))
+     (else
+      (define pk
+        (lambda args
+          (display ";; " (current-error-port))
+          (write args (current-error-port))
+          (car (reverse args))))))
+
 
     (define ash arithmetic-shift)