match

.dir-locals.el

@@ -1,14 +1,9 @@
 ;; The 'nil' configuration applies to all modes.
-((scheme-mode
-  (indent-tabs-mode . nil)
-  (lisp-local-indent
-   guard 1
-   c-lambda 2
-   let*-pointers 1
-   test-group 1
-   unwind-protect 0
-   ;; okvs:
-   call-with-input-file 1
-   call-with-values 1
-   match 1
-   switch 1)))
+((scheme-mode . ((indent-tabs-mode . nil)
+                 (tab-width . 2)
+                 (eval . (progn
+                           (put 'guard 'scheme-indent-function 1)
+                           (put 'call-with-input-string 'scheme-indent-function 1)
+                           (put 'call-with-values 'scheme-indent-function 1)
+                           (put 'call-with-port 'scheme-indent-function 1)
+                           (put 'match 'scheme-indent-function 1))))))

Dockerfile

@@ -10,4 +10,4 @@ RUN cd /live && make prepare-debian
 
 RUN cd /live && ./venv $(pwd)/local/ scheme-live install /
 
-RUN rm -rf /var/cache/apt/* /tmp
+RUN rm -rf /var/cache/apt/* /tmp/*

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/match/unstable.chez.sls

@@ -0,0 +1,32 @@
+;; Copyright (C) Felix Thibault (2020).  All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice (including
+;; the next paragraph) shall be included in all copies or substantial
+;; portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(library (live match unstable)
+  (export
+   ;; (chibi match) forms
+   match match-lambda match-lambda* match-let match-letrec match-let*)
+  (import (live unstable))
+
+  #!chezscheme
+
+  (include  "unstable/body.scm"))

live/match/unstable.scm

@@ -0,0 +1,117 @@
+;; Copyright (C) Felix Thibault (2020).  All Rights Reserved.
+
+;; Permission is hereby granted, free of charge, to any person
+;; obtaining a copy of this software and associated documentation
+;; files (the "Software"), to deal in the Software without
+;; restriction, including without limitation the rights to use, copy,
+;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;; of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice (including
+;; the next paragraph) shall be included in all copies or substantial
+;; portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(define-library (live match unstable)
+  (export
+   ;; (chibi match) forms
+   match match-lambda match-lambda* match-let match-letrec match-let*)
+   ;; auxiliary syntax
+   ;; ___ **1 =.. *.. *** ? $ struct object get!)
+   ;; (import (only (live match auxiliary-syntax) ___ **1 =.. *.. *** ? $ struct object get!))
+   (cond-expand
+    (chibi
+     (import (chibi)))
+    (gauche
+     (import (only (gauche base) is-a? slot-definition-name class-slots)
+	     (scheme base)
+	     (rename (gauche base)
+		     (slot-ref gb-slot-ref)
+		     (slot-set! gb-slot-set!)))
+     (begin
+       (define-syntax slot-ref
+	 (syntax-rules ()
+	   ((_ class inst n)
+	    (if (integer? n)
+		(gb-slot-ref inst
+			     (list-ref (map slot-definition-name
+					    (class-slots class))
+				       n))
+		(gb-slot-ref inst n)))))
+       (define-syntax slot-set!
+	 (syntax-rules ()
+	   ((_ class inst n value)
+	    (if (integer? n)
+		(gb-slot-set! inst
+			      (list-ref (map slot-definition-name
+					     (class-slots class))
+					n)
+			      value)
+		(gb-slot-set! inst n value)))))))
+    ((or larceny (library (srfi 99)))
+     (import (scheme base)
+	     (srfi 99 records))
+     (begin
+       (define-syntax is-a?
+	 (syntax-rules ()
+	   ((_ rec rtd)
+	    (and (rtd? rtd)
+		 ((rtd-predicate rtd) rec)))))
+       (define-syntax slot-ref
+	 (syntax-rules ()
+	   ((_ rtd rec n)
+	    (if (integer? n)
+		((rtd-accessor rtd (vector-ref (rtd-all-field-names rtd) n)) rec)
+		((rtd-accessor rtd n) rec)))))
+       (define-syntax slot-set!
+	 (syntax-rules ()
+	   ((_ rtd rec n value)
+	    (if (integer? n)
+		((rtd-mutator rtd (vector-ref (rtd-all-field-names rtd) n)) rec value)
+		((rtd-mutator rtd n) rec value)))))))
+    (unsyntax
+     (import (except (scheme base) define-record-type)
+	     (rnrs records syntactic (6))
+	     (rnrs records procedural (6))
+	     (rnrs records inspection (6)))
+     (begin
+       (define-syntax is-a?
+	 (syntax-rules ()
+	   ((_ rec rtd)
+	    ((record-predicate (record-type-descriptor rtd)) rec))))
+       (define-syntax slot-ref
+	 (syntax-rules ()
+	   ((_ rtd rec n)
+	    (let ((rtd (record-type-descriptor rtd)))
+	      (if (integer? n)
+		  ((record-accessor rtd n) rec)
+		  ((record-accessor rtd (name->idx rtd n)) rec))))))
+       (define-syntax slot-set!
+	 (syntax-rules ()
+	   ((_ rtd rec n value)
+	    (let ((rtd (record-type-descriptor rtd)))
+	      (if (integer? n)
+		  ((record-mutator rtd n) rec value)
+		  ((record-mutator rtd (name->idx rtd n)) rec value))))))
+       (define-syntax name->idx
+	 (syntax-rules ()
+	   ((_ rtd n)
+	    (let* ((names (record-type-field-names rtd))
+		   (len (vector-length names)))
+	      (let lp ((i 0))
+		(cond
+		 ((> i len) (error "name not in record" n))
+		 ((eq? n (vector-ref names i)) i)
+		 (else (lp (+ i 1 )))))))))))
+    (else
+     (import (scheme base))))
+   (include  "unstable/body.scm"))