diff --git a/.dir-locals.el b/.dir-locals.el index 3cecdd4..b8f715b 100644 --- a/.dir-locals.el +++ b/.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)))))) diff --git a/Dockerfile b/Dockerfile index 6515c4d..b20dd92 100644 --- a/Dockerfile +++ b/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/* diff --git a/README.md b/README.md index dda4235..2c64cbe 100644 --- a/README.md +++ b/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, diff --git a/live.egg b/live.egg index 6ed3927..430c08e 100644 --- a/live.egg +++ b/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 diff --git a/live/json/base.scm b/live/json/base.scm deleted file mode 100644 index afec7ab..0000000 --- a/live/json/base.scm +++ /dev/null @@ -1,143 +0,0 @@ -(define-library (live json base) - (export - read - quote - let* - begin - fx+ - string->symbol - number->string - symbol? - char? - current-output-port - include - + - - - <= - = - and - append - ash - bitwise-ior - boolean? - call-with-input-file - call-with-port - call-with-values - car - case - case-lambda - cdr - char=? - close-port - cond - cons - current-input-port - define - define-record-type - define-syntax - denominator - directory-list - display - else - eof-object? - eq? - equal? - error - exact? - file-regular? - for-all - for-each - format - fx- - fxzero? - get-output-string - guard - if - inexact? - infinite? - input-port? - integer->char - lambda - length - let - list - list->string - make-parameter - make-vector - map - nan? - newline - not - null? - number? - number? - open-input-string - open-output-string - or - pair? - pk - procedure? - put-char - put-string - raise - read-char - real? - reverse - set! - string->number - string-append - string-for-each - string? - symbol->string - port? - unless - values - vector-for-each - vector-set! - vector? - void - when - write - exit) - (import (scheme base) - (scheme read) - (srfi srfi-1) - (scheme case-lambda) - (only (srfi srfi-60) bitwise-ior) - (scheme file) - (scheme write) - (scheme process-context) - (live json shim)) - - (begin - - (define fx+ +) - (define fx- -) - (define fxzero? zero?) - - (define nan? (lambda (x) #f)) - - (define (format x message . args) - (cons message args)) - - (define for-all every) - - (define (void) - (when #f #f)) - - (define pk - (lambda args - (display ";; ") - (write args (current-error-port)) - (car (reverse args)))) - - (define ash arithmetic-shift) - - (define put-char (lambda (p c) (write-char c p))) - - (define put-string (lambda (p s) (write-string s p))) - - (define (infinite? x) - (and (number? x) - (or (equal? x +inf.0) - (equal? x -inf.0)))))) diff --git a/live/json/unstable.chez.sls b/live/json/unstable.chez.sls index 6566b34..86e34df 100644 --- a/live/json/unstable.chez.sls +++ b/live/json/unstable.chez.sls @@ -7,6 +7,6 @@ json-read json-write) - (import (live json base)) + (import (live unstable)) (include "body.scm")) diff --git a/live/json/unstable.rkt b/live/json/unstable.rkt index fb6e545..f558204 100644 --- a/live/json/unstable.rkt +++ b/live/json/unstable.rkt @@ -8,6 +8,6 @@ json-read json-write) - (import (live json base)) + (import (live unstable)) (include "body.scm")) diff --git a/live/json/unstable.scm b/live/json/unstable.scm index 6566b34..86e34df 100644 --- a/live/json/unstable.scm +++ b/live/json/unstable.scm @@ -7,6 +7,6 @@ json-read json-write) - (import (live json base)) + (import (live unstable)) (include "body.scm")) diff --git a/live/json/unstable.sld b/live/json/unstable.sld index 668658b..1ac6ac9 100644 --- a/live/json/unstable.sld +++ b/live/json/unstable.sld @@ -12,6 +12,6 @@ (import (scheme base))) (else)) - (import (live json base)) + (import (live unstable)) (include "body.scm")) diff --git a/live/match/unstable.chez.sls b/live/match/unstable.chez.sls new file mode 100644 index 0000000..b2367c0 --- /dev/null +++ b/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")) diff --git a/live/match/unstable.scm b/live/match/unstable.scm new file mode 100644 index 0000000..d770bcf --- /dev/null +++ b/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")) diff --git a/live/match/unstable/body.scm b/live/match/unstable/body.scm new file mode 100644 index 0000000..94bd361 --- /dev/null +++ b/live/match/unstable/body.scm @@ -0,0 +1,1106 @@ +;;; Chez-Scheme Wrappers for Alex Shinn's Match (Wright Compatible) +;;; +;;; Copyright (c) 2016 Federico Beffa +;;; +;;; Permission to use, copy, modify, and distribute this software for +;;; any purpose with or without fee is hereby granted, provided that the +;;; above copyright notice and this permission notice appear in all +;;; copies. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL +;;; DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA +;;; OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +;;; TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +;;; PERFORMANCE OF THIS SOFTWARE. + +;; The reader in #!r6rs mode doesn't allow the '..1' identifier. +#!chezscheme +;; We declare end export the symbols used as auxiliary identifiers +;; in 'syntax-rules' to make them work in Chez Scheme's interactive +;; environment. (FBE) + +;; Also we replaced '_' with ':_' as the special identifier matching +;; anything and not binding. This is because R6RS forbids its use +;; as an auxiliary literal in a syntax-rules form. + +;; (define-syntax define-auxiliary-keyword +;; (syntax-rules () +;; [(_ name) +;; (define-syntax name +;; (lambda (x) +;; (syntax-violation #f "misplaced use of auxiliary keyword" x)))])) + +;; (define-syntax define-auxiliary-keywords +;; (syntax-rules () +;; [(_ name* ...) +;; (begin (define-auxiliary-keyword name*) ...)])) + +;; (define-auxiliary-keywords :_ ___ ..1 *** ? $ struct @ object) + +(define-syntax is-a? + (syntax-rules () + ((_ rec rtn) + (and (record? rec) + (eq? (record-type-name (record-rtd rec)) (quote rtn)))))) + +(define-syntax slot-ref + (syntax-rules () + ((_ rtn rec n) + (if (number? n) + ((record-accessor (record-rtd rec) n) rec) + ;; If it's not a number, then it should be a symbol with + ;; the name of a field. + (let* ((rtd (record-rtd rec)) + (fields (record-type-field-names rtd)) + (fields-idxs (map (lambda (f i) (cons f i)) + (vector->list fields) + (iota (vector-length fields)))) + (idx (cdr (assv n fields-idxs)))) + ((record-accessor rtd idx) rec)))))) + +(define-syntax slot-set! + (syntax-rules () + ((_ rtn rec n) + (if (number? n) + ((record-mutator (record-rtd rec) n) rec) + ;; If it's not a number, then it should be a symbol with + ;; the name of a field. + (let* ((rtd (record-rtd rec)) + (fields (record-type-field-names rtd)) + (fields-idxs (map (lambda (f i) (cons f i)) + (vector->list fields) + (iota (vector-length fields)))) + (idx (cdr (assv n fields-idxs)))) + ((record-mutator rtd idx) rec)))))) + +;;;; match.scm -- portable hygienic pattern matcher -*- coding: utf-8 -*- +;; +;; This code is written by Alex Shinn and placed in the +;; Public Domain. All warranties are disclaimed. + +;;> \example-import[(srfi 9)] + +;;> A portable hygienic pattern matcher. + +;;> This is a full superset of the popular \hyperlink[ +;;> "http://www.cs.indiana.edu/scheme-repository/code.match.html"]{match} +;;> package by Andrew Wright, written in fully portable \scheme{syntax-rules} +;;> and thus preserving hygiene. + +;;> The most notable extensions are the ability to use \emph{non-linear} +;;> patterns - patterns in which the same identifier occurs multiple +;;> times, tail patterns after ellipsis, and the experimental tree patterns. + +;;> \section{Patterns} + +;;> Patterns are written to look like the printed representation of +;;> the objects they match. The basic usage is + +;;> \scheme{(match expr (pat body ...) ...)} + +;;> where the result of \var{expr} is matched against each pattern in +;;> turn, and the corresponding body is evaluated for the first to +;;> succeed. Thus, a list of three elements matches a list of three +;;> elements. + +;;> \example{(let ((ls (list 1 2 3))) (match ls ((1 2 3) #t)))} + +;;> If no patterns match an error is signalled. + +;;> Identifiers will match anything, and make the corresponding +;;> binding available in the body. + +;;> \example{(match (list 1 2 3) ((a b c) b))} + +;;> If the same identifier occurs multiple times, the first instance +;;> will match anything, but subsequent instances must match a value +;;> which is \scheme{equal?} to the first. + +;;> \example{(match (list 1 2 1) ((a a b) 1) ((a b a) 2))} + +;;> The special identifier \scheme{_} matches anything, no matter how +;;> many times it is used, and does not bind the result in the body. + +;;> \example{(match (list 1 2 1) ((_ _ b) 1) ((a b a) 2))} + +;;> To match a literal identifier (or list or any other literal), use +;;> \scheme{quote}. + +;;> \example{(match 'a ('b 1) ('a 2))} + +;;> Analogous to its normal usage in scheme, \scheme{quasiquote} can +;;> be used to quote a mostly literally matching object with selected +;;> parts unquoted. + +;;> \example|{(match (list 1 2 3) (`(1 ,b ,c) (list b c)))}| + +;;> Often you want to match any number of a repeated pattern. Inside +;;> a list pattern you can append \scheme{...} after an element to +;;> match zero or more of that pattern (like a regexp Kleene star). + +;;> \example{(match (list 1 2) ((1 2 3 ...) #t))} +;;> \example{(match (list 1 2 3) ((1 2 3 ...) #t))} +;;> \example{(match (list 1 2 3 3 3) ((1 2 3 ...) #t))} + +;;> Pattern variables matched inside the repeated pattern are bound to +;;> a list of each matching instance in the body. + +;;> \example{(match (list 1 2) ((a b c ...) c))} +;;> \example{(match (list 1 2 3) ((a b c ...) c))} +;;> \example{(match (list 1 2 3 4 5) ((a b c ...) c))} + +;;> More than one \scheme{...} may not be used in the same list, since +;;> this would require exponential backtracking in the general case. +;;> However, \scheme{...} need not be the final element in the list, +;;> and may be succeeded by a fixed number of patterns. + +;;> \example{(match (list 1 2 3 4) ((a b c ... d e) c))} +;;> \example{(match (list 1 2 3 4 5) ((a b c ... d e) c))} +;;> \example{(match (list 1 2 3 4 5 6 7) ((a b c ... d e) c))} + +;;> \scheme{___} is provided as an alias for \scheme{...} when it is +;;> inconvenient to use the ellipsis (as in a syntax-rules template). + +;;> The \scheme{..1} syntax is exactly like the \scheme{...} except +;;> that it matches one or more repetitions (like a regexp "+"). + +;;> \example{(match (list 1 2) ((a b c ..1) c))} +;;> \example{(match (list 1 2 3) ((a b c ..1) c))} + +;;> The boolean operators \scheme{and}, \scheme{or} and \scheme{not} +;;> can be used to group and negate patterns analogously to their +;;> Scheme counterparts. + +;;> The \scheme{and} operator ensures that all subpatterns match. +;;> This operator is often used with the idiom \scheme{(and x pat)} to +;;> bind \var{x} to the entire value that matches \var{pat} +;;> (c.f. "as-patterns" in ML or Haskell). Another common use is in +;;> conjunction with \scheme{not} patterns to match a general case +;;> with certain exceptions. + +;;> \example{(match 1 ((and) #t))} +;;> \example{(match 1 ((and x) x))} +;;> \example{(match 1 ((and x 1) x))} + +;;> The \scheme{or} operator ensures that at least one subpattern +;;> matches. If the same identifier occurs in different subpatterns, +;;> it is matched independently. All identifiers from all subpatterns +;;> are bound if the \scheme{or} operator matches, but the binding is +;;> only defined for identifiers from the subpattern which matched. + +;;> \example{(match 1 ((or) #t) (else #f))} +;;> \example{(match 1 ((or x) x))} +;;> \example{(match 1 ((or x 2) x))} + +;;> The \scheme{not} operator succeeds if the given pattern doesn't +;;> match. None of the identifiers used are available in the body. + +;;> \example{(match 1 ((not 2) #t))} + +;;> The more general operator \scheme{?} can be used to provide a +;;> predicate. The usage is \scheme{(? predicate pat ...)} where +;;> \var{predicate} is a Scheme expression evaluating to a predicate +;;> called on the value to match, and any optional patterns after the +;;> predicate are then matched as in an \scheme{and} pattern. + +;;> \example{(match 1 ((? odd? x) x))} + +;;> The field operator \scheme{=} is used to extract an arbitrary +;;> field and match against it. It is useful for more complex or +;;> conditional destructuring that can't be more directly expressed in +;;> the pattern syntax. The usage is \scheme{(= field pat)}, where +;;> \var{field} can be any expression, and should result in a +;;> procedure of one argument, which is applied to the value to match +;;> to generate a new value to match against \var{pat}. + +;;> Thus the pattern \scheme{(and (= car x) (= cdr y))} is equivalent +;;> to \scheme{(x . y)}, except it will result in an immediate error +;;> if the value isn't a pair. + +;;> \example{(match '(1 . 2) ((= car x) x))} +;;> \example{(match 4 ((= square x) x))} + +;;> The record operator \scheme{$} is used as a concise way to match +;;> records defined by SRFI-9 (or SRFI-99). The usage is +;;> \scheme{($ rtd field ...)}, where \var{rtd} should be the record +;;> type descriptor specified as the first argument to +;;> \scheme{define-record-type}, and each \var{field} is a subpattern +;;> matched against the fields of the record in order. Not all fields +;;> must be present. + +;;> \example{ +;;> (let () +;;> (define-record-type employee +;;> (make-employee name title) +;;> employee? +;;> (name get-name) +;;> (title get-title)) +;;> (match (make-employee "Bob" "Doctor") +;;> (($ employee n t) (list t n)))) +;;> } + +;;> For records with more fields it can be helpful to match them by +;;> name rather than position. For this you can use the \scheme{@} +;;> operator, originally a Gauche extension: + +;;> \example{ +;;> (let () +;;> (define-record-type employee +;;> (make-employee name title) +;;> employee? +;;> (name get-name) +;;> (title get-title)) +;;> (match (make-employee "Bob" "Doctor") +;;> ((@ employee (title t) (name n)) (list t n)))) +;;> } + +;;> The \scheme{set!} and \scheme{get!} operators are used to bind an +;;> identifier to the setter and getter of a field, respectively. The +;;> setter is a procedure of one argument, which mutates the field to +;;> that argument. The getter is a procedure of no arguments which +;;> returns the current value of the field. + +;;> \example{(let ((x (cons 1 2))) (match x ((1 . (set! s)) (s 3) x)))} +;;> \example{(match '(1 . 2) ((1 . (get! g)) (g)))} + +;;> The new operator \scheme{***} can be used to search a tree for +;;> subpatterns. A pattern of the form \scheme{(x *** y)} represents +;;> the subpattern \var{y} located somewhere in a tree where the path +;;> from the current object to \var{y} can be seen as a list of the +;;> form \scheme{(x ...)}. \var{y} can immediately match the current +;;> object in which case the path is the empty list. In a sense it's +;;> a 2-dimensional version of the \scheme{...} pattern. + +;;> As a common case the pattern \scheme{(_ *** y)} can be used to +;;> search for \var{y} anywhere in a tree, regardless of the path +;;> used. + +;;> \example{(match '(a (a (a b))) ((x *** 'b) x))} +;;> \example{(match '(a (b) (c (d e) (f g))) ((x *** 'g) x))} + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Notes + +;; The implementation is a simple generative pattern matcher - each +;; pattern is expanded into the required tests, calling a failure +;; continuation if the tests fail. This makes the logic easy to +;; follow and extend, but produces sub-optimal code in cases where you +;; have many similar clauses due to repeating the same tests. +;; Nonetheless a smart compiler should be able to remove the redundant +;; tests. For MATCH-LET and DESTRUCTURING-BIND type uses there is no +;; performance hit. + +;; The original version was written on 2006/11/29 and described in the +;; following Usenet post: +;; http://groups.google.com/group/comp.lang.scheme/msg/0941234de7112ffd +;; and is still available at +;; http://synthcode.com/scheme/match-simple.scm +;; It's just 80 lines for the core MATCH, and an extra 40 lines for +;; MATCH-LET, MATCH-LAMBDA and other syntactic sugar. +;; +;; A variant of this file which uses COND-EXPAND in a few places for +;; performance can be found at +;; http://synthcode.com/scheme/match-cond-expand.scm +;; +;; 2016/03/06 - fixing named match-let (thanks to Stefan Israelsson Tampe) +;; 2015/05/09 - fixing bug in var extraction of quasiquote patterns +;; 2014/11/24 - adding Gauche's `@' pattern for named record field matching +;; 2012/12/26 - wrapping match-let&co body in lexical closure +;; 2012/11/28 - fixing typo s/vetor/vector in largely unused set! code +;; 2012/05/23 - fixing combinatorial explosion of code in certain or patterns +;; 2011/09/25 - fixing bug when directly matching an identifier repeated in +;; the pattern (thanks to Stefan Israelsson Tampe) +;; 2011/01/27 - fixing bug when matching tail patterns against improper lists +;; 2010/09/26 - adding `..1' patterns (thanks to Ludovic Courtès) +;; 2010/09/07 - fixing identifier extraction in some `...' and `***' patterns +;; 2009/11/25 - adding `***' tree search patterns +;; 2008/03/20 - fixing bug where (a ...) matched non-lists +;; 2008/03/15 - removing redundant check in vector patterns +;; 2008/03/06 - you can use `...' portably now (thanks to Taylor Campbell) +;; 2007/09/04 - fixing quasiquote patterns +;; 2007/07/21 - allowing ellipsis patterns in non-final list positions +;; 2007/04/10 - fixing potential hygiene issue in match-check-ellipsis +;; (thanks to Taylor Campbell) +;; 2007/04/08 - clean up, commenting +;; 2006/12/24 - bugfixes +;; 2006/12/01 - non-linear patterns, shared variables in OR, get!/set! + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; force compile-time syntax errors with useful messages + +(define-syntax match-syntax-error + (syntax-rules () + ((_) (match-syntax-error "invalid match-syntax-error usage")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;> \section{Syntax} + +;;> \macro{(match expr (pattern . body) ...)\br{} +;;> (match expr (pattern (=> failure) . body) ...)} + +;;> The result of \var{expr} is matched against each \var{pattern} in +;;> turn, according to the pattern rules described in the previous +;;> section, until the the first \var{pattern} matches. When a match is +;;> found, the corresponding \var{body}s are evaluated in order, +;;> and the result of the last expression is returned as the result +;;> of the entire \scheme{match}. If a \var{failure} is provided, +;;> then it is bound to a procedure of no arguments which continues, +;;> processing at the next \var{pattern}. If no \var{pattern} matches, +;;> an error is signalled. + +;; The basic interface. MATCH just performs some basic syntax +;; validation, binds the match expression to a temporary variable `v', +;; and passes it on to MATCH-NEXT. It's a constant throughout the +;; code below that the binding `v' is a direct variable reference, not +;; an expression. + +(define-syntax match + (syntax-rules () + ((match) + (match-syntax-error "missing match expression")) + ((match atom) + (match-syntax-error "no match clauses")) + ((match (app ...) (pat . body) ...) + (let ((v (app ...))) + (match-next v ((app ...) (set! (app ...))) (pat . body) ...))) + ((match #(vec ...) (pat . body) ...) + (let ((v #(vec ...))) + (match-next v (v (set! v)) (pat . body) ...))) + ((match atom (pat . body) ...) + (let ((v atom)) + (match-next v (atom (set! atom)) (pat . body) ...))) + )) + +;; MATCH-NEXT passes each clause to MATCH-ONE in turn with its failure +;; thunk, which is expanded by recursing MATCH-NEXT on the remaining +;; clauses. `g+s' is a list of two elements, the get! and set! +;; expressions respectively. + +(define-syntax match-next + (syntax-rules (=>) + ;; no more clauses, the match failed + ((match-next v g+s) + (error 'match "no matching pattern" v)) + ;; named failure continuation + ((match-next v g+s (pat (=> failure) . body) . rest) + (let ((failure (lambda () (match-next v g+s . rest)))) + ;; match-one analyzes the pattern for us + (match-one v pat g+s (match-drop-ids (begin . body)) (failure) ()))) + ;; anonymous failure continuation, give it a dummy name + ((match-next v g+s (pat . body) . rest) + (match-next v g+s (pat (=> failure) . body) . rest)))) + +;; MATCH-ONE first checks for ellipsis patterns, otherwise passes on to +;; MATCH-TWO. + +(define-syntax match-one + (syntax-rules () + ;; If it's a list of two or more values, check to see if the + ;; second one is an ellipsis and handle accordingly, otherwise go + ;; to MATCH-TWO. + ((match-one v (p q . r) g+s sk fk i) + (match-check-ellipsis + q + (match-extract-vars p (match-gen-ellipsis v p r g+s sk fk i) i ()) + (match-two v (p q . r) g+s sk fk i))) + ;; Go directly to MATCH-TWO. + ((match-one . x) + (match-two . x)))) + +;; This is the guts of the pattern matcher. We are passed a lot of +;; information in the form: +;; +;; (match-two var pattern getter setter success-k fail-k (ids ...)) +;; +;; usually abbreviated +;; +;; (match-two v p g+s sk fk i) +;; +;; where VAR is the symbol name of the current variable we are +;; matching, PATTERN is the current pattern, getter and setter are the +;; corresponding accessors (e.g. CAR and SET-CAR! of the pair holding +;; VAR), SUCCESS-K is the success continuation, FAIL-K is the failure +;; continuation (which is just a thunk call and is thus safe to expand +;; multiple times) and IDS are the list of identifiers bound in the +;; pattern so far. + +;; Replace '_' with ':_' as the former is forbidden as an auxiliariy +;; keyword in R6RS. (FBE) +(define-syntax match-two + (syntax-rules (:_ ___ ..1 *** quote quasiquote ? $ struct @ object = and or not set! get!) + ((match-two v () g+s (sk ...) fk i) + (if (null? v) (sk ... i) fk)) + ((match-two v (quote p) g+s (sk ...) fk i) + (if (equal? v 'p) (sk ... i) fk)) + ((match-two v (quasiquote p) . x) + (match-quasiquote v p . x)) + ((match-two v (and) g+s (sk ...) fk i) (sk ... i)) + ((match-two v (and p q ...) g+s sk fk i) + (match-one v p g+s (match-one v (and q ...) g+s sk fk) fk i)) + ((match-two v (or) g+s sk fk i) fk) + ((match-two v (or p) . x) + (match-one v p . x)) + ((match-two v (or p ...) g+s sk fk i) + (match-extract-vars (or p ...) (match-gen-or v (p ...) g+s sk fk i) i ())) + ((match-two v (not p) g+s (sk ...) fk i) + (match-one v p g+s (match-drop-ids fk) (sk ... i) i)) + ((match-two v (get! getter) (g s) (sk ...) fk i) + (let ((getter (lambda () g))) (sk ... i))) + ((match-two v (set! setter) (g (s ...)) (sk ...) fk i) + (let ((setter (lambda (x) (s ... x)))) (sk ... i))) + ((match-two v (? pred . p) g+s sk fk i) + (if (pred v) (match-one v (and . p) g+s sk fk i) fk)) + ((match-two v (= proc p) . x) + (let ((w (proc v))) (match-one w p . x))) + ((match-two v (p ___ . r) g+s sk fk i) + (match-extract-vars p (match-gen-ellipsis v p r g+s sk fk i) i ())) + ((match-two v (p) g+s sk fk i) + (if (and (pair? v) (null? (cdr v))) + (let ((w (car v))) + (match-one w p ((car v) (set-car! v)) sk fk i)) + fk)) + ((match-two v (p *** q) g+s sk fk i) + (match-extract-vars p (match-gen-search v p q g+s sk fk i) i ())) + ((match-two v (p *** . q) g+s sk fk i) + (match-syntax-error "invalid use of ***" (p *** . q))) + ((match-two v (p ..1) g+s sk fk i) + (if (pair? v) + (match-one v (p ___) g+s sk fk i) + fk)) + ((match-two v ($ rec p ...) g+s sk fk i) + (if (is-a? v rec) + (match-record-refs v rec 0 (p ...) g+s sk fk i) + fk)) + ((match-two v (struct rec p ...) g+s sk fk i) + (if (is-a? v rec) + (match-record-refs v rec 0 (p ...) g+s sk fk i) + fk)) + ((match-two v (@ rec p ...) g+s sk fk i) + (if (is-a? v rec) + (match-record-named-refs v rec (p ...) g+s sk fk i) + fk)) + ((match-two v (object rec p ...) g+s sk fk i) + (if (is-a? v rec) + (match-record-named-refs v rec (p ...) g+s sk fk i) + fk)) + ((match-two v (p . q) g+s sk fk i) + (if (pair? v) + (let ((w (car v)) (x (cdr v))) + (match-one w p ((car v) (set-car! v)) + (match-one x q ((cdr v) (set-cdr! v)) sk fk) + fk + i)) + fk)) + ((match-two v #(p ...) g+s . x) + (match-vector v 0 () (p ...) . x)) + ;; Next line: replace '_' with ':_'. (FBE) + ((match-two v :_ g+s (sk ...) fk i) (sk ... i)) + ;; Not a pair or vector or special literal, test to see if it's a + ;; new symbol, in which case we just bind it, or if it's an + ;; already bound symbol or some other literal, in which case we + ;; compare it with EQUAL?. + ((match-two v x g+s (sk ...) fk (id ...)) + (let-syntax + ((new-sym? + (syntax-rules (id ...) + ((new-sym? x sk2 fk2) sk2) + ((new-sym? y sk2 fk2) fk2)))) + (new-sym? random-sym-to-match + (let ((x v)) (sk ... (id ... x))) + (if (equal? v x) (sk ... (id ...)) fk)))) + )) + +;; QUASIQUOTE patterns + +(define-syntax match-quasiquote + (syntax-rules (unquote unquote-splicing quasiquote) + ((_ v (unquote p) g+s sk fk i) + (match-one v p g+s sk fk i)) + ((_ v ((unquote-splicing p) . rest) g+s sk fk i) + (if (pair? v) + (match-one v + (p . tmp) + (match-quasiquote tmp rest g+s sk fk) + fk + i) + fk)) + ((_ v (quasiquote p) g+s sk fk i . depth) + (match-quasiquote v p g+s sk fk i #f . depth)) + ((_ v (unquote p) g+s sk fk i x . depth) + (match-quasiquote v p g+s sk fk i . depth)) + ((_ v (unquote-splicing p) g+s sk fk i x . depth) + (match-quasiquote v p g+s sk fk i . depth)) + ((_ v (p . q) g+s sk fk i . depth) + (if (pair? v) + (let ((w (car v)) (x (cdr v))) + (match-quasiquote + w p g+s + (match-quasiquote-step x q g+s sk fk depth) + fk i . depth)) + fk)) + ((_ v #(elt ...) g+s sk fk i . depth) + (if (vector? v) + (let ((ls (vector->list v))) + (match-quasiquote ls (elt ...) g+s sk fk i . depth)) + fk)) + ((_ v x g+s sk fk i . depth) + (match-one v 'x g+s sk fk i)))) + +(define-syntax match-quasiquote-step + (syntax-rules () + ((match-quasiquote-step x q g+s sk fk depth i) + (match-quasiquote x q g+s sk fk i . depth)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utilities + +;; Takes two values and just expands into the first. +(define-syntax match-drop-ids + (syntax-rules () + ((_ expr ids ...) expr))) + +(define-syntax match-tuck-ids + (syntax-rules () + ((_ (letish args (expr ...)) ids ...) + (letish args (expr ... ids ...))))) + +(define-syntax match-drop-first-arg + (syntax-rules () + ((_ arg expr) expr))) + +;; To expand an OR group we try each clause in succession, passing the +;; first that succeeds to the success continuation. On failure for +;; any clause, we just try the next clause, finally resorting to the +;; failure continuation fk if all clauses fail. The only trick is +;; that we want to unify the identifiers, so that the success +;; continuation can refer to a variable from any of the OR clauses. + +(define-syntax match-gen-or + (syntax-rules () + ((_ v p g+s (sk ...) fk (i ...) ((id id-ls) ...)) + (let ((sk2 (lambda (id ...) (sk ... (i ... id ...))))) + (match-gen-or-step v p g+s (match-drop-ids (sk2 id ...)) fk (i ...)))))) + +(define-syntax match-gen-or-step + (syntax-rules () + ((_ v () g+s sk fk . x) + ;; no OR clauses, call the failure continuation + fk) + ((_ v (p) . x) + ;; last (or only) OR clause, just expand normally + (match-one v p . x)) + ((_ v (p . q) g+s sk fk i) + ;; match one and try the remaining on failure + (let ((fk2 (lambda () (match-gen-or-step v q g+s sk fk i)))) + (match-one v p g+s sk (fk2) i))) + )) + +;; We match a pattern (p ...) by matching the pattern p in a loop on +;; each element of the variable, accumulating the bound ids into lists. + +;; Look at the body of the simple case - it's just a named let loop, +;; matching each element in turn to the same pattern. The only trick +;; is that we want to keep track of the lists of each extracted id, so +;; when the loop recurses we cons the ids onto their respective list +;; variables, and on success we bind the ids (what the user input and +;; expects to see in the success body) to the reversed accumulated +;; list IDs. + +(define-syntax match-gen-ellipsis + (syntax-rules () + ((_ v p () g+s (sk ...) fk i ((id id-ls) ...)) + (match-check-identifier p + ;; simplest case equivalent to (p ...), just bind the list + (let ((p v)) + (if (list? p) + (sk ... i) + fk)) + ;; simple case, match all elements of the list + (let loop ((ls v) (id-ls '()) ...) + (cond + ((null? ls) + (let ((id (reverse id-ls)) ...) (sk ... i))) + ((pair? ls) + (let ((w (car ls))) + (match-one w p ((car ls) (set-car! ls)) + (match-drop-ids (loop (cdr ls) (cons id id-ls) ...)) + fk i))) + (else + fk))))) + ((_ v p r g+s (sk ...) fk i ((id id-ls) ...)) + ;; general case, trailing patterns to match, keep track of the + ;; remaining list length so we don't need any backtracking + (match-verify-no-ellipsis + r + (let* ((tail-len (length 'r)) + (ls v) + (len (and (list? ls) (length ls)))) + (if (or (not len) (< len tail-len)) + fk + (let loop ((ls ls) (n len) (id-ls '()) ...) + (cond + ((= n tail-len) + (let ((id (reverse id-ls)) ...) + (match-one ls r (#f #f) (sk ...) fk i))) + ((pair? ls) + (let ((w (car ls))) + (match-one w p ((car ls) (set-car! ls)) + (match-drop-ids + (loop (cdr ls) (- n 1) (cons id id-ls) ...)) + fk + i))) + (else + fk))))))))) + +;; This is just a safety check. Although unlike syntax-rules we allow +;; trailing patterns after an ellipsis, we explicitly disable multiple +;; ellipsis at the same level. This is because in the general case +;; such patterns are exponential in the number of ellipsis, and we +;; don't want to make it easy to construct very expensive operations +;; with simple looking patterns. For example, it would be O(n^2) for +;; patterns like (a ... b ...) because we must consider every trailing +;; element for every possible break for the leading "a ...". + +(define-syntax match-verify-no-ellipsis + (syntax-rules () + ((_ (x . y) sk) + (match-check-ellipsis + x + (match-syntax-error + "multiple ellipsis patterns not allowed at same level") + (match-verify-no-ellipsis y sk))) + ((_ () sk) + sk) + ((_ x sk) + (match-syntax-error "dotted tail not allowed after ellipsis" x)))) + +;; To implement the tree search, we use two recursive procedures. TRY +;; attempts to match Y once, and on success it calls the normal SK on +;; the accumulated list ids as in MATCH-GEN-ELLIPSIS. On failure, we +;; call NEXT which first checks if the current value is a list +;; beginning with X, then calls TRY on each remaining element of the +;; list. Since TRY will recursively call NEXT again on failure, this +;; effects a full depth-first search. +;; +;; The failure continuation throughout is a jump to the next step in +;; the tree search, initialized with the original failure continuation +;; FK. + +(define-syntax match-gen-search + (syntax-rules () + ((match-gen-search v p q g+s sk fk i ((id id-ls) ...)) + (letrec ((try (lambda (w fail id-ls ...) + (match-one w q g+s + (match-tuck-ids + (let ((id (reverse id-ls)) ...) + sk)) + (next w fail id-ls ...) i))) + (next (lambda (w fail id-ls ...) + (if (not (pair? w)) + (fail) + (let ((u (car w))) + (match-one + u p ((car w) (set-car! w)) + (match-drop-ids + ;; accumulate the head variables from + ;; the p pattern, and loop over the tail + (let ((id-ls (cons id id-ls)) ...) + (let lp ((ls (cdr w))) + (if (pair? ls) + (try (car ls) + (lambda () (lp (cdr ls))) + id-ls ...) + (fail))))) + (fail) i)))))) + ;; the initial id-ls binding here is a dummy to get the right + ;; number of '()s + (let ((id-ls '()) ...) + (try v (lambda () fk) id-ls ...)))))) + +;; Vector patterns are just more of the same, with the slight +;; exception that we pass around the current vector index being +;; matched. + +(define-syntax match-vector + (syntax-rules (___) + ((_ v n pats (p q) . x) + (match-check-ellipsis q + (match-gen-vector-ellipsis v n pats p . x) + (match-vector-two v n pats (p q) . x))) + ((_ v n pats (p ___) sk fk i) + (match-gen-vector-ellipsis v n pats p sk fk i)) + ((_ . x) + (match-vector-two . x)))) + +;; Check the exact vector length, then check each element in turn. + +(define-syntax match-vector-two + (syntax-rules () + ((_ v n ((pat index) ...) () sk fk i) + (if (vector? v) + (let ((len (vector-length v))) + (if (= len n) + (match-vector-step v ((pat index) ...) sk fk i) + fk)) + fk)) + ((_ v n (pats ...) (p . q) . x) + (match-vector v (+ n 1) (pats ... (p n)) q . x)))) + +(define-syntax match-vector-step + (syntax-rules () + ((_ v () (sk ...) fk i) (sk ... i)) + ((_ v ((pat index) . rest) sk fk i) + (let ((w (vector-ref v index))) + (match-one w pat ((vector-ref v index) (vector-set! v index)) + (match-vector-step v rest sk fk) + fk i))))) + +;; With a vector ellipsis pattern we first check to see if the vector +;; length is at least the required length. + +(define-syntax match-gen-vector-ellipsis + (syntax-rules () + ((_ v n ((pat index) ...) p sk fk i) + (if (vector? v) + (let ((len (vector-length v))) + (if (>= len n) + (match-vector-step v ((pat index) ...) + (match-vector-tail v p n len sk fk) + fk i) + fk)) + fk)))) + +(define-syntax match-vector-tail + (syntax-rules () + ((_ v p n len sk fk i) + (match-extract-vars p (match-vector-tail-two v p n len sk fk i) i ())))) + +(define-syntax match-vector-tail-two + (syntax-rules () + ((_ v p n len (sk ...) fk i ((id id-ls) ...)) + (let loop ((j n) (id-ls '()) ...) + (if (>= j len) + (let ((id (reverse id-ls)) ...) (sk ... i)) + (let ((w (vector-ref v j))) + (match-one w p ((vector-ref v j) (vector-set! v j)) + (match-drop-ids (loop (+ j 1) (cons id id-ls) ...)) + fk i))))))) + +(define-syntax match-record-refs + (syntax-rules () + ((_ v rec n (p . q) g+s sk fk i) + (let ((w (slot-ref rec v n))) + (match-one w p ((slot-ref rec v n) (slot-set! rec v n)) + (match-record-refs v rec (+ n 1) q g+s sk fk) fk i))) + ((_ v rec n () g+s (sk ...) fk i) + (sk ... i)))) + +(define-syntax match-record-named-refs + (syntax-rules () + ((_ v rec ((f p) . q) g+s sk fk i) + (let ((w (slot-ref rec v 'f))) + (match-one w p ((slot-ref rec v 'f) (slot-set! rec v 'f)) + (match-record-named-refs v rec q g+s sk fk) fk i))) + ((_ v rec () g+s (sk ...) fk i) + (sk ... i)))) + +;; Extract all identifiers in a pattern. A little more complicated +;; than just looking for symbols, we need to ignore special keywords +;; and non-pattern forms (such as the predicate expression in ? +;; patterns), and also ignore previously bound identifiers. +;; +;; Calls the continuation with all new vars as a list of the form +;; ((orig-var tmp-name) ...), where tmp-name can be used to uniquely +;; pair with the original variable (e.g. it's used in the ellipsis +;; generation for list variables). +;; +;; (match-extract-vars pattern continuation (ids ...) (new-vars ...)) + +;; Replace '_' with ':_' as the former is forbidden as an auxiliariy +;; keyword in R6RS. (FBE) +(define-syntax match-extract-vars + (syntax-rules (:_ ___ ..1 *** ? $ struct @ object = quote quasiquote and or not get! set!) + ((match-extract-vars (? pred . p) . x) + (match-extract-vars p . x)) + ((match-extract-vars ($ rec . p) . x) + (match-extract-vars p . x)) + ((match-extract-vars (struct rec . p) . x) + (match-extract-vars p . x)) + ((match-extract-vars (@ rec (f p) ...) . x) + (match-extract-vars (p ...) . x)) + ((match-extract-vars (object rec (f p) ...) . x) + (match-extract-vars (p ...) . x)) + ((match-extract-vars (= proc p) . x) + (match-extract-vars p . x)) + ((match-extract-vars (quote x) (k ...) i v) + (k ... v)) + ((match-extract-vars (quasiquote x) k i v) + (match-extract-quasiquote-vars x k i v (#t))) + ((match-extract-vars (and . p) . x) + (match-extract-vars p . x)) + ((match-extract-vars (or . p) . x) + (match-extract-vars p . x)) + ((match-extract-vars (not . p) . x) + (match-extract-vars p . x)) + ;; A non-keyword pair, expand the CAR with a continuation to + ;; expand the CDR. + ((match-extract-vars (p q . r) k i v) + (match-check-ellipsis + q + (match-extract-vars (p . r) k i v) + (match-extract-vars p (match-extract-vars-step (q . r) k i v) i ()))) + ((match-extract-vars (p . q) k i v) + (match-extract-vars p (match-extract-vars-step q k i v) i ())) + ((match-extract-vars #(p ...) . x) + (match-extract-vars (p ...) . x)) + ;; Next line: replace '_' with ':_'. (FBE) + ((match-extract-vars :_ (k ...) i v) (k ... v)) + ((match-extract-vars ___ (k ...) i v) (k ... v)) + ((match-extract-vars *** (k ...) i v) (k ... v)) + ((match-extract-vars ..1 (k ...) i v) (k ... v)) + ;; This is the main part, the only place where we might add a new + ;; var if it's an unbound symbol. + ((match-extract-vars p (k ...) (i ...) v) + (let-syntax + ((new-sym? + (syntax-rules (i ...) + ((new-sym? p sk fk) sk) + ((new-sym? any sk fk) fk)))) + (new-sym? random-sym-to-match + (k ... ((p p-ls) . v)) + (k ... v)))) + )) + +;; Stepper used in the above so it can expand the CAR and CDR +;; separately. + +(define-syntax match-extract-vars-step + (syntax-rules () + ((_ p k i v ((v2 v2-ls) ...)) + (match-extract-vars p k (v2 ... . i) ((v2 v2-ls) ... . v))) + )) + +(define-syntax match-extract-quasiquote-vars + (syntax-rules (quasiquote unquote unquote-splicing) + ((match-extract-quasiquote-vars (quasiquote x) k i v d) + (match-extract-quasiquote-vars x k i v (#t . d))) + ((match-extract-quasiquote-vars (unquote-splicing x) k i v d) + (match-extract-quasiquote-vars (unquote x) k i v d)) + ((match-extract-quasiquote-vars (unquote x) k i v (#t)) + (match-extract-vars x k i v)) + ((match-extract-quasiquote-vars (unquote x) k i v (#t . d)) + (match-extract-quasiquote-vars x k i v d)) + ((match-extract-quasiquote-vars (x . y) k i v d) + (match-extract-quasiquote-vars + x + (match-extract-quasiquote-vars-step y k i v d) i () d)) + ((match-extract-quasiquote-vars #(x ...) k i v d) + (match-extract-quasiquote-vars (x ...) k i v d)) + ((match-extract-quasiquote-vars x (k ...) i v d) + (k ... v)) + )) + +(define-syntax match-extract-quasiquote-vars-step + (syntax-rules () + ((_ x k i v d ((v2 v2-ls) ...)) + (match-extract-quasiquote-vars x k (v2 ... . i) ((v2 v2-ls) ... . v) d)) + )) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Gimme some sugar baby. + +;;> Shortcut for \scheme{lambda} + \scheme{match}. Creates a +;;> procedure of one argument, and matches that argument against each +;;> clause. + +(define-syntax match-lambda + (syntax-rules () + ((_ (pattern . body) ...) (lambda (expr) (match expr (pattern . body) ...))))) + +;;> Similar to \scheme{match-lambda}. Creates a procedure of any +;;> number of arguments, and matches the argument list against each +;;> clause. + +(define-syntax match-lambda* + (syntax-rules () + ((_ (pattern . body) ...) (lambda expr (match expr (pattern . body) ...))))) + +;;> Matches each var to the corresponding expression, and evaluates +;;> the body with all match variables in scope. Raises an error if +;;> any of the expressions fail to match. Syntax analogous to named +;;> let can also be used for recursive functions which match on their +;;> arguments as in \scheme{match-lambda*}. + +(define-syntax match-let + (syntax-rules () + ((_ ((var value) ...) . body) + (match-let/helper let () () ((var value) ...) . body)) + ((_ loop ((var init) ...) . body) + (match-named-let loop () ((var init) ...) . body)))) + +;;> Similar to \scheme{match-let}, but analogously to \scheme{letrec} +;;> matches and binds the variables with all match variables in scope. + +(define-syntax match-letrec + (syntax-rules () + ((_ ((var value) ...) . body) + (match-let/helper letrec () () ((var value) ...) . body)))) + +(define-syntax match-let/helper + (syntax-rules () + ((_ let ((var expr) ...) () () . body) + (let ((var expr) ...) . body)) + ((_ let ((var expr) ...) ((pat tmp) ...) () . body) + (let ((var expr) ...) + (match-let* ((pat tmp) ...) + . body))) + ((_ let (v ...) (p ...) (((a . b) expr) . rest) . body) + (match-let/helper + let (v ... (tmp expr)) (p ... ((a . b) tmp)) rest . body)) + ((_ let (v ...) (p ...) ((#(a ...) expr) . rest) . body) + (match-let/helper + let (v ... (tmp expr)) (p ... (#(a ...) tmp)) rest . body)) + ((_ let (v ...) (p ...) ((a expr) . rest) . body) + (match-let/helper let (v ... (a expr)) (p ...) rest . body)))) + +(define-syntax match-named-let + (syntax-rules () + ((_ loop ((pat expr var) ...) () . body) + (let loop ((var expr) ...) + (match-let ((pat var) ...) + . body))) + ((_ loop (v ...) ((pat expr) . rest) . body) + (match-named-let loop (v ... (pat expr tmp)) rest . body)))) + +;;> \macro{(match-let* ((var value) ...) body ...)} + +;;> Similar to \scheme{match-let}, but analogously to \scheme{let*} +;;> matches and binds the variables in sequence, with preceding match +;;> variables in scope. + +(define-syntax match-let* + (syntax-rules () + ((_ () . body) + (let () . body)) + ((_ ((pat expr) . rest) . body) + (match expr (pat (match-let* rest . body)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Otherwise COND-EXPANDed bits. + +;; To avoid depending on srfi-0 we comment the following form and copy +;; the generic version below it. (FBE) + +;; (cond-expand +;; (chibi +;; (define-syntax match-check-ellipsis +;; (er-macro-transformer +;; (lambda (expr rename compare) +;; (if (compare '... (cadr expr)) +;; (car (cddr expr)) +;; (cadr (cddr expr)))))) +;; (define-syntax match-check-identifier +;; (er-macro-transformer +;; (lambda (expr rename compare) +;; (if (identifier? (cadr expr)) +;; (car (cddr expr)) +;; (cadr (cddr expr))))))) + +;; (else +;; ;; Portable versions +;; ;; +;; ;; This *should* work, but doesn't :( +;; ;; (define-syntax match-check-ellipsis +;; ;; (syntax-rules (...) +;; ;; ((_ ... sk fk) sk) +;; ;; ((_ x sk fk) fk))) +;; ;; +;; ;; This is a little more complicated, and introduces a new let-syntax, +;; ;; but should work portably in any R[56]RS Scheme. Taylor Campbell +;; ;; originally came up with the idea. +;; (define-syntax match-check-ellipsis +;; (syntax-rules () +;; ;; these two aren't necessary but provide fast-case failures +;; ((match-check-ellipsis (a . b) success-k failure-k) failure-k) +;; ((match-check-ellipsis #(a ...) success-k failure-k) failure-k) +;; ;; matching an atom +;; ((match-check-ellipsis id success-k failure-k) +;; (let-syntax ((ellipsis? (syntax-rules () +;; ;; iff `id' is `...' here then this will +;; ;; match a list of any length +;; ((ellipsis? (foo id) sk fk) sk) +;; ((ellipsis? other sk fk) fk)))) +;; ;; this list of three elements will only match the (foo id) list +;; ;; above if `id' is `...' +;; (ellipsis? (a b c) success-k failure-k))))) + +;; ;; This is portable but can be more efficient with non-portable +;; ;; extensions. This trick was originally discovered by Oleg Kiselyov. +;; (define-syntax match-check-identifier +;; (syntax-rules () +;; ;; fast-case failures, lists and vectors are not identifiers +;; ((_ (x . y) success-k failure-k) failure-k) +;; ((_ #(x ...) success-k failure-k) failure-k) +;; ;; x is an atom +;; ((_ x success-k failure-k) +;; (let-syntax +;; ((sym? +;; (syntax-rules () +;; ;; if the symbol `abracadabra' matches x, then x is a +;; ;; symbol +;; ((sym? x sk fk) sk) +;; ;; otherwise x is a non-symbol datum +;; ((sym? y sk fk) fk)))) +;; (sym? abracadabra success-k failure-k))))))) + +;; Portable versions +;; +;; This *should* work, but doesn't :( +;; (define-syntax match-check-ellipsis +;; (syntax-rules (...) +;; ((_ ... sk fk) sk) +;; ((_ x sk fk) fk))) +;; +;; This is a little more complicated, and introduces a new let-syntax, +;; but should work portably in any R[56]RS Scheme. Taylor Campbell +;; originally came up with the idea. +(define-syntax match-check-ellipsis + (syntax-rules () + ;; these two aren't necessary but provide fast-case failures + ((match-check-ellipsis (a . b) success-k failure-k) failure-k) + ((match-check-ellipsis #(a ...) success-k failure-k) failure-k) + ;; matching an atom + ((match-check-ellipsis id success-k failure-k) + (let-syntax ((ellipsis? (syntax-rules () + ;; iff `id' is `...' here then this will + ;; match a list of any length + ((ellipsis? (foo id) sk fk) sk) + ((ellipsis? other sk fk) fk)))) + ;; this list of three elements will only match the (foo id) list + ;; above if `id' is `...' + (ellipsis? (a b c) success-k failure-k))))) + +;; This is portable but can be more efficient with non-portable +;; extensions. This trick was originally discovered by Oleg Kiselyov. +(define-syntax match-check-identifier + (syntax-rules () + ;; fast-case failures, lists and vectors are not identifiers + ((_ (x . y) success-k failure-k) failure-k) + ((_ #(x ...) success-k failure-k) failure-k) + ;; x is an atom + ((_ x success-k failure-k) + (let-syntax + ((sym? + (syntax-rules () + ;; if the symbol `abracadabra' matches x, then x is a + ;; symbol + ((sym? x sk fk) sk) + ;; otherwise x is a non-symbol datum + ((sym? y sk fk) fk)))) + (sym? abracadabra success-k failure-k))))) diff --git a/live/match/unstable/checks/check b/live/match/unstable/checks/check new file mode 100755 index 0000000..170a82c --- /dev/null +++ b/live/match/unstable/checks/check @@ -0,0 +1,19 @@ +#!/bin/sh + +CHECKS_DIRECTORY=$(realpath $(dirname $0)) +EXIT=0 + +cd $CHECKS_DIRECTORY + +for CHECK in $(ls check-*.scm); do + echo "** scheme-live $SCHEME_LIVE_CURRENT run $CHECKS_DIRECTORY/$CHECK" + scheme-live current run "$CHECKS_DIRECTORY/$CHECK" + if [ $? = 255 ]; then + echo "*** failed" + EXIT=255 + fi +done + +cd - + +exit $EXIT diff --git a/live/match/unstable/checks/check-0000.scm b/live/match/unstable/checks/check-0000.scm new file mode 100644 index 0000000..a3d1562 --- /dev/null +++ b/live/match/unstable/checks/check-0000.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 42 (match 42 (42 42))) diff --git a/live/match/unstable/checks/check-0001.scm b/live/match/unstable/checks/check-0001.scm new file mode 100644 index 0000000..5e7d31a --- /dev/null +++ b/live/match/unstable/checks/check-0001.scm @@ -0,0 +1,8 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test #t (let ((ls (list 1 2 3))) + (match ls + ((1 2 3) #t)))) diff --git a/live/match/unstable/checks/check-0002.scm b/live/match/unstable/checks/check-0002.scm new file mode 100644 index 0000000..a4b2cd6 --- /dev/null +++ b/live/match/unstable/checks/check-0002.scm @@ -0,0 +1,8 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'ok + (let ((lts (list 'a "b" #f 2 '() #\c))) + (match lts (('a "b" #f 2 '() #\c) 'ok)))) diff --git a/live/match/unstable/checks/check-0003.scm b/live/match/unstable/checks/check-0003.scm new file mode 100644 index 0000000..614acbf --- /dev/null +++ b/live/match/unstable/checks/check-0003.scm @@ -0,0 +1,5 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + +(test 'ok (match '#(1) ('#(1) 'ok))) diff --git a/live/match/unstable/checks/check-0004.scm b/live/match/unstable/checks/check-0004.scm new file mode 100644 index 0000000..66ed157 --- /dev/null +++ b/live/match/unstable/checks/check-0004.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 2 (match (list 1 2 3) ((a b c) b))) diff --git a/live/match/unstable/checks/check-0005.scm b/live/match/unstable/checks/check-0005.scm new file mode 100644 index 0000000..a6b5baf --- /dev/null +++ b/live/match/unstable/checks/check-0005.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 2 (match (list 1 2 3) ((_ b _2) b))) diff --git a/live/match/unstable/checks/check-0006.scm b/live/match/unstable/checks/check-0006.scm new file mode 100644 index 0000000..3e9d9ee --- /dev/null +++ b/live/match/unstable/checks/check-0006.scm @@ -0,0 +1,7 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'fail + (match (list 1 2 3) (`(a ,b c) b) (_ 'fail))) diff --git a/live/match/unstable/checks/check-0009.scm b/live/match/unstable/checks/check-0009.scm new file mode 100644 index 0000000..15e4036 --- /dev/null +++ b/live/match/unstable/checks/check-0009.scm @@ -0,0 +1,7 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'fail + (match (list 'A 'B 'A) (`(,a b ,a) a) (_ 'fail))) diff --git a/live/match/unstable/checks/check-0012.scm b/live/match/unstable/checks/check-0012.scm new file mode 100644 index 0000000..f22a7ee --- /dev/null +++ b/live/match/unstable/checks/check-0012.scm @@ -0,0 +1,9 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + +(test + 1 + (match (list 1 2 1) + ((a b c) (=> fail) (if (equal? a c) a (fail))) + (_ 'fail))) diff --git a/live/match/unstable/checks/check-0013.scm b/live/match/unstable/checks/check-0013.scm new file mode 100644 index 0000000..0b1bff9 --- /dev/null +++ b/live/match/unstable/checks/check-0013.scm @@ -0,0 +1,7 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test #t + (match (list 1 2) ((1 2 3 ...) #t))) diff --git a/live/match/unstable/checks/check-0015.scm b/live/match/unstable/checks/check-0015.scm new file mode 100644 index 0000000..211c91e --- /dev/null +++ b/live/match/unstable/checks/check-0015.scm @@ -0,0 +1,7 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test '((a a a) (b b b)) + (match '((a b) (a b) (a b)) (((x y) ...) (list x y)))) diff --git a/live/match/unstable/checks/check-0016.scm b/live/match/unstable/checks/check-0016.scm new file mode 100644 index 0000000..887c31e --- /dev/null +++ b/live/match/unstable/checks/check-0016.scm @@ -0,0 +1,12 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(let () + (define transpose + (match-lambda (((a b ...) ...) (cons a (transpose b))) (_ '()))) + + (test + '((a a) (b b) (c c)) + (transpose '((a b c) (a b c))))) diff --git a/live/match/unstable/checks/check-0017.scm b/live/match/unstable/checks/check-0017.scm new file mode 100644 index 0000000..c821731 --- /dev/null +++ b/live/match/unstable/checks/check-0017.scm @@ -0,0 +1,11 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(define first-column + (lambda (e) + (match e (((a b ...) ...) a)))) + +(test '(a a a) + (first-column '((a b c) (a b c) (a b c)))) diff --git a/live/match/unstable/checks/check-0018.scm b/live/match/unstable/checks/check-0018.scm new file mode 100644 index 0000000..e49fc5c --- /dev/null +++ b/live/match/unstable/checks/check-0018.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'failure (match (list 1 2) ((a b c **1) c) (_ 'failure))) diff --git a/live/match/unstable/checks/check-0022.scm b/live/match/unstable/checks/check-0022.scm new file mode 100644 index 0000000..ed05188 --- /dev/null +++ b/live/match/unstable/checks/check-0022.scm @@ -0,0 +1,9 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'fail + (match '((a b) (c d) (e f) (g h)) + (((x y) =.. 3) (list x y)) + (_ 'fail))) diff --git a/live/match/unstable/checks/check-0024.scm b/live/match/unstable/checks/check-0024.scm new file mode 100644 index 0000000..ac16790 --- /dev/null +++ b/live/match/unstable/checks/check-0024.scm @@ -0,0 +1,8 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + +(test 'fail + (match '((a b)) + (((x y) *.. 2 4) (list x y)) + (_ 'fail))) diff --git a/live/match/unstable/checks/check-0027.scm b/live/match/unstable/checks/check-0027.scm new file mode 100644 index 0000000..5ee51d2 --- /dev/null +++ b/live/match/unstable/checks/check-0027.scm @@ -0,0 +1,8 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + +(test 'fail + (match '((a b) (a b) (a b) (a b) (a b)) + (((x y) *.. 2 4) (list x y)) + (_ 'fail))) diff --git a/live/match/unstable/checks/check-0028.scm b/live/match/unstable/checks/check-0028.scm new file mode 100644 index 0000000..a15e1a0 --- /dev/null +++ b/live/match/unstable/checks/check-0028.scm @@ -0,0 +1,10 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(define keys + (lambda (x) (match x (((a b ...) ...) a) (_ 'fail)))) + + +(test '(a b c) (keys '((a 1) (b 2) (c 3)))) diff --git a/live/match/unstable/checks/check-0029.scm b/live/match/unstable/checks/check-0029.scm new file mode 100644 index 0000000..7067bf0 --- /dev/null +++ b/live/match/unstable/checks/check-0029.scm @@ -0,0 +1,9 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(define keys + (lambda (x) (match x (((a b ...) ...) a) (_ 'fail)))) + +(test 'fail (keys '((a . 1) (b . 2) (c . 3)))) diff --git a/live/match/unstable/checks/check-0030.scm b/live/match/unstable/checks/check-0030.scm new file mode 100644 index 0000000..f57f61c --- /dev/null +++ b/live/match/unstable/checks/check-0030.scm @@ -0,0 +1,10 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(define keys + (match-lambda (((a . _) ...) a) (_ 'fail))) + +(test '(a b c) + (keys '((a 1) (b 2) (c 3)))) diff --git a/live/match/unstable/checks/check-0031.scm b/live/match/unstable/checks/check-0031.scm new file mode 100644 index 0000000..3780a1f --- /dev/null +++ b/live/match/unstable/checks/check-0031.scm @@ -0,0 +1,11 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + + +(define keys + (match-lambda (((a . _) ...) a) (_ 'fail))) + +(test '(a b c) + (keys '((a . 1) (b . 2) (c . 3)))) diff --git a/live/match/unstable/checks/check-0032.scm b/live/match/unstable/checks/check-0032.scm new file mode 100644 index 0000000..cd9a74b --- /dev/null +++ b/live/match/unstable/checks/check-0032.scm @@ -0,0 +1,8 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test '(+ * +) + (match '(+ (* (+ 7 2) (/ 5 4)) (sqrt (+ (square x) (square y)))) + ((a *** 7) a))) diff --git a/live/match/unstable/checks/check-0034.scm b/live/match/unstable/checks/check-0034.scm new file mode 100644 index 0000000..9513d7c --- /dev/null +++ b/live/match/unstable/checks/check-0034.scm @@ -0,0 +1,5 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + +(test #t (match 1 ((and) #t))) diff --git a/live/match/unstable/checks/check-0035.scm b/live/match/unstable/checks/check-0035.scm new file mode 100644 index 0000000..c6a2215 --- /dev/null +++ b/live/match/unstable/checks/check-0035.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 1 (match 1 ((and x) x))) diff --git a/live/match/unstable/checks/check-0036.scm b/live/match/unstable/checks/check-0036.scm new file mode 100644 index 0000000..5b3ddfd --- /dev/null +++ b/live/match/unstable/checks/check-0036.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 1 (match 1 ((and x 1) x))) diff --git a/live/match/unstable/checks/check-0037.scm b/live/match/unstable/checks/check-0037.scm new file mode 100644 index 0000000..3d2fa5f --- /dev/null +++ b/live/match/unstable/checks/check-0037.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test #t (match #f ((and) #t) (_ #f))) diff --git a/live/match/unstable/checks/check-0039.scm b/live/match/unstable/checks/check-0039.scm new file mode 100644 index 0000000..7080258 --- /dev/null +++ b/live/match/unstable/checks/check-0039.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test #f (match 1 ((or) #t) (else #f))) diff --git a/live/match/unstable/checks/check-0040.scm b/live/match/unstable/checks/check-0040.scm new file mode 100644 index 0000000..c9e0ed3 --- /dev/null +++ b/live/match/unstable/checks/check-0040.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 1 (match 1 ((or x) x))) diff --git a/live/match/unstable/checks/check-0041.scm b/live/match/unstable/checks/check-0041.scm new file mode 100644 index 0000000..68a0c83 --- /dev/null +++ b/live/match/unstable/checks/check-0041.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 1 (match 1 ((and x (not #f)) x) (_ 'fail))) diff --git a/live/match/unstable/checks/check-0042.scm b/live/match/unstable/checks/check-0042.scm new file mode 100644 index 0000000..b7bd2de --- /dev/null +++ b/live/match/unstable/checks/check-0042.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'fail (match #f ((and x (not #f)) x) (_ 'fail))) diff --git a/live/match/unstable/checks/check-0043.scm b/live/match/unstable/checks/check-0043.scm new file mode 100644 index 0000000..e6b0fcb --- /dev/null +++ b/live/match/unstable/checks/check-0043.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test #t (match 1 ((not 2) #t))) diff --git a/live/match/unstable/checks/check-0044.scm b/live/match/unstable/checks/check-0044.scm new file mode 100644 index 0000000..d6cb5fc --- /dev/null +++ b/live/match/unstable/checks/check-0044.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 1 (match 1 ((? odd? x) x))) diff --git a/live/match/unstable/checks/check-0045.scm b/live/match/unstable/checks/check-0045.scm new file mode 100644 index 0000000..fd03cd9 --- /dev/null +++ b/live/match/unstable/checks/check-0045.scm @@ -0,0 +1,6 @@ +#!/usr/bin/env -S scheme-live current run +(import (live unstable)) +(import (live match unstable)) + + +(test 'fail (match 42 ((? odd? x) x) (_ 'fail))) diff --git a/live/match/unstable/match-simple.scm b/live/match/unstable/match-simple.scm new file mode 100644 index 0000000..e662198 --- /dev/null +++ b/live/match/unstable/match-simple.scm @@ -0,0 +1,145 @@ +(define-syntax match + (syntax-rules () + ((match expr (pat . body) ...) + (match-gen-labels expr start () (pat . body) ...)))) + +(define-syntax match-gen-labels + (syntax-rules (=>) + ((_ expr label ((k1 fk1 pat1 . body1) (k fk pat . body) ...)) + (let ((tmp expr)) + (letrec ((k (lambda () (match-one tmp pat (begin . body) (fk)))) ... + (label (lambda () (error "no matches" tmp)))) + (match-one tmp pat1 (begin . body1) (fk1))))) + ((_ expr label (labels ...) (pat (=> fk) . body) . rest) + (match-gen-labels expr fk (labels ... (label fk pat . body)) . rest)) + ((_ expr label (labels ...) (pat . body) . rest) + (match-gen-labels expr fail (labels ... (label fail pat . body)) . rest)) + )) + +(define-syntax match-one + (syntax-rules (_ ___ quote ? and or not) + ((match-one var () sk fk) + (if (null? var) sk fk)) + ((match-one var (quote a) sk fk) + (if (equal? var 'a) sk fk)) + ((match-one var (and) sk fk) sk) + ((match-one var (and a b ...) sk fk) + (match-one var a (match-one var (and b ...) sk fk) fk)) + ((match-one var (or) sk fk) fk) + ((match-one var (or a ...) sk fk) + (let ((sk2 (lambda () sk))) + (match-one var (not (and (not a) ...)) (sk2) fk))) + ((match-one var (not a) sk fk) + (match-one var a fk sk)) + ((match-one var (? pred a ...) sk fk) + (if (pred var) (match-one var (and a ...) sk fk) fk)) + ((match-one var (a ___) sk fk) + (match-extract-variables a (match-gen-ellipses var a sk fk) ())) + ((match-one var (a) sk fk) + (if (and (pair? var) (null? (cdr var))) + (let ((tmp (car var))) + (match-one tmp a sk fk)) + fk)) + ((match-one var (a . b) sk fk) + (if (pair? var) + (let ((tmp1 (car var))) + (match-one tmp1 a (let ((tmp2 (cdr var))) (match-one tmp2 b sk fk)) fk)) + fk)) + ((match-one var #(a ...) sk fk) + (if (vector? var) + (let ((ls (vector->list var))) + (match-one ls (a ...) sk fk)) + fk)) + ((match-one var _ sk fk) sk) + ((match-one var x sk fk) + (let-syntax ((sym? + (syntax-rules () + ((sym? x) (let ((x var)) sk)) + ((sym? y) (if (equal? var x) sk fk))))) + (sym? abracadabra))) ; thanks Oleg + )) + +(define-syntax match-gen-ellipses + (syntax-rules () + ((_ var a sk fk ((v v-ls) ...)) + (let loop ((ls var) (v-ls '()) ...) + (cond ((null? ls) + (let ((v (reverse v-ls)) ...) sk)) + ((pair? ls) + (let ((x (car ls))) + (match-one x a (loop (cdr ls) (cons v v-ls) ...) fk))) + (else + fk)))) + )) + +(define-syntax match-extract-variables + (syntax-rules (_ ___ quote ? and or not) + ((_ (a . b) k v) + (match-extract-variables a (match-extract-variables-step b k v) ())) + ((_ #(a ...) k v) + (match-extract-variables (a ...) k v)) + ((_ a (k ...) (v ...)) + (let-syntax ((sym? + (syntax-rules () + ((sym? a) (k ... (v ... (a a-ls)))) + ((sym? b) (k ... (v ...)))))) + (sym? abracadabra))) + )) + +(define-syntax match-extract-variables-step + (syntax-rules () + ((_ a k (v ...) (v2 ...)) + (match-extract-variables a k (v ... v2 ...))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; gimme some sugar baby + +(define-syntax match-lambda + (syntax-rules () + ((_ clause ...) (lambda (expr) (match expr clause ...))))) + +(define-syntax match-lambda* + (syntax-rules () + ((_ clause ...) (lambda expr (match expr clause ...))))) + +(define-syntax match-let + (syntax-rules () + ((_ ((pat expr)) . body) + (match expr (pat . body))) + ((_ ((pat expr) ...) . body) + (match (list expr ...) ((pat ...) . body))) + ((_ loop . rest) + (match-named-let loop () . rest)) + )) + +(define-syntax match-named-let + (syntax-rules () + ((_ loop ((pat expr var) ...) () . body) + (let loop ((var expr) ...) + (match-let ((pat var) ...) + . body))) + ((_ loop (v ...) ((pat expr) . rest) . body) + (match-named-let loop (v ... (pat expr tmp)) rest . body)) + )) + +(define-syntax match-letrec + (syntax-rules () + ((_ vars . body) (match-letrec-helper () vars . body)))) + +(define-syntax match-letrec-helper + (syntax-rules () + ((_ ((pat expr var) ...) () . body) + (letrec ((var expr) ...) + (match-let ((pat var) ...) + . body))) + ((_ (v ...) ((pat expr) . rest) . body) + (match-letrec-helper (v ... (pat expr tmp)) rest . body)) + )) + +(define-syntax match-let* + (syntax-rules () + ((_ () . body) + (begin . body)) + ((_ ((pat expr) . rest) . body) + (match expr (pat (match-let* rest . body)))))) + diff --git a/live/json/base.chez.sls b/live/unstable.chez.sls similarity index 84% rename from live/json/base.chez.sls rename to live/unstable.chez.sls index 326927d..b26e75d 100644 --- a/live/json/base.chez.sls +++ b/live/unstable.chez.sls @@ -1,5 +1,13 @@ -(library (live json base) +(library (live unstable) (export + ... + _ + list? + test + let-syntax + vector-ref + vector-length + syntax-rules port? read quote @@ -65,6 +73,10 @@ lambda length let + letrec + letrec* + odd? + even? list list->string make-parameter @@ -110,6 +122,22 @@ exit) (import (rename (chezscheme) (define-record-type define-record-type*))) + (define-syntax test + (syntax-rules () + ((test expected expression) + (guard (_ (else (exit 255))) + (if (equal? expected expression) + (exit 0) + (exit 255)))))) + + (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)) diff --git a/live/json/base.rkt b/live/unstable.rkt similarity index 87% rename from live/json/base.rkt rename to live/unstable.rkt index a5950f5..2d3f205 100644 --- a/live/json/base.rkt +++ b/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)))))) diff --git a/live/json/base.sld b/live/unstable.scm similarity index 56% rename from live/json/base.sld rename to live/unstable.scm index acb6167..c290daf 100644 --- a/live/json/base.sld +++ b/live/unstable.scm @@ -1,5 +1,8 @@ -(define-library (live json base) +(define-library (live unstable) (export + syntax-rules + assume + test port? read let* @@ -91,7 +94,9 @@ void when write - exit) + exit + odd? + even?) (cond-expand (chicken @@ -149,6 +154,22 @@ (begin + (define-syntax assume + (syntax-rules () + ((assume expression message) + (or expression + (error 'assume message (quote expression)))) + ((assume . _) + (syntax-error "invalid assume syntax")))) + + (define-syntax test + (syntax-rules () + ((test expected expression) + (guard (_ (else (exit 255))) + (if (equal? expected expression) + (exit 0) + (exit 255)))))) + (cond-expand ((or gambit loko mit gauche) (define every @@ -158,83 +179,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 +215,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) diff --git a/live/unstable.sld b/live/unstable.sld new file mode 100644 index 0000000..75d8dc7 --- /dev/null +++ b/live/unstable.sld @@ -0,0 +1,248 @@ +(define-library (live unstable) + (export + ... + _ + list? + syntax-rules + let-syntax + assume + test + port? + read + let* + letrec + letrec* + odd? + begin + fx+ + string->symbol + number->string + symbol? + char? + current-output-port + include + + + - + <= + = + and + append + ash + bitwise-ior + boolean? + call-with-input-file + call-with-port + call-with-values + car + case + case-lambda + cdr + char=? + close-port + cond + cons + current-input-port + define-record-type + denominator + directory-list + display + eof-object? + eq? + equal? + error + exact? + file-regular? + for-all + for-each + format + fx- + fxzero? + get-output-string + guard + inexact? + infinite? + input-port? + integer->char + length + let + list + list->string + make-parameter + make-vector + map + nan? + newline + not + null? + number? + open-input-string + open-output-string + or + pair? + pk + procedure? + put-char + put-string + raise + read-char + real? + reverse + string->number + string-append + string-for-each + string? + symbol->string + textual-port? + unless + values + vector-for-each + vector-set! + vector? + void + when + write + exit + even?) + + (cond-expand + (chicken + (export set!) + (export lambda) + (export if) + (export define-syntax) + (export define) + (export quote)) + (cyclone + (export vector make-record-marker)) + (else + (export set!) + (export lambda) + (export if) + (export define-syntax) + (export define) + (export quote) + (export else))) + + (cond-expand + ((or chicken gambit loko gauche mit cyclone) + (import (scheme base) + ;; (srfi 1) + (scheme read) + (scheme case-lambda) + ;; (scheme bitwise) + (scheme file) + (scheme write) + (scheme process-context) + (live json shim))) + (else + (import (scheme base) + (scheme list) + (scheme read) + (scheme case-lambda) + (scheme bitwise) + (scheme file) + (scheme write) + (scheme process-context) + (live json shim)))) + + (cond-expand + (chicken + (import (only (chicken bitwise) bitwise-ior) + (only (srfi 1) every))) + (loko + (import (only (rnrs) bitwise-ior))) + (mit + (import (rename (srfi 143) (fxior bitwise-ior)))) + (cyclone + (import (only (srfi 1) every)) + (import (only (srfi 60) bitwise-ior))) + (else)) + + (begin + + (define-syntax assume + (syntax-rules () + ((assume expression message) + (or expression + (error 'assume message (quote expression)))) + ((assume . _) + (syntax-error "invalid assume syntax")))) + + (define-syntax test + (syntax-rules () + ((test expected expression) + (guard (_ (else (exit 255))) + (if (equal? expected expression) + (exit 0) + (exit 255)))))) + + (cond-expand + ((or gambit loko mit gauche) + (define every + (lambda (p? x) + (if (null? x) + #t + (if (p? (car x)) + (every (cdr x)) + #f))))) + (chicken) + (else)) + + (cond-expand + (loko + (define (remove pred lis) + (let recur ((lis lis)) + (if (null? lis) lis + (let ((head (car lis)) + (tail (cdr lis))) + (if (not (pred head)) + (let ((new-tail (recur tail))) + (if (eq? tail new-tail) lis + (cons head new-tail))) + (recur tail))))))) + (else)) + + (cond-expand + (mit + (define ignorable values)) + (else)) + + (define fx+ +) + (define fx- -) + (define fxzero? zero?) + + (define nan? (lambda (x) #f)) + + (define (format x message . args) + (cons message args)) + + (define for-all every) + + (define (void) + (when #f #f)) + + (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) + + (define put-char (lambda (p c) (write-char c p))) + + (define put-string (lambda (p s) (write-string s p))) + + (define (infinite? x) + (and (number? x) + (or (equal? x +inf.0) + (equal? x -inf.0)))))) diff --git a/live/unstable/index.html b/live/unstable/index.html new file mode 100644 index 0000000..1112f01 --- /dev/null +++ b/live/unstable/index.html @@ -0,0 +1,608 @@ + + + + + + + Scheme Live! + + + + +
+

Scheme Live!

+
+

(live unstable)

+

(alive expr message) syntax

+

Non-standard assert macro that immediatly exit the program with code 1 if expr evalutes to false, and display to the standard error output message. Otherwise, if expr evalutes to a truthy value returns that value.

+
(import (live unstable))
+
+
+(alive #t)
+

(* number ...)

+

Multiplication procedure.

+

(+ number ...)

+

Addition procedure.

+

(- number ...)

+

Substraction procedure.

+

(/ number ...)

+

Division procedure. Raise 'numerical-overflow condition in case where denominator is zero.

+

(< number number ...)

+

Less than procedure. Return a boolean.

+

(<= number number ...)

+

Less than or equal procedure. Return a boolean.

+

(= number number ...)

+

Return #t if the numbers passed as parameters are equal. And #f otherwise.

+

(> number number ...)

+

Greater than procedure. Return a boolean.

+

(>= number number ...)

+

Greater than or equal. Return a boolean.

+

(abs number)

+

Return the absolute value of NUMBER.

+

(and test1 ...)

+

The test expressions are evaluated from left to right, and if any expression evaluates to #f, then #f is returned. Any remaining expressions are not evaluated. If all the expressions evaluate to true values, the values of the last expression are returned. If there are no expressions, then #t is returned.

+

(append lst ...)

+

Return the list made of the list passed as parameters in the same order.

+

(apply proc arg1 ... args)

+

The apply procedure calls proc with the elements of the list (append (list arg1 ...) args) as the actual arguments.

+

(assoc obj alist)

+

Return the first pair which car is equal to OBJ according to the predicate equal?. Or it returns #f.

+

(assq obj alist)

+

Return the first pair which car is equal to OBJ according to the predicate eq?. Or it returns #f.

+

(assv obj alist)

+

Return the first pair which car is equal to OBJ according to the predicate eqv?. Or it returns #f.

+

begin syntax

+

There is two uses of begin.

+

(begin expression-or-definition ...)

+

This form of begin can appear as part of a body, or at the outermost level of a program, or at the REPL, or directly nested in a begin that is itself of this form. It causes the contained expressions and definitions to be evaluated exactly as if the enclosing begin construct were not present.

+

TODO: example

+

(begin expression1 expression2 ...)

+

This form of begin can be used as an ordinary expression. The expressions are evaluated sequentially from left to right, and the values of the last expression are returned. This expression type is used to sequence side effects such as assignments or input and output.

+

TODO: example

+

binary-port?

+

TODO: not implemented

+

(boolean=? obj ...)

+

Return #t if the scheme objects passed as arguments are the same boolean. Otherwise it return #f.

+

(boolean? obj)

+

Return #t if OBJ is a boolean. Otherwise #f.

+

(bytevector byte ...)

+

Returns a newly allocated bytevector containing its arguments.

+

(bytevector-append bytevector ...)

+

Returns a newly allocated bytevector whose elements arethe concatenation of the elements in the given bytevectors.

+

(bytevector-copy bytevector [start [end]])

+

Returns a newly allocated bytevector containing the bytes in bytevector between start and end.

+

(bytevector-copy! to at from [start [end]])

+

Copies the bytes of bytevector from between start and end to bytevector TO, starting at at. The order in which bytes are copied is unspecified, except that if the source and destination overlap, copying takes place as if the source is first copied into a temporary bytevector and then into the destination. This can be achieved without allocating storage by making sure to copy in the correct direction in such circumstances.

+

(bytevector-length bytevector)

+

Returns the length of bytevector in bytes as an exact integer.

+

bytevector-u8-ref

+

Returns the Kth byte of BYTEVECTOR. It is an error if K is not a valid index of BYTEVECTOR.

+

bytevector-u8-set!

+

Stores BYTE as the Kth byte of BYTEVECTOR.

+

It is an error if K is not a valid index of BYTEVECTOR.

+

(bytevector? obj)

+

Returns #t if OBJ is a bytevector. Otherwise, #f is returned.

+

caar

+

TODO

+

cadr

+

TODO

+

(call-with-current-continuation proc)

+

It is an error if proc does not accept one argument.

+

The procedure call-with-current-continuation (or its equivalent abbreviation call/cc) packages the current continuation (see the rationale below) as an “escape procedure” and passes it as an argument to proc. The escape procedure is a Scheme procedure that, if it is later called, will abandon whatever continuation is in effect at that later time and will instead use the continuation that was in effect when the escape procedure was created. Calling the escape procedure will cause the invocation of before and after thunks installed using dynamic-wind.

+

The escape procedure accepts the same number of arguments as the continuation to the original call to call-with-current-continuation. Most continuations take only one value. Continuations created by the call-with-values procedure (including the initialization expressions of define-values, let-values, and let-values expressions), take the number of values that the consumer expects. The continuations of all non-final expressions within a sequence of expressions, such as in lambda, case-lambda, begin, let, let, letrec, letrec, let-values, let-values, let-syntax, letrec-syntax, parameterize, guard, case, cond, when, and unless expressions, take an arbitrary number of values because they discard the values passed to them in any event. The effect of passing no values or more than one value to continuations that were not created in one of these ways is unspecified.

+

The escape procedure that is passed to proc has unlimited extent just like any other procedure in Scheme. It can be stored in variables or data structures and can be called as many times as desired. However, like the raise and error procedures, it never returns to its caller.

+

TODO: example

+

(call-with-port port proc)

+

The call-with-port procedure calls PROC with PORT as an argument. If PROC returns, then the PORT is closed automatically and the values yielded by the PROC are returned. If PROC does not return, then the PORT must not be closed automatically unless it is possible to prove that the port will never again be used for a read or write operation.

+

It is an error if PROC does not accept one argument.

+

(call-with-values producer consumer)

+

Calls its producer argument with no arguments and a continuation that, when passed some values, calls the consumer procedure with those values as arguments. The continuation for the call to consumer is the continuation of the call to call-with-values.

+

(call/cc proc)

+

Abbreviation for call-with-continuation.

+

(car pair)

+

Returns the contents of the car field of pair. Note that it is an error to take the car of the empty list.

+

(case <key> <clause1> <clause2> ...) syntax

+

TODO

+

cdar

+

TODO

+

cddr

+

TODO

+

cdr

+

Returns the contents of the cdr field of pair. Note that it is an error to take the cdr of the empty list.

+

(ceiling x)

+

The ceiling procedure returns the smallest integer not smaller than x.

+

(char->integer char)

+

Given a Unicode character, char->integer returns an exact integer between 0 and #xD7FF or between #xE000 and #x10FFFF which is equal to the Unicode scalar value of that character. Given a non-Unicode character, it returns an exact integer greater than #x10FFFF.

+

(char-ready? [port])

+

Returns #t if a character is ready on the textual input port and returns #f otherwise. If char-ready returns #t then the next read-char operation on the given port is guaranteed not to hang. If the port is at end of file then char-ready? returns #t.

+

char<=?

+

TODO

+

char<?

+

TODO

+

char=?

+

TODO

+

char>=?

+

TODO

+

char>?

+

TODO

+

char?

+

Returns #t if obj is a character, otherwise returns #f.

+

(close-input-port port)

+

Closes the resource associated with port, rendering the port incapable of delivering or accepting data.

+

(close-output-port port)

+

Closes the resource associated with port, rendering the port incapable of delivering or accepting data.

+

(close-port port)

+

Closes the resource associated with port, rendering the port incapable of delivering or accepting data.

+

(complex? obj)

+

Returns #t if obj is a complex number, otherwise returns #f.

+

(cond <clause1> ...)

+

TODO

+

cond-expand

+

TODO: not implemented

+

(cons obj1 obj2)

+

Returns a newly allocated pair whose car is obj1 and whose cdr is obj2. The pair is guaranteed to be different (in the sense of eqv?) from every existing object.

+

(current-error-port [port])

+

Returns the current default error port (an output port). That procedure is also a parameter object, which can be overridden with parameterize.

+

(current-input-port [port])

+

Returns the current default input port. That procedure is also a parameter object, which can be overridden with parameterize.

+

current-output-port

+

Returns the current default output port. That procedure is also a parameter object, which can be overridden with parameterize.

+

(define <name> <expr>)

+

TODO

+

(define (<name> <variable> ...) <expr> ...)

+

TODO

+

define-record-type syntax

+

TODO

+

define-syntax

+

TODO

+

(define-values var1 ... expr) syntax

+

creates multiple definitions from a single expression returning multiple values. It is allowed wherever define is allowed.

+

(denominator q)

+

Return the denominator of their argument; the result is computed as if the argument was represented as a fraction in lowest terms. The denominator is always positive. The denominator of 0 is defined to be 1.

+

do

+

TODO

+

(dynamic-wind before thunk after)

+

TODO

+

(eof-object)

+

Returns an end-of-file object, not necessarily unique.

+

(eof-object? obj)

+

Returns #t if obj is an end-of-file object, otherwise returns #f. A end-of-file object will ever be an object that can be read in using read.

+

(eq? obj1 obj2)

+

The eq? procedure is similar to eqv? except that in some cases it is capable of discerning distinctions finer than those detectable by eqv?. It must always return #f when eqv? also would, but may return #f in some cases where eqv? would return #t.

+

On symbols, booleans, the empty list, pairs, and records, and also on non-empty strings, vectors, and bytevectors, eq? and eqv? are guaranteed to have the same behavior. On procedures, eq? must return true if the arguments’ location tags are equal. On numbers and characters, eq?’s behavior is implementation-dependent, but it will always return either true or false. On empty strings, empty vectors, and empty bytevectors, eq? may also behave differently from eqv?.

+

(equal? obj1 obj2)

+

The equal? procedure, when applied to pairs, vectors, strings and bytevectors, recursively compares them, returning #t when the unfoldings of its arguments into (possibly infinite) trees are equal (in the sense of equal?) as ordered trees, and #f otherwise. It returns the same as eqv? when applied to booleans, symbols, numbers, characters, ports, procedures, and the empty list. If two objects are eqv?, they must be equal? as well. In all other cases, equal? may return either #t or #f.

+

Even if its arguments are circular data structures, equal? must always terminate.

+

(eqv? obj1 obj2)

+

The eqv? procedure defines a useful equivalence relation on objects. Briefly, it returns #t if obj1 and obj2 are normally regarded as the same object.

+

TODO: complete based on r7rs small and guile.

+

(error [who] message . irritants)

+

Raises an exception as if by calling raise on a newly allocated implementation-defined object which encapsulates the information provided by message, as well as any objs, known as the irritants. The procedure error-object? must return #t on such objects.

+

(error-object-irritants error)

+

Returns a list of the irritants encapsulated by error.

+

(error-object-message error)

+

Returns the message encapsulated by error.

+

(error-object? obj)

+

Returns #t if obj is an object created by error or one of an implementation-defined set of objects. Otherwise, it returns #f. The objects used to signal errors, including those which satisfy the predicates file-error? and read-error?, may or may not satisfy error-object?.

+

(even? number)

+

Return #t if NUMBER is even. Otherwise #f.

+

(exact z)

+

TODO: FIXME

+

The procedure exact returns an exact representation of z. The value returned is the exact number that is numerically closest to the argument. For exact arguments, the result is the same as the argument. For inexact non-integral real arguments, the implementation may return a rational approximation, or may report an implementation violation. For inexact complex arguments, the result is a complex number whose real and imaginary parts are the result of applying exact to the real and imaginary parts of the argument, respectively. If an inexact argument has no reasonably close exact equivalent, (in the sense of =), then a violation of an implementation restriction may be reported.

+

(exact-integer-sqrt k)

+

TODO

+

(exact-integer? z)

+

Returns #t if z is both exact and an integer; otherwise returns #f.

+

(exact? z)

+

Return #t if Z is exact. Otherwise #f.

+

(expt z1 z2)

+

Returns z1 raised to the power z2.

+

features

+

TODO: no implemented

+

(file-error? error)

+

TODO: not implemented?

+

(floor x)

+

The floor procedure returns the largest integer not larger than x.

+

floor-quotient

+

TODO

+

floor-remainder

+

TODO

+

floor/

+

TODO

+

(flush-output-port [port])

+

Flushes any buffered output from the buffer of output-port to the underlying file or device and returns an unspecified value.

+

(for-each proc list1 ...)

+

It is an error if proc does not accept as many arguments as there are lists.

+

The arguments to for-each are like the arguments to map, but for-each calls proc for its side effects rather than for its values. Unlike map, for-each is guaranteed to call proc on the elements of the lists in order from the first element(s) to the last, and the value returned by for-each is unspecified. If more than one list is given and not all lists have the same length, for-each terminates when the shortest list runs out. The lists can be circular, but it is an error if all of them are circular.

+

(gcd n1 ...)

+

Return the greatest common divisor.

+

(get-output-bytevector port)

+

It is an error if port was not created with open-output-bytevector.

+

Returns a bytevector consisting of the bytes that have been output to the port so far in the order they were output.

+

(get-output-string port)

+

It is an error if port was not created with open-output-string.

+

Returns a string consisting of the characters that have been output to the port so far in the order they were output.

+

(guard <clause> ...) syntax

+

TODO

+

(if <expr> <then> [<else>])

+

TODO

+

include

+

TODO

+

include-ci

+

TODO: not implemented

+

(inexact z)

+

The procedure inexact returns an inexact representation of z. The value returned is the inexact number that is numerically closest to the argument. For inexact arguments, the result is the same as the argument. For exact complex numbers, the result is a complex number whose real and imaginary parts are the result of applying inexact to the real and imaginary parts of the argument, respectively. If an exact argument has no reasonably close inexact equivalent (in the sense of =), then a violation of an implementation restriction may be reported.

+

(inexact? z)

+

Return #t if Z is inexact. Otherwise #f.

+

(input-port-open? port)

+

Returns #t if port is still open and capable of performing input, and #f otherwise.

+

(input-port? obj)

+

Return #t if obj is an input port. Otherwise it return #f.

+

(integer->char integer)

+

Given an exact integer that is the value returned by a character when char->integer is applied to it, integer->char returns that character.

+

(integer? obj)

+

Return #t if OBJ is an integer. Otherwise #f.

+

(lambda <formals> <expr> ...)

+

TODO

+

(lcm n1 ...)

+

Return the least common multiple of its arguments.

+

(length list)

+

Returns the length of list.

+

let

+

TODO

+

let*

+

TODO

+

let*-values

+

TODO

+

let-syntax

+

TODO

+

let-values

+

TODO

+

letrec

+

TODO

+

letrec*

+

TODO

+

letrec-syntax

+

TODO

+

(list obj ...)

+

Returns a newly allocated list of its arguments.

+

(list->string list)

+

It is an error if any element of list is not a character.

+

list->string returns a newly allocated string formed from the elements in the list list.

+

(list->vector list)

+

The list->vector procedure returns a newly created vector initialized to the elements of the list list.

+

(list-copy obj)

+

Returns a newly allocated copy of the given obj if it is a list. Only the pairs themselves are copied; the cars of the result are the same (in the sense of eqv?) as the cars of list. If obj is an improper list, so is the result, and the final cdrs are the same in the sense of eqv?. An obj which is not a list is returned unchanged. It is an error if obj is a circular list.

+

(list-ref list k)

+

The list argument can be circular, but it is an error if list has fewer than k elements.

+

Returns the kth element of list. (This is the same as the car of (list-tail list k).)

+

(list-set! list k obj)

+

It is an error if k is not a valid index of list.

+

The list-set! procedure stores obj in element k of list.

+

(list-tail list k)

+

It is an error if list has fewer than k elements.

+

Returns the sublist of list obtained by omitting the first k elements.

+

(list? obj)

+

Return #t if OBJ is a list. Otherwise #f.

+

(make-bytevector k [byte])

+

The make-bytevector procedure returns a newly allocated bytevector of length k. If byte is given, then all elements of the bytevector are initialized to byte, otherwise the contents of each element are unspecified.

+

(make-list k [fill])

+

Returns a newly allocated list of k elements. If a second argument is given, then each element is initialized to fill. Otherwise the initial contents of each element is unspecified.

+

(make-parameter init [converter])

+

Returns a newly allocated parameter object, which is a procedure that accepts zero arguments and returns the value associated with the parameter object. Initially, this value is the value of (converter init), or of init if the conversion procedure converter is not specified. The associated value can be temporarily changed using parameterize, which is described below.

+

(make-string k [char])

+

The make-string procedure returns a newly allocated string of length k. If char is given, then all the characters of the string are initialized to char, otherwise the contents of the string are unspecified.

+

(make-vector k [fill])

+

Returns a newly allocated vector of k elements. If a second argument is given, then each element is initialized to fill. Otherwise the initial contents of each element is unspecified.

+

(map proc list1 ...)

+

It is an error if proc does not accept as many arguments as there are lists and return a single value.

+

The map procedure applies proc element-wise to the elements of the lists and returns a list of the results, in order. If more than one list is given and not all lists have the same length, map terminates when the shortest list runs out. The lists can be circular, but it is an error if all of them are circular. It is an error for proc to mutate any of the lists. The dynamic order in which proc is applied to the elements of the lists is unspecified. If multiple returns occur from map, the values returned by earlier returns are not mutated.

+

(max x1 ...)

+

Return the maximum of its arguments.

+

(member obj list [compare])

+

Return the first sublist of list whose car is obj, where the sublists of list are the non-empty lists returned by (list-tail list k) for k less than the length of list. If obj does not occur in list, then #f (not the empty list) is returned.

+

Uses compare, if given, and equal? otherwise.

+

(memq obj list)

+

Return the first sublist of list whose car is obj, where the sublists of list are the non-empty lists returned by (list-tail list k) for k less than the length of list. If obj does not occur in list, then #f (not the empty list) is returned.

+

Use eq? for comparison.

+

(memv obj list)

+

Return the first sublist of list whose car is obj, where the sublists of list are the non-empty lists returned by (list-tail list k) for k less than the length of list. If obj does not occur in list, then #f (not the empty list) is returned.

+

Uses eqv? for comparison.

+

(min x1 ...)

+

Return the minimum of its arguments.

+

(modulo n1 n2)

+

modulo is equivalent to floor-remainder. Provided for backward compatibility.

+

(negative? x)

+

Return #t if X is negative. Otherwise #f.

+

(newline [port])

+

Writes an end of line to output port.

+

(not obj)

+

The not procedure returns #t if obj is false, and returns #f otherwise.

+

(null? obj)

+

Returns #t if obj is the empty list, otherwise returns #f.

+

(number->string z [radix])

+

It is an error if radix is not one of 2, 8, 10, or 16.

+

(number? obj)

+

Return #t if OBJ is a number. Otherwise #f.

+

(numerator q)

+

TODO

+

(odd? number)

+

Return #t if NUMBER is odd. Otherwise #f.

+

(open-input-bytevector bytevector)

+

Takes a bytevector and returns a binary input port that delivers bytes from the bytevector.

+

(open-input-string string)

+

Takes a string and returns a textual input port that delivers characters from the string. If the string is modified, the effect is unspecified.

+

(open-output-bytevector)

+

Returns a binary output port that will accumulate bytes for retrieval by get-output-bytevector.

+

(open-output-string)

+

Returns a textual output port that will accumulate characters for retrieval by get-output-string.

+

(or test1 ...) syntax

+

The test expressions are evaluated from left to right, and the value of the first expression that evaluates to a true value is returned. Any remaining expressions are not evaluated. If all expressions evaluate to #f or if there are no expressions, then #f is returned.

+

(output-port-open? port)

+

Returns #t if port is still open and capable of performing output, and #f otherwise.

+

(output-port? obj)

+

Return #t if obj is an output port. Otherwise return #f.

+

(pair? obj)

+

The pair? predicate returns #t if obj is a pair, and otherwise returns #f.

+

(parameterize ((param1 value1) ...) expr ...)

+

A parameterize expression is used to change the values returned by specified parameter objects during the evaluation of the body.

+

The param and value expressions are evaluated in an unspecified order. The body is evaluated in a dynamic environment in which calls to the parameters return the results of passing the corresponding values to the conversion procedure specified when the parameters were created. Then the previous values of the parameters are restored without passing them to the conversion procedure. The results of the last expression in the body are returned as the results of the entire parameterize expression.

+

Note: If the conversion procedure is not idempotent, the results of (parameterize ((x (x))) …), which appears to bind the parameter x to its current value, might not be what the user expects.

+

If an implementation supports multiple threads of execution, then parameterize must not change the associated values of any parameters in any thread other than the current thread and threads created inside body.

+

Parameter objects can be used to specify configurable settings for a computation without the need to pass the value to every procedure in the call chain explicitly.

+

(peek-char [port])

+

Returns the next character available from the textual input port, but without updating the port to point to the following character. If no more characters are available, an end-of-file object is returned.

+

Note: The value returned by a call to peek-char is the same as the value that would have been returned by a call to read-char with the same port. The only difference is that the very next call to read-char or peek-char on that port will return the value returned by the preceding call to peek-char. In particular, a call to peek-char on an interactive port will hang waiting for input whenever a call to read-char would have hung.

+

(peek-u8 [port])

+

Returns the next byte available from the binary input port, but without updating the port to point to the following byte. If no more bytes are available, an end-of-file object is returned.

+

(port? obj)

+

Return #t if OBJ is port. Otherwise #f.

+

(positive? x)

+

Return #t if X is positive. Otherwise #f.

+

(procedure? obj)

+

Return #t if OBJ is a procedure. Otherwise #f.

+

quasiquote

+

TODO

+

quote

+

TODO

+

quotient

+

TODO

+

(raise obj)

+

Raises an exception by invoking the current exception handler on obj. The handler is called with the same dynamic environment as that of the call to raise, except that the current exception handler is the one that was in place when the handler being called was installed. If the handler returns, a secondary exception is raised in the same dynamic environment as the handler. The relationship between obj and the object raised by the secondary exception is unspecified.

+

(raise-continuable obj)

+

Raises an exception by invoking the current exception handler on obj. The handler is called with the same dynamic environment as the call to raise-continuable, except that: (1) the current exception handler is the one that was in place when the handler being called was installed, and (2) if the handler being called returns, then it will again become the current exception handler. If the handler returns, the values it returns become the values returned by the call to raise-continuable.

+

(rational? obj)

+

Return #t if OBJ is a rational number. Otherwise #f.

+

(rationalize x y)

+

The rationalize procedure returns the simplest rational number differing from x by no more than y.

+

(read-bytevector k [port])

+

Reads the next k bytes, or as many as are available before the end of file, from the binary input port into a newly allocated bytevector in left-to-right order and returns the bytevector. If no bytes are available before the end of file, an end-of-file object is returned.

+

(read-bytevector! bytevector [port [start [end]]])

+

Reads the next end - start bytes, or as many as are available before the end of file, from the binary input port into bytevector in left-to-right order beginning at the start position. If end is not supplied, reads until the end of bytevector has been reached. If start is not supplied, reads beginning at position 0. Returns the number of bytes read. If no bytes are available, an end-of-file object is returned.

+

(read-char [port])

+

Returns the next character available from the textual input port, updating the port to point to the following character. If no more characters are available, an end-of-file object is returned.

+

(read-error? obj)

+

Error type predicates. Returns #t if obj is an object raised by the read procedure. Otherwise, it returns #f.

+

(read-line [port])

+

Returns the next line of text available from the textual input port, updating the port to point to the following character. If an end of line is read, a string containing all of the text up to (but not including) the end of line is returned, and the port is updated to point just past the end of line. If an end of file is encountered before any end of line is read, but some characters have been read, a string containing those characters is returned. If an end of file is encountered before any characters are read, an end-of-file object is returned. For the purpose of this procedure, an end of line consists of either a linefeed character, a carriage return character, or a sequence of a carriage return character followed by a linefeed character. Implementations may also recognize other end of line characters or sequences.

+

(read-string k [port])

+

Reads the next k characters, or as many as are available before the end of file, from the textual input port into a newly allocated string in left-to-right order and returns the string. If no characters are available before the end of file, an end-of-file object is returned.

+

(read-u8 [port])

+

Returns the next byte available from the binary input port, updating the port to point to the following byte. If no more bytes are available, an end-of-file object is returned.

+

(real? obj)

+

Return #t if OBJ is real number. Otherwise #f.

+

(remainder n1 n2)

+

TODO

+

(reverse list)

+

Returns a newly allocated list consisting of the elements of list in reverse order.

+

(round x)

+

TODO

+

(set! <variable> <expression>) syntax

+

Expression is evaluated, and the resulting value is stored in the location to which variable is bound. It is an error if variable is not bound either in some region enclosing the set! expression or else globally. The result of the set! expression is unspecified.

+

(set-car! pair obj)

+

Stores obj in the car field of pair.

+

(set-cdr! pair obj)

+

Stores obj in the cdr field of pair.

+

(square z)

+

Returns the square of z. This is equivalent to (* z z).

+

(string char ...)

+

Returns a newly allocated string composed of the arguments. It is analogous to list.

+

(string->list string [start [end]])

+

The string->list procedure returns a newly allocated list of the characters of string between start and end.

+

(string->number string [radix])

+

Returns a number of the maximally precise representation expressed by the given string. It is an error if radix is not 2, 8, 10, or 16.

+

If supplied, radix is a default radix that will be overridden if an explicit radix prefix is present in string (e.g. “#o177”). If radix is not supplied, then the default radix is 10. If string is not a syntactically valid notation for a number, or would result in a number that the implementation cannot represent, then string->number returns #f. An error is never signaled due to the content of string.

+

(string->symbol string)

+

Returns the symbol whose name is string. This procedure can create symbols with names containing special characters that would require escaping when written, but does not interpret escapes in its input.

+

(string->utf8 string [start [end]])

+

The string->utf8 procedure encodes the characters of a string between start and end and returns the corresponding bytevector.

+

(string->vector string [start [end]])

+

The string->vector procedure returns a newly created vector initialized to the elements of the string string between start and end.

+

(string-append string ...)

+

Returns a newly allocated string whose characters are the concatenation of the characters in the given strings.

+

(string-copy string [start [end]])

+

Returns a newly allocated copy of the part of the given string between start and end.

+

(string-copy! to at from [start [end]])

+

It is an error if at is less than zero or greater than the length of to. It is also an error if (- (string-length to) at) is less than (- end start).

+

Copies the characters of string from between start and end to string to, starting at at. The order in which characters are copied is unspecified, except that if the source and destination overlap, copying takes place as if the source is first copied into a temporary string and then into the destination. This can be achieved without allocating storage by making sure to copy in the correct direction in such circumstances.

+

(string-fill! string fill [start [end]])

+

It is an error if fill is not a character.

+

The string-fill! procedure stores fill in the elements of string between start and end.

+

(string-for-each proc string1 ...)

+

It is an error if proc does not accept as many arguments as there are strings.

+

The arguments to string-for-each are like the arguments to string-map, but string-for-each calls proc for its side effects rather than for its values. Unlike string-map, string-for-each is guaranteed to call proc on the elements of the lists in order from the first element(s) to the last, and the value returned by string-for-each is unspecified. If more than one string is given and not all strings have the same length, string-for-each terminates when the shortest string runs out. It is an error for proc to mutate any of the strings.

+

(string-length string)

+

Returns the number of characters in the given string.

+

(string-map proc string1 ...)

+

It is an error if proc does not accept as many arguments as there are strings and return a single character.

+

The string-map procedure applies proc element-wise to the elements of the strings and returns a string of the results, in order. If more than one string is given and not all strings have the same length, string-map terminates when the shortest string runs out. The dynamic order in which proc is applied to the elements of the strings is unspecified. If multiple returns occur from string-map, the values returned by earlier returns are not mutated.

+

(string-ref string k)

+

It is an error if k is not a valid index of string.

+

The string-ref procedure returns character k of string using zero-origin indexing. There is no requirement for this procedure to execute in constant time.

+

(string-set! string k char)

+

It is an error if k is not a valid index of string.

+

The string-set! procedure stores char in element k of string. There is no requirement for this procedure to execute in constant time.

+

string<=?

+

TODO

+

string<?

+

TODO

+

(string=? string1 string2 ...)

+

Returns #t if all the strings are the same length and contain exactly the same characters in the same positions, otherwise returns #f.

+

string>=?

+

TODO

+

string>?

+

TODO

+

(string? obj)

+

Return #t if OBJ is string. Otherwise #f.

+

(substring string start end)

+

The substring procedure returns a newly allocated string formed from the characters of string beginning with index start and ending with index end. This is equivalent to calling string-copy with the same arguments, but is provided for backward compatibility and stylistic flexibility.

+

(symbol->string symbol)

+

Returns the name of symbol as a string, but without adding escapes. It is an error to apply mutation procedures like string-set! to strings returned by this procedure.

+

(symbol=? symbol1 symbol2 ...)

+

Returns #t if all the arguments are symbols and all have the same names in the sense of string=?.

+

(symbol? obj)

+

Returns #t if obj is a symbol, otherwise returns #f.

+

syntax-error

+

TODO

+

syntax-rules

+

TODO

+

textual-port?

+

TODO

+

(truncate x)

+

TODO

+

truncate-quotient

+

TODO

+

truncate-remainder

+

TODO

+

truncate/

+

TODO

+

(u8-ready? [port])

+

Returns #t if a byte is ready on the binary input port and returns #f otherwise. If u8-ready? returns #t then the next read-u8 operation on the given port is guaranteed not to hang. If the port is at end of file then u8-ready? returns #t.

+

(unless <test> <expr> ...) syntax

+

The test is evaluated, and if it evaluates to #f, the expressions are evaluated in order. The result of the unless expression is unspecified.

+

unquote

+

TODO

+

unquote-splicing

+

TODO

+

(utf8->string bytevector [start [end]])

+

It is an error for bytevector to contain invalid UTF-8 byte sequences.

+

The utf8->string procedure decodes the bytes of a bytevector between start and end and returns the corresponding string.

+

(values obj ...)

+

Delivers all of its arguments to its continuation.

+

(vector obj ...)

+

Returns a newly allocated vector whose elements contain the given arguments. It is analogous to list.

+

(vector->list vector [start [end]])

+

The vector->list procedure returns a newly allocated list of the objects contained in the elements of vector between start and end. The list->vector procedure returns a newly created vector initialized to the elements of the list list.

+

(vector->string vector [start [end]])

+

It is an error if any element of vector between start and end is not a character.

+

The vector->string procedure returns a newly allocated string of the objects contained in the elements of vector between start and end. The string->vector procedure returns a newly created vector initialized to the elements of the string string between start and end.

+

(vector-append vector ...)

+

Returns a newly allocated vector whose elements are the concatenation of the elements of the given vectors.

+

(vector-copy vector [start [end]])

+

Returns a newly allocated copy of the elements of the given vector between start and end. The elements of the new vector are the same (in the sense of eqv?) as the elements of the old.

+

(vector-copy! to at from [start [end]])

+

It is an error if at is less than zero or greater than the length of to. It is also an error if (- (vector-length to) at) is less than (- end start).

+

Copies the elements of vector from between start and end to vector to, starting at at. The order in which elements are copied is unspecified, except that if the source and destination overlap, copying takes place as if the source is first copied into a temporary vector and then into the destination. This can be achieved without allocating storage by making sure to copy in the correct direction in such circumstances.

+

(vector-fill! vector fill [start [end]])

+

The vector-fill! procedure stores fill in the elements of vector between start and end.

+

(vector-for-each proc vector1 ...)

+

It is an error if proc does not accept as many arguments as there are vectors.

+

The arguments to vector-for-each are like the arguments to vector-map, but vector-for-each calls proc for its side effects rather than for its values. Unlike vector-map, vector-for-each is guaranteed to call proc on the elements of the vectors in order from the first element(s) to the last, and the value returned by vector-for-each is unspecified. If more than one vector is given and not all vectors have the same length, vector-for-each terminates when the shortest vector runs out. It is an error for proc to mutate any of the vectors.

+

(vector-length vector)

+

Returns the number of elements in vector as an exact integer.

+

(vector-map proc vector1 ...)

+

It is an error if proc does not accept as many arguments as there are vectors and return a single value.

+

The vector-map procedure applies proc element-wise to the elements of the vectors and returns a vector of the results, in order. If more than one vector is given and not all vectors have the same length, vector-map terminates when the shortest vector runs out. The dynamic order in which proc is applied to the elements of the vectors is unspecified. If multiple returns occur from vector-map, the values returned by earlier returns are not mutated.

+

(vector-ref vector k)

+

It is an error if k is not a valid index of vector.

+

The vector-ref procedure returns the contents of element k of vector.

+

(vector-set! vector k obj)

+

It is an error if k is not a valid index of vector.

+

The vector-set! procedure stores obj in element k of vector.

+

vector?

+

Returns #t if obj is a bytevector. Otherwise, #f is returned.

+

(when <test> <expr> ...) syntax

+

The test is evaluated, and if it evaluates to a true value, the expressions are evaluated in order. The result of the when expression is unspecified.

+

with-exception-handler

+

TODO

+

(write-bytevector bytevector [port [start [end]]])

+

Writes the bytes of bytevector from start to end in left-to-right order to the binary output port.

+

(write-char char [port])

+

Writes the character char (not an external representation of the character) to the given textual output port and returns an unspecified value.

+

(write-string string [port [start [end]]])

+

Writes the characters of string from start to end in left-to-right order to the textual output port.

+

(write-u8 byte [port])

+

Writes the byte to the given binary output port and returns an unspecified value.

+

(zero? z)

+

Return #t if z is zero. Otherwise #f.

+ + diff --git a/live/unstable/index.md b/live/unstable/index.md new file mode 100644 index 0000000..910660f --- /dev/null +++ b/live/unstable/index.md @@ -0,0 +1,1404 @@ +# `(live unstable)` + +## `(pk object ...)` + +Print `object ...` to standard error output and return the last +object. + +## `(assume expr message)` syntax + +Non-standard assert macro that immediatly exit the program with code +`255` if `expr` evalutes to false, and display to the standard error +output `message`. Otherwise, if `expr` evalutes to a truthy value +returns that value. + +Note: it is based on [SRFI-145](https://srfi.schemers.org/srfi-145/) + +## `(* number ...)` + +Multiplication procedure. + +## `(+ number ...)` + +Addition procedure. + +## `(- number ...)` + +Substraction procedure. + +## `(/ number ...)` + +Division procedure. Raise `'numerical-overflow` condition in case +where denominator is zero. + +## `(< number number ...)` + +Less than procedure. Return a boolean. + +## `(<= number number ...)` + +Less than or equal procedure. Return a boolean. + +## `(= number number ...)` + +Return `#t` if the numbers passed as parameters are equal. And `#f` otherwise. + +## `(> number number ...)` + +Greater than procedure. Return a boolean. + +## `(>= number number ...)` + +Greater than or equal. Return a boolean. + +## `(abs number)` + +Return the absolute value of `NUMBER`. + +## `(and test1 ...)` + +The `test` expressions are evaluated from left to right, and if any +expression evaluates to `#f`, then `#f` is returned. Any remaining +expressions are not evaluated. If all the expressions evaluate to +true values, the values of the last expression are returned. If there +are no expressions, then `#t` is returned. + +## `(append lst ...)` + +Return the list made of the list passed as parameters in the same +order. + +## `(apply proc arg1 ... args)` + +The apply procedure calls proc with the elements of the list `(append +(list arg1 ...) args)` as the actual arguments. + +## `(assoc obj alist)` + +Return the first pair which `car` is equal to `OBJ` according to the +predicate `equal?`. Or it returns `#f`. + +## `(assq obj alist)` + +Return the first pair which `car` is equal to `OBJ` according to the +predicate `eq?`. Or it returns `#f`. + +## `(assv obj alist)` + +Return the first pair which `car` is equal to `OBJ` according to the +predicate `eqv?`. Or it returns `#f`. + +## `begin` syntax + +There is two uses of `begin`. + +### `(begin expression-or-definition ...)` + +This form of begin can appear as part of a body, or at the outermost +level of a program, or at the REPL, or directly nested in a begin that +is itself of this form. It causes the contained expressions and +definitions to be evaluated exactly as if the enclosing begin +construct were not present. + +TODO: example + +### `(begin expression1 expression2 ...)` + +This form of begin can be used as an ordinary expression. The +expressions are evaluated sequentially from left to right, and the +values of the last expression are returned. This expression type is +used to sequence side effects such as assignments or input and output. + +TODO: example + +## `binary-port?` + +TODO: not implemented + +## `(boolean=? obj ...)` + +Return `#t` if the scheme objects passed as arguments are the same +boolean. Otherwise it return `#f`. + +## `(boolean? obj)` + +Return `#t` if `OBJ` is a boolean. Otherwise `#f`. + +## `(bytevector byte ...)` + +Returns a newly allocated bytevector containing its arguments. + +## `(bytevector-append bytevector ...)` + +Returns a newly allocated bytevector whose elements arethe +concatenation of the elements in the given bytevectors. + +## `(bytevector-copy bytevector [start [end]])` + +Returns a newly allocated bytevector containing the bytes in +bytevector between start and end. + +## `(bytevector-copy! to at from [start [end]])` + +Copies the bytes of bytevector `from` between `start` and `end` to +bytevector `TO`, starting at `at`. The order in which bytes are +copied is unspecified, except that if the source and destination +overlap, copying takes place as if the source is first copied into a +temporary bytevector and then into the destination. This can be +achieved without allocating storage by making sure to copy in the +correct direction in such circumstances. + +## `(bytevector-length bytevector)` + +Returns the length of bytevector in bytes as an exact integer. + +## `bytevector-u8-ref` + +Returns the `K`th byte of `BYTEVECTOR`. It is an error if `K` is not a valid index of `BYTEVECTOR`. + +## `bytevector-u8-set!` + +Stores `BYTE` as the `K`th byte of `BYTEVECTOR`. + +It is an error if `K` is not a valid index of `BYTEVECTOR`. + +## `(bytevector? obj)` + +Returns `#t` if `OBJ` is a bytevector. Otherwise, `#f` is returned. + +## `caar` + +TODO + +## `cadr` + +TODO + +## `(call-with-current-continuation proc)` + +It is an error if proc does not accept one argument. + +The procedure call-with-current-continuation (or its equivalent +abbreviation call/cc) packages the current continuation (see the +rationale below) as an “escape procedure” and passes it as an argument +to proc. The escape procedure is a Scheme procedure that, if it is +later called, will abandon whatever continuation is in effect at that +later time and will instead use the continuation that was in effect +when the escape procedure was created. Calling the escape procedure +will cause the invocation of before and after thunks installed using +dynamic-wind. + +The escape procedure accepts the same number of arguments as the +continuation to the original call to +call-with-current-continuation. Most continuations take only one +value. Continuations created by the call-with-values procedure +(including the initialization expressions of define-values, +let-values, and let*-values expressions), take the number of values +that the consumer expects. The continuations of all non-final +expressions within a sequence of expressions, such as in lambda, +case-lambda, begin, let, let*, letrec, letrec*, let-values, +let*-values, let-syntax, letrec-syntax, parameterize, guard, case, +cond, when, and unless expressions, take an arbitrary number of values +because they discard the values passed to them in any event. The +effect of passing no values or more than one value to continuations +that were not created in one of these ways is unspecified. + +The escape procedure that is passed to proc has unlimited extent just +like any other procedure in Scheme. It can be stored in variables or +data structures and can be called as many times as desired. However, +like the raise and error procedures, it never returns to its caller. + +TODO: example + +## `(call-with-port port proc)` + +The `call-with-port` procedure calls `PROC` with `PORT` as an +argument. If `PROC` returns, then the `PORT` is closed automatically +and the values yielded by the `PROC` are returned. If `PROC` does not +return, then the `PORT` must not be closed automatically unless it is +possible to prove that the port will never again be used for a read or +write operation. + +It is an error if `PROC` does not accept one argument. + +## `(call-with-values producer consumer)` + +Calls its producer argument with no arguments and a continuation that, +when passed some values, calls the consumer procedure with those +values as arguments. The continuation for the call to consumer is the +continuation of the call to `call-with-values`. + +## `(call/cc proc)` + +Abbreviation for `call-with-continuation`. + +## `(car pair)` + +Returns the contents of the car field of pair. Note that it is an +error to take the `car` of the empty list. + +## `(case ...)` syntax + +TODO + +## `cdar` + +TODO + +## `cddr` + +TODO + +## `cdr` + +Returns the contents of the `cdr` field of pair. Note that it is an +error to take the `cdr` of the empty list. + +## `(ceiling x)` + +The ceiling procedure returns the smallest integer not smaller than x. + +## `(char->integer char)` + +Given a Unicode character, `char->integer` returns an exact integer +between 0 and #xD7FF or between #xE000 and #x10FFFF which is equal to +the Unicode scalar value of that character. Given a non-Unicode +character, it returns an exact integer greater than #x10FFFF. + +## `(char-ready? [port])` + +Returns #t if a character is ready on the textual input port and +returns #f otherwise. If char-ready returns #t then the next read-char +operation on the given port is guaranteed not to hang. If the port is +at end of file then char-ready? returns #t. + +## `char<=?` + +TODO + +## `char=?` + +TODO + +## `char>?` + +TODO + +## `char?` + +Returns #t if obj is a character, otherwise returns #f. + +## `(close-input-port port)` + +Closes the resource associated with port, rendering the port incapable +of delivering or accepting data. + +## `(close-output-port port)` + +Closes the resource associated with port, rendering the port incapable +of delivering or accepting data. + +## `(close-port port)` + +Closes the resource associated with port, rendering the port incapable +of delivering or accepting data. + +## `(complex? obj)` + +Returns #t if obj is a complex number, otherwise returns #f. + +## `(cond ...)` + +TODO + +## `cond-expand` + +TODO: not implemented + +## `(cons obj1 obj2)` + +Returns a newly allocated pair whose car is obj1 and whose cdr is +obj2. The pair is guaranteed to be different (in the sense of eqv?) +from every existing object. + +## `(current-error-port [port])` + +Returns the current default error port (an output port). That +procedure is also a parameter object, which can be overridden with +`parameterize`. + +## `(current-input-port [port])` + +Returns the current default input port. That procedure is also a +parameter object, which can be overridden with `parameterize`. + +## `current-output-port` + +Returns the current default output port. That procedure is also a +parameter object, which can be overridden with `parameterize`. + +## `(define )` + +TODO + +## `(define ( ...) ...)` + +TODO + +## `define-record-type` syntax + +TODO + +## `define-syntax` + +TODO + +## `(define-values var1 ... expr)` syntax + +creates multiple definitions from a single expression returning +multiple values. It is allowed wherever define is allowed. + +## `(denominator q)` + +Return the denominator of their argument; the result is computed as if +the argument was represented as a fraction in lowest terms. The +denominator is always positive. The denominator of 0 is defined to be +1. + +## `do` + +TODO + +## `(dynamic-wind before thunk after)` + +TODO + +## `(eof-object)` + +Returns an end-of-file object, not necessarily unique. + +## `(eof-object? obj)` + +Returns #t if obj is an end-of-file object, otherwise returns #f. A +end-of-file object will ever be an object that can be read in using +read. + +## `(eq? obj1 obj2)` + +The eq? procedure is similar to eqv? except that in some cases it is +capable of discerning distinctions finer than those detectable by +eqv?. It must always return #f when eqv? also would, but may return #f +in some cases where eqv? would return #t. + +On symbols, booleans, the empty list, pairs, and records, and also on +non-empty strings, vectors, and bytevectors, eq? and eqv? are +guaranteed to have the same behavior. On procedures, eq? must return +true if the arguments’ location tags are equal. On numbers and +characters, eq?’s behavior is implementation-dependent, but it will +always return either true or false. On empty strings, empty vectors, +and empty bytevectors, eq? may also behave differently from eqv?. + +## `(equal? obj1 obj2)` + +The equal? procedure, when applied to pairs, vectors, strings and +bytevectors, recursively compares them, returning #t when the +unfoldings of its arguments into (possibly infinite) trees are equal +(in the sense of equal?) as ordered trees, and #f otherwise. It +returns the same as eqv? when applied to booleans, symbols, numbers, +characters, ports, procedures, and the empty list. If two objects are +eqv?, they must be equal? as well. In all other cases, equal? may +return either #t or #f. + +Even if its arguments are circular data structures, equal? must always +terminate. + +## `(eqv? obj1 obj2)` + +The eqv? procedure defines a useful equivalence relation on +objects. Briefly, it returns #t if obj1 and obj2 are normally regarded +as the same object. + +TODO: complete based on r7rs small and guile. + +## `(error [who] message . irritants)` + +Raises an exception as if by calling raise on a newly allocated +implementation-defined object which encapsulates the information +provided by message, as well as any objs, known as the irritants. The +procedure error-object? must return #t on such objects. + +## `(error-object-irritants error)` + +Returns a list of the irritants encapsulated by error. + +## `(error-object-message error)` + +Returns the message encapsulated by error. + +## `(error-object? obj)` + +Returns #t if obj is an object created by `error` or one of an +implementation-defined set of objects. Otherwise, it returns #f. The +objects used to signal errors, including those which satisfy the +predicates `file-error?` and `read-error?`, may or may not satisfy +`error-object?`. + +## `(even? number)` + +Return `#t` if `NUMBER` is even. Otherwise `#f`. + +## `(exact z)` + +TODO: FIXME + +The procedure exact returns an exact representation of z. The value +returned is the exact number that is numerically closest to the +argument. For exact arguments, the result is the same as the +argument. For inexact non-integral real arguments, the implementation +may return a rational approximation, or may report an implementation +violation. For inexact complex arguments, the result is a complex +number whose real and imaginary parts are the result of applying exact +to the real and imaginary parts of the argument, respectively. If an +inexact argument has no reasonably close exact equivalent, (in the +sense of `=`), then a violation of an implementation restriction may +be reported. + +## `(exact-integer-sqrt k)` + +TODO + +## `(exact-integer? z)` + +Returns #t if z is both exact and an integer; otherwise returns #f. + +## `(exact? z)` + +Return `#t` if `Z` is exact. Otherwise `#f`. + +## `(expt z1 z2)` + +Returns `z1` raised to the power `z2`. + +## `features` + +TODO: no implemented + +## `(file-error? error)` + +TODO: not implemented? + +## `(floor x)` + +The floor procedure returns the largest integer not larger than x. + +## `floor-quotient` + +TODO + +## `floor-remainder` + +TODO + +## `floor/` + +TODO + +## `(flush-output-port [port])` + +Flushes any buffered output from the buffer of output-port to the +underlying file or device and returns an unspecified value. + +## `(for-each proc list1 ...)` + +It is an error if proc does not accept as many arguments as there are +lists. + +The arguments to for-each are like the arguments to map, but for-each +calls proc for its side effects rather than for its values. Unlike +map, for-each is guaranteed to call proc on the elements of the lists +in order from the first element(s) to the last, and the value returned +by for-each is unspecified. If more than one list is given and not all +lists have the same length, for-each terminates when the shortest list +runs out. The lists can be circular, but it is an error if all of them +are circular. + +## `(gcd n1 ...)` + +Return the greatest common divisor. + +## `(get-output-bytevector port)` + +It is an error if port was not created with `open-output-bytevector`. + +Returns a bytevector consisting of the bytes that have been output to +the port so far in the order they were output. + +## `(get-output-string port)` + +It is an error if port was not created with open-output-string. + +Returns a string consisting of the characters that have been output to +the port so far in the order they were output. + +## `(guard ...)` syntax + +TODO + +## `(if [])` + +TODO + +## `include` + +TODO + +## `include-ci` + +TODO: not implemented + +## `(inexact z)` + +The procedure inexact returns an inexact representation of z. The +value returned is the inexact number that is numerically closest to +the argument. For inexact arguments, the result is the same as the +argument. For exact complex numbers, the result is a complex number +whose real and imaginary parts are the result of applying inexact to +the real and imaginary parts of the argument, respectively. If an +exact argument has no reasonably close inexact equivalent (in the +sense of `=`), then a violation of an implementation restriction may +be reported. + +## `(inexact? z)` + +Return `#t` if `Z` is inexact. Otherwise `#f`. + +## `(input-port-open? port)` + +Returns #t if port is still open and capable of performing input, and +`#f` otherwise. + +## `(input-port? obj)` + +Return `#t` if obj is an input port. Otherwise it return `#f`. + +## `(integer->char integer)` + +Given an exact integer that is the value returned by a character when +char->integer is applied to it, integer->char returns that character. + +## `(integer? obj)` + +Return `#t` if `OBJ` is an integer. Otherwise `#f`. + +## `(lambda ...)` + +TODO + +## `(lcm n1 ...)` + +Return the least common multiple of its arguments. + +## `(length list)` + +Returns the length of list. + +## `let` + +TODO + +## `let*` + +TODO + +## `let*-values` + +TODO + +## `let-syntax` + +TODO + +## `let-values` + +TODO + +## `letrec` + +TODO + +## `letrec*` + +TODO + +## `letrec-syntax` + +TODO + +## `(list obj ...)` + +Returns a newly allocated list of its arguments. + +## `(list->string list)` + +It is an error if any element of list is not a character. + +list->string returns a newly allocated string formed from the elements +in the list list. + +## `(list->vector list)` + +The list->vector procedure returns a newly created vector initialized +to the elements of the list list. + +## `(list-copy obj)` + +Returns a newly allocated copy of the given obj if it is a list. Only +the pairs themselves are copied; the cars of the result are the same +(in the sense of eqv?) as the cars of list. If obj is an improper +list, so is the result, and the final cdrs are the same in the sense +of eqv?. An obj which is not a list is returned unchanged. It is an +error if obj is a circular list. + +## `(list-ref list k)` + +The list argument can be circular, but it is an error if list has +fewer than k elements. + +Returns the kth element of list. (This is the same as the car of +(list-tail list k).) + +## `(list-set! list k obj)` + +It is an error if k is not a valid index of list. + +The list-set! procedure stores obj in element k of list. + +## `(list-tail list k)` + +It is an error if list has fewer than k elements. + +Returns the sublist of list obtained by omitting the first k elements. + +## `(list? obj)` + +Return `#t` if `OBJ` is a list. Otherwise `#f`. + +## `(make-bytevector k [byte])` + +The make-bytevector procedure returns a newly allocated bytevector of +length k. If byte is given, then all elements of the bytevector are +initialized to byte, otherwise the contents of each element are +unspecified. + +## `(make-list k [fill])` + +Returns a newly allocated list of k elements. If a second argument is +given, then each element is initialized to fill. Otherwise the initial +contents of each element is unspecified. + +## `(make-parameter init [converter])` + +Returns a newly allocated parameter object, which is a procedure that +accepts zero arguments and returns the value associated with the +parameter object. Initially, this value is the value of (converter +init), or of init if the conversion procedure converter is not +specified. The associated value can be temporarily changed using +parameterize, which is described below. + +## `(make-string k [char])` + +The make-string procedure returns a newly allocated string of length +k. If char is given, then all the characters of the string are +initialized to char, otherwise the contents of the string are +unspecified. + +## `(make-vector k [fill])` + +Returns a newly allocated vector of k elements. If a second argument +is given, then each element is initialized to fill. Otherwise the +initial contents of each element is unspecified. + +## `(map proc list1 ...)` + +It is an error if proc does not accept as many arguments as there are +lists and return a single value. + +The map procedure applies proc element-wise to the elements of the +lists and returns a list of the results, in order. If more than one +list is given and not all lists have the same length, map terminates +when the shortest list runs out. The lists can be circular, but it is +an error if all of them are circular. It is an error for proc to +mutate any of the lists. The dynamic order in which proc is applied to +the elements of the lists is unspecified. If multiple returns occur +from map, the values returned by earlier returns are not mutated. + +## `(max x1 ...)` + +Return the maximum of its arguments. + +## `(member obj list [compare])` + +Return the first sublist of list whose `car` is `obj`, where the +sublists of list are the non-empty lists returned by (list-tail list +k) for k less than the length of list. If `obj` does not occur in +`list`, then `#f` (not the empty list) is returned. + +Uses `compare`, if given, and `equal?` otherwise. + +## `(memq obj list)` + +Return the first sublist of list whose `car` is `obj`, where the +sublists of list are the non-empty lists returned by (list-tail list +k) for k less than the length of list. If `obj` does not occur in +`list`, then `#f` (not the empty list) is returned. + +Use `eq?` for comparison. + +## `(memv obj list)` + +Return the first sublist of list whose `car` is `obj`, where the +sublists of list are the non-empty lists returned by (list-tail list +k) for k less than the length of list. If `obj` does not occur in +`list`, then `#f` (not the empty list) is returned. + +Uses `eqv?` for comparison. + +## `(min x1 ...)` + +Return the minimum of its arguments. + +## `(modulo n1 n2)` + +`modulo` is equivalent to `floor-remainder`. Provided for backward compatibility. + +## `(negative? x)` + +Return `#t` if `X` is negative. Otherwise `#f`. + +## `(newline [port])` + +Writes an end of line to output port. + +## `(not obj)` + +The not procedure returns #t if obj is false, and returns #f otherwise. + +## `(null? obj)` + +Returns #t if obj is the empty list, otherwise returns #f. + +## `(number->string z [radix])` + +It is an error if radix is not one of 2, 8, 10, or 16. + +## `(number? obj)` + +Return `#t` if `OBJ` is a number. Otherwise `#f`. + +## `(numerator q)` + +TODO + +## `(odd? number)` + +Return `#t` if `NUMBER` is odd. Otherwise `#f`. + +## `(open-input-bytevector bytevector)` + +Takes a bytevector and returns a binary input port that delivers bytes +from the bytevector. + +## `(open-input-string string)` + +Takes a string and returns a textual input port that delivers +characters from the string. If the string is modified, the effect is +unspecified. + +## `(open-output-bytevector)` + +Returns a binary output port that will accumulate bytes for retrieval +by `get-output-bytevector`. + +## `(open-output-string)` + +Returns a textual output port that will accumulate characters for +retrieval by `get-output-string`. + +## `(or test1 ...)` syntax + +The `test` expressions are evaluated from left to right, and the value +of the first expression that evaluates to a true value is +returned. Any remaining expressions are not evaluated. If all +expressions evaluate to #f or if there are no expressions, then #f is +returned. + +## `(output-port-open? port)` + +Returns #t if port is still open and capable of performing output, and +#f otherwise. + +## `(output-port? obj)` + +Return #t if obj is an output port. Otherwise return #f. + +## `(pair? obj)` + +The pair? predicate returns #t if obj is a pair, and otherwise returns #f. + +## `(parameterize ((param1 value1) ...) expr ...)` + +A parameterize expression is used to change the values returned by +specified parameter objects during the evaluation of the body. + +The param and value expressions are evaluated in an unspecified +order. The body is evaluated in a dynamic environment in which calls +to the parameters return the results of passing the corresponding +values to the conversion procedure specified when the parameters were +created. Then the previous values of the parameters are restored +without passing them to the conversion procedure. The results of the +last expression in the body are returned as the results of the entire +parameterize expression. + +Note: If the conversion procedure is not idempotent, the results of +(parameterize ((x (x))) ...), which appears to bind the parameter x to +its current value, might not be what the user expects. + +If an implementation supports multiple threads of execution, then +parameterize must not change the associated values of any parameters +in any thread other than the current thread and threads created inside +body. + +Parameter objects can be used to specify configurable settings for a +computation without the need to pass the value to every procedure in +the call chain explicitly. + +## `(peek-char [port])` + +Returns the next character available from the textual input port, but +without updating the port to point to the following character. If no +more characters are available, an end-of-file object is returned. + +Note: The value returned by a call to peek-char is the same as the +value that would have been returned by a call to read-char with the +same port. The only difference is that the very next call to read-char +or peek-char on that port will return the value returned by the +preceding call to peek-char. In particular, a call to peek-char on an +interactive port will hang waiting for input whenever a call to +read-char would have hung. + +## `(peek-u8 [port])` + +Returns the next byte available from the binary input port, but +without updating the port to point to the following byte. If no more +bytes are available, an end-of-file object is returned. + +## `(port? obj)` + +Return `#t` if `OBJ` is port. Otherwise `#f`. + +## `(positive? x)` + +Return `#t` if `X` is positive. Otherwise `#f`. + +## `(procedure? obj)` + +Return `#t` if `OBJ` is a procedure. Otherwise `#f`. + +## `quasiquote` + +TODO + +## `quote` + +TODO + +## `quotient` + +TODO + +## `(raise obj)` + +Raises an exception by invoking the current exception handler on +obj. The handler is called with the same dynamic environment as that +of the call to raise, except that the current exception handler is the +one that was in place when the handler being called was installed. If +the handler returns, a secondary exception is raised in the same +dynamic environment as the handler. The relationship between obj and +the object raised by the secondary exception is unspecified. + +## `(raise-continuable obj)` + +Raises an exception by invoking the current exception handler on +obj. The handler is called with the same dynamic environment as the +call to raise-continuable, except that: (1) the current exception +handler is the one that was in place when the handler being called was +installed, and (2) if the handler being called returns, then it will +again become the current exception handler. If the handler returns, +the values it returns become the values returned by the call to +raise-continuable. + +## `(rational? obj)` + +Return `#t` if `OBJ` is a rational number. Otherwise `#f`. + +## `(rationalize x y)` + +The rationalize procedure returns the simplest rational number +differing from x by no more than y. + +## `(read-bytevector k [port])` + +Reads the next k bytes, or as many as are available before the end of +file, from the binary input port into a newly allocated bytevector in +left-to-right order and returns the bytevector. If no bytes are +available before the end of file, an end-of-file object is returned. + +## `(read-bytevector! bytevector [port [start [end]]])` + +Reads the next end - start bytes, or as many as are available before +the end of file, from the binary input port into bytevector in +left-to-right order beginning at the start position. If end is not +supplied, reads until the end of bytevector has been reached. If start +is not supplied, reads beginning at position 0. Returns the number of +bytes read. If no bytes are available, an end-of-file object is +returned. + +## `(read-char [port])` + +Returns the next character available from the textual input port, +updating the port to point to the following character. If no more +characters are available, an end-of-file object is returned. + +## `(read-error? obj)` + +Error type predicates. Returns #t if obj is an object raised by the +read procedure. Otherwise, it returns #f. + +## `(read-line [port])` + +Returns the next line of text available from the textual input port, +updating the port to point to the following character. If an end of +line is read, a string containing all of the text up to (but not +including) the end of line is returned, and the port is updated to +point just past the end of line. If an end of file is encountered +before any end of line is read, but some characters have been read, a +string containing those characters is returned. If an end of file is +encountered before any characters are read, an end-of-file object is +returned. For the purpose of this procedure, an end of line consists +of either a linefeed character, a carriage return character, or a +sequence of a carriage return character followed by a linefeed +character. Implementations may also recognize other end of line +characters or sequences. + +## `(read-string k [port])` + +Reads the next k characters, or as many as are available before the +end of file, from the textual input port into a newly allocated string +in left-to-right order and returns the string. If no characters are +available before the end of file, an end-of-file object is returned. + +## `(read-u8 [port])` + +Returns the next byte available from the binary input port, updating +the port to point to the following byte. If no more bytes are +available, an end-of-file object is returned. + +## `(real? obj)` + +Return #t if `OBJ` is real number. Otherwise `#f`. + +## `(remainder n1 n2)` + +TODO + +## `(reverse list)` + +Returns a newly allocated list consisting of the elements of list in +reverse order. + +## `(round x)` + +TODO + +## `(set! )` syntax + +Expression is evaluated, and the resulting value is stored in the +location to which variable is bound. It is an error if variable is not +bound either in some region enclosing the set! expression or else +globally. The result of the set! expression is unspecified. + +## `(set-car! pair obj)` + +Stores `obj` in the car field of `pair`. + +## `(set-cdr! pair obj)` + +Stores obj in the cdr field of pair. + +## `(square z)` + +Returns the square of z. This is equivalent to (* z z). + +## `(string char ...)` + +Returns a newly allocated string composed of the arguments. It is +analogous to list. + +## `(string->list string [start [end]])` + +The string->list procedure returns a newly allocated list of the +characters of string between start and end. + + +## `(string->number string [radix])` + +Returns a number of the maximally precise representation expressed by +the given string. It is an error if radix is not 2, 8, 10, or 16. + +If supplied, radix is a default radix that will be overridden if an +explicit radix prefix is present in string (e.g. "#o177"). If radix is +not supplied, then the default radix is 10. If string is not a +syntactically valid notation for a number, or would result in a number +that the implementation cannot represent, then string->number returns +#f. An error is never signaled due to the content of string. + +## `(string->symbol string)` + +Returns the symbol whose name is string. This procedure can create +symbols with names containing special characters that would require +escaping when written, but does not interpret escapes in its input. + +## `(string->utf8 string [start [end]])` + +The string->utf8 procedure encodes the characters of a string between +start and end and returns the corresponding bytevector. + +## `(string->vector string [start [end]])` + +The string->vector procedure returns a newly created vector +initialized to the elements of the string string between start and +end. + +## `(string-append string ...)` + +Returns a newly allocated string whose characters are the +concatenation of the characters in the given strings. + +## `(string-copy string [start [end]])` + +Returns a newly allocated copy of the part of the given string between +start and end. + +## `(string-copy! to at from [start [end]])` + +It is an error if at is less than zero or greater than the length of +to. It is also an error if (- (string-length to) at) is less than (- +end start). + +Copies the characters of string from between start and end to string +to, starting at at. The order in which characters are copied is +unspecified, except that if the source and destination overlap, +copying takes place as if the source is first copied into a temporary +string and then into the destination. This can be achieved without +allocating storage by making sure to copy in the correct direction in +such circumstances. + +## `(string-fill! string fill [start [end]])` + +It is an error if fill is not a character. + +The string-fill! procedure stores fill in the elements of string +between start and end. + +## `(string-for-each proc string1 ...)` + +It is an error if proc does not accept as many arguments as there are +strings. + +The arguments to string-for-each are like the arguments to string-map, +but string-for-each calls proc for its side effects rather than for +its values. Unlike string-map, string-for-each is guaranteed to call +proc on the elements of the lists in order from the first element(s) +to the last, and the value returned by string-for-each is +unspecified. If more than one string is given and not all strings have +the same length, string-for-each terminates when the shortest string +runs out. It is an error for proc to mutate any of the strings. + +## `(string-length string)` + +Returns the number of characters in the given string. + +## `(string-map proc string1 ...)` + +It is an error if proc does not accept as many arguments as there are +strings and return a single character. + +The string-map procedure applies proc element-wise to the elements of +the strings and returns a string of the results, in order. If more +than one string is given and not all strings have the same length, +string-map terminates when the shortest string runs out. The dynamic +order in which proc is applied to the elements of the strings is +unspecified. If multiple returns occur from string-map, the values +returned by earlier returns are not mutated. + +## `(string-ref string k)` + +It is an error if k is not a valid index of string. + +The string-ref procedure returns character k of string using +zero-origin indexing. There is no requirement for this procedure to +execute in constant time. + +## `(string-set! string k char)` + +It is an error if k is not a valid index of string. + +The string-set! procedure stores char in element k of string. There is +no requirement for this procedure to execute in constant time. + +## `string<=?` + +TODO + +## `string=?` + +TODO + +## `string>?` + +TODO + +## `(string? obj)` + +Return `#t` if `OBJ` is string. Otherwise `#f`. + +## `(substring string start end)` + +The substring procedure returns a newly allocated string formed from +the characters of string beginning with index start and ending with +index end. This is equivalent to calling string-copy with the same +arguments, but is provided for backward compatibility and stylistic +flexibility. + +## `(symbol->string symbol)` + +Returns the name of symbol as a string, but without adding escapes. It +is an error to apply mutation procedures like string-set! to strings +returned by this procedure. + +## `(symbol=? symbol1 symbol2 ...)` + +Returns #t if all the arguments are symbols and all have the same +names in the sense of string=?. + +## `(symbol? obj)` + +Returns #t if obj is a symbol, otherwise returns #f. + +## `syntax-error` + +TODO + +## `syntax-rules` + +TODO + +## `textual-port?` + +TODO + +## `(truncate x)` + +TODO + +## `truncate-quotient` + +TODO + +## `truncate-remainder` + +TODO + +## `truncate/` + +TODO + +## `(u8-ready? [port])` + +Returns #t if a byte is ready on the binary input port and returns #f +otherwise. If u8-ready? returns #t then the next read-u8 operation on +the given port is guaranteed not to hang. If the port is at end of +file then u8-ready? returns #t. + +## `(unless ...)` syntax + +The test is evaluated, and if it evaluates to #f, the expressions are +evaluated in order. The result of the unless expression is +unspecified. + +## `unquote` + +TODO + +## `unquote-splicing` + +TODO + +## `(utf8->string bytevector [start [end]])` + +It is an error for bytevector to contain invalid UTF-8 byte sequences. + +The utf8->string procedure decodes the bytes of a bytevector between +start and end and returns the corresponding string. + +## `(values obj ...)` + +Delivers all of its arguments to its continuation. + +## `(vector obj ...)` + +Returns a newly allocated vector whose elements contain the given arguments. It is analogous to list. + +## `(vector->list vector [start [end]])` + +The vector->list procedure returns a newly allocated list of the +objects contained in the elements of vector between start and end. The +list->vector procedure returns a newly created vector initialized to +the elements of the list list. + +## `(vector->string vector [start [end]])` + +It is an error if any element of vector between start and end is not a +character. + +The vector->string procedure returns a newly allocated string of the +objects contained in the elements of vector between start and end. The +string->vector procedure returns a newly created vector initialized to +the elements of the string string between start and end. + +## `(vector-append vector ...)` + +Returns a newly allocated vector whose elements are the concatenation +of the elements of the given vectors. + +## `(vector-copy vector [start [end]])` + +Returns a newly allocated copy of the elements of the given vector +between start and end. The elements of the new vector are the same (in +the sense of eqv?) as the elements of the old. + +## `(vector-copy! to at from [start [end]])` + +It is an error if at is less than zero or greater than the length of +to. It is also an error if (- (vector-length to) at) is less than (- +end start). + +Copies the elements of vector from between start and end to vector to, +starting at at. The order in which elements are copied is unspecified, +except that if the source and destination overlap, copying takes place +as if the source is first copied into a temporary vector and then into +the destination. This can be achieved without allocating storage by +making sure to copy in the correct direction in such circumstances. + +## `(vector-fill! vector fill [start [end]])` + +The vector-fill! procedure stores fill in the elements of vector +between start and end. + +## `(vector-for-each proc vector1 ...)` + +It is an error if proc does not accept as many arguments as there are vectors. + +The arguments to vector-for-each are like the arguments to vector-map, +but vector-for-each calls proc for its side effects rather than for +its values. Unlike vector-map, vector-for-each is guaranteed to call +proc on the elements of the vectors in order from the first element(s) +to the last, and the value returned by vector-for-each is +unspecified. If more than one vector is given and not all vectors have +the same length, vector-for-each terminates when the shortest vector +runs out. It is an error for proc to mutate any of the vectors. + +## `(vector-length vector)` + +Returns the number of elements in vector as an exact integer. + +## `(vector-map proc vector1 ...)` + +It is an error if proc does not accept as many arguments as there are +vectors and return a single value. + +The vector-map procedure applies proc element-wise to the elements of +the vectors and returns a vector of the results, in order. If more +than one vector is given and not all vectors have the same length, +vector-map terminates when the shortest vector runs out. The dynamic +order in which proc is applied to the elements of the vectors is +unspecified. If multiple returns occur from vector-map, the values +returned by earlier returns are not mutated. + +## `(vector-ref vector k)` + +It is an error if k is not a valid index of vector. + +The vector-ref procedure returns the contents of element k of vector. + +## `(vector-set! vector k obj)` + +It is an error if k is not a valid index of vector. + +The vector-set! procedure stores obj in element k of vector. + +## `vector?` + +Returns #t if obj is a bytevector. Otherwise, #f is returned. + +## `(when ...)` syntax + +The test is evaluated, and if it evaluates to a true value, the +expressions are evaluated in order. The result of the when expression +is unspecified. + +## `with-exception-handler` + +TODO + +## `(write-bytevector bytevector [port [start [end]]])` + +Writes the bytes of bytevector from start to end in left-to-right +order to the binary output port. + +## `(write-char char [port])` + +Writes the character char (not an external representation of the +character) to the given textual output port and returns an unspecified +value. + +## `(write-string string [port [start [end]]])` + +Writes the characters of string from start to end in left-to-right +order to the textual output port. + +## `(write-u8 byte [port])` + +Writes the byte to the given binary output port and returns an +unspecified value. + +## `(zero? z)` + +Return `#t` if z is zero. Otherwise `#f`. diff --git a/local/bin/scheme-live-chez b/local/bin/scheme-live-chez index ce02804..bcc9c39 100755 --- a/local/bin/scheme-live-chez +++ b/local/bin/scheme-live-chez @@ -1,5 +1,6 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) HELP_MAIN="usage: scheme-live chez [options]" @@ -31,7 +32,7 @@ scheme-live-chez-run () { echo "(import (only (chezscheme) import))" >> $SOURCE tail -n +2 $1 >> $SOURCE shift - PATH=$SCHEME_LIVE_PREFIX/opt/live/chez/bin:$PATH scheme --libexts .chez.sls:.sls --libdirs $SCHEME_LIVE_PREFIX/lib/:$(pwd) --program $SOURCE $@ + PATH=$SCHEME_LIVE_PREFIX/opt/live/chez/bin:$PATH scheme --libexts .chez.sls:.sls --libdirs $PROGRAMDIR/../../:$(pwd) --program $SOURCE $@ } scheme-live-chez-repl () { diff --git a/local/bin/scheme-live-chibi b/local/bin/scheme-live-chibi index 993e3b8..21b5851 100755 --- a/local/bin/scheme-live-chibi +++ b/local/bin/scheme-live-chibi @@ -1,5 +1,6 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) HELP_MAIN="usage: scheme-live chibi [options]" @@ -20,7 +21,7 @@ scheme-live-chibi-install () { } scheme-live-chibi-run () { - LD_LIBRARY_PATH=$SCHEME_LIVE_PREFIX/opt/live/chibi/lib PATH=$SCHEME_LIVE_PREFIX/opt/live/chibi/bin:$PATH chibi-scheme -I $SCHEME_LIVE_PREFIX/lib/ -I $(pwd) $1 + LD_LIBRARY_PATH=$SCHEME_LIVE_PREFIX/opt/live/chibi/lib PATH=$SCHEME_LIVE_PREFIX/opt/live/chibi/bin:$PATH chibi-scheme -I $PROGRAMDIR/../../ -I $(pwd) $1 } scheme-live-chibi-repl () { diff --git a/local/bin/scheme-live-current b/local/bin/scheme-live-current index 9342caa..a6e2bd9 100755 --- a/local/bin/scheme-live-current +++ b/local/bin/scheme-live-current @@ -37,6 +37,7 @@ scheme-live-current-check () { scheme-live $SCHEME_LIVE_CURRENT version | tee --append $REPORT find ./tests/ -type f -executable -name "check*" -exec bash -c "echo \* {} && {} || echo \*\* failed" \; | tee --append $REPORT + find ./live/ -type f -executable -name "check*" -exec bash -c "echo \* {} && {} || echo \*\* failed" \; | tee --append $REPORT if grep "^** failed" $REPORT > /dev/null; then echo "* Report for $SCHEME_LIVE_CURRENT: $(grep "^\*\* failed" $REPORT | wc -l) failed tests @ $REPORT" diff --git a/local/bin/scheme-live-cyclone b/local/bin/scheme-live-cyclone index a08a728..c1a4dd0 100755 --- a/local/bin/scheme-live-cyclone +++ b/local/bin/scheme-live-cyclone @@ -1,5 +1,7 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) + HELP_MAIN="usage: scheme-live cyclone [options]" @@ -38,7 +40,7 @@ scheme-live-cyclone-run () { SOURCE=$(mktemp --tmpdir=/tmp/ $(basename $1).XXXXXX.scm) echo "(import (scheme base))" >> $SOURCE tail -n +2 $1 >> $SOURCE - $SCHEME_LIVE_PREFIX/opt/live/cyclone/bin/cyclone -A $SCHEME_LIVE_PREFIX/lib/ -A $(pwd) $SOURCE + $SCHEME_LIVE_PREFIX/opt/live/cyclone/bin/cyclone -A "$PROGRAMDIR/../../" -A $(pwd) $SOURCE shift exec /tmp/$(basename $SOURCE .scm) $@ } diff --git a/local/bin/scheme-live-gambit b/local/bin/scheme-live-gambit index 5f4a8d9..5b5c76d 100755 --- a/local/bin/scheme-live-gambit +++ b/local/bin/scheme-live-gambit @@ -1,5 +1,7 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) + HELP_MAIN="usage: scheme-live gambit [options]" @@ -29,7 +31,7 @@ scheme-live-gambit-install () { } scheme-live-gambit-run () { - PATH=$SCHEME_LIVE_PREFIX/opt/live/gambit/bin:$PATH gsi -:r7rs $SCHEME_LIVE_PREFIX/lib/ $(pwd)/ $SCHEME_LIVE_PREFIX/opt/live/gambit/github.com/udem-dlteam/libs/@/ $1 + PATH=$SCHEME_LIVE_PREFIX/opt/live/gambit/bin:$PATH gsi -:r7rs $PROGRAMDIR/../../ $(pwd)/ $SCHEME_LIVE_PREFIX/opt/live/gambit/github.com/udem-dlteam/libs/@/ $1 } scheme-live-gambit-repl () { diff --git a/local/bin/scheme-live-gerbil b/local/bin/scheme-live-gerbil index 9df3887..d2e8198 100755 --- a/local/bin/scheme-live-gerbil +++ b/local/bin/scheme-live-gerbil @@ -1,5 +1,7 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) + HELP_MAIN="usage: scheme-live gerbil [options]" scheme-live-gerbil-install () { @@ -25,7 +27,7 @@ scheme-live-gerbil-install () { } scheme-live-gerbil-run () { - PATH=$SCHEME_LIVE_PREFIX/opt/live/gerbil/bin:$SCHEME_LIVE_PREFIX/opt/live/gambit/bin:$PATH GERBIL_HOME="$SCHEME_LIVE_PREFIX/opt/live/gerbil/" GERBIL_LOADPATH="." gxi --lang r7rs $1 + PATH=$SCHEME_LIVE_PREFIX/opt/live/gerbil/bin:$SCHEME_LIVE_PREFIX/opt/live/gambit/bin:$PATH GERBIL_HOME="$SCHEME_LIVE_PREFIX/opt/live/gerbil/" GERBIL_LOADPATH=".:$PROGRAMDIR/../../" gxi --lang r7rs $1 } scheme-live-gerbil-repl () { diff --git a/local/bin/scheme-live-guile b/local/bin/scheme-live-guile index 4ddc57f..92ad54f 100755 --- a/local/bin/scheme-live-guile +++ b/local/bin/scheme-live-guile @@ -1,5 +1,7 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) + HELP_MAIN="usage: scheme-live guile [options]" @@ -26,7 +28,7 @@ scheme-live-guile-run () { SOURCE=$(mktemp --tmpdir=/tmp/ $(basename $1).XXXXXX.scm) tail -n +2 $1 > $SOURCE shift - PATH=$SCHEME_LIVE_PREFIX/opt/live/guile/bin/:$PATH guile --fresh-auto-compile -L $SCHEME_LIVE_PREFIX/lib/ -L $(pwd) $SOURCE $@ + PATH=$SCHEME_LIVE_PREFIX/opt/live/guile/bin/:$PATH guile --fresh-auto-compile -L $PROGRAMDIR/../../ -L $(pwd) $SOURCE $@ } scheme-live-guile-repl () { diff --git a/local/bin/scheme-live-loko b/local/bin/scheme-live-loko index 494646e..d5cee26 100755 --- a/local/bin/scheme-live-loko +++ b/local/bin/scheme-live-loko @@ -1,5 +1,7 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) + HELP_MAIN="usage: scheme-live loko [options]" scheme-live-loko-install () { @@ -27,7 +29,7 @@ scheme-live-loko-install () { } scheme-live-loko-run () { - PATH=$SCHEME_LIVE_PREFIX/opt/live/loko/bin:$PATH LOKO_LIBRARY_PATH=$SCHEME_LIVE_PREFIX/lib/:$(pwd):$SCHEME_LIVE_PREFIX/opt/live/loko/lib/ loko -std=r7rs --program $@ + PATH=$SCHEME_LIVE_PREFIX/opt/live/loko/bin:$PATH LOKO_LIBRARY_PATH=$PROGRAMDIR/../../:$(pwd):$SCHEME_LIVE_PREFIX/opt/live/loko/lib/ loko -std=r7rs --program $@ } scheme-live-loko-repl () { diff --git a/local/bin/scheme-live-mit b/local/bin/scheme-live-mit index 162f5ce..f3e7fc5 100755 --- a/local/bin/scheme-live-mit +++ b/local/bin/scheme-live-mit @@ -1,5 +1,6 @@ #!/bin/bash +PROGRAMDIR=$(dirname $0) HELP_MAIN="usage: scheme-live mit [options]" @@ -44,7 +45,7 @@ scheme-live-mit-run () { } scheme-live-mit-repl () { - PATH=$SCHEME_LIVE_PREFIX/opt/live/mit/bin:$PATH rlwrap mit-scheme --eval "(find-scheme-libraries! \"$SCHEME_LIVE_PREFIX/lib/\")" + PATH=$SCHEME_LIVE_PREFIX/opt/live/mit/bin:$PATH rlwrap mit-scheme --eval "(find-scheme-libraries! \"$PROGRAMDIR/../../\")" } scheme-live-mit-version () { diff --git a/makefile b/makefile index 5024e97..82c534b 100644 --- a/makefile +++ b/makefile @@ -6,11 +6,6 @@ prepare-debian: ## Prepare a Debian host (call with sudo) apt update apt install --yes --no-install-recommends $(shell cat debian-system-dependencies.txt | tr '\n' ' ') -check-with-docker: ## Run checks with docker - env | grep "^IMPLEMENTATION=" # requires an implementation - env | grep "^IMAGE=" # requires a docker image - docker run --volume $(PWD):/live --interactive --rm $(IMAGE) /bin/sh -c "cd /live && apt update && apt install --yes $(shell cat debian-system-dependencies.txt | tr '\n' ' ') && ./venv make IMPLEMENTATION=$(IMPLEMENTATION) check" - check: ## Run tests env | grep "^IMPLEMENTATION=" # requires an env variable called IMPLEMENTATION ./local/bin/scheme-live $(IMPLEMENTATION) check $(PWD) @@ -19,3 +14,8 @@ test: check ## Run checks html: ## Generate html from markdown documentation pandoc --metadata title="Scheme Live!" README.md --css styles.css --mathml --standalone --to=html5 --output index.html + pandoc --metadata title="Scheme Live!" live/unstable/index.md --css ../../styles.css --mathml --standalone --to=html5 --output live/unstable/index.html + +check-with-podman: + env | grep "^IMPLEMENTATION=" # requires an env variable called IMPLEMENTATION + podman run --volume $(PWD):/live --interactive --rm ghcr.io/scheme-live/schemers:stable bash -c 'cp /live/local/shell-subcommand.sh . && cd /live && SCHEME_LIVE_PREFIX=/ PATH=/opt/live/$(IMPLEMENTATION)/bin:/live/local/bin:/usr/bin/:/bin USER=github scheme-live $(IMPLEMENTATION) check' diff --git a/tests/check-0002-json-unstable.scm b/tests/check-0002-json-unstable.scm index c84b0b9..4d0738c 100755 --- a/tests/check-0002-json-unstable.scm +++ b/tests/check-0002-json-unstable.scm @@ -1,6 +1,6 @@ #!/usr/bin/env -S scheme-live current run (import (scheme write)) -(import (live json base)) +(import (live unstable)) (import (live json unstable)) @@ -53,7 +53,7 @@ (output (string-append data "/" name "/output.scm")) (error (string-append data "/" name "/error.txt")) (outxy (guard (exc (else (on-error exc error))) - (display "* ") + (display "** ") (display name) (display " => ") (let ((obj (json->obj->json->obj input)))