From 91ed7c651c6c65dbd5c4592079bea4fb2f20b95c Mon Sep 17 00:00:00 2001 From: Freja Nordsiek Date: Thu, 9 Mar 2017 19:46:44 +0100 Subject: [PATCH] Add preliminary version of the R7RS libraries. --- doc/ref/Makefile.am | 1 + doc/ref/guile.texi | 2 + doc/ref/intro.texi | 33 +- doc/ref/r7rs.texi | 1265 +++++++++++++++++++++++++++++++++++++ module/Makefile.am | 17 + module/scheme/base.scm | 598 ++++++++++++++++++ module/scheme/case-lambda.scm | 23 + module/scheme/char.scm | 73 +++ module/scheme/complex.scm | 23 + module/scheme/cxr.scm | 46 ++ module/scheme/eval.scm | 23 + module/scheme/file.scm | 36 ++ module/scheme/inexact.scm | 25 + module/scheme/lazy.scm | 35 + module/scheme/load.scm | 36 ++ module/scheme/process-context.scm | 29 + module/scheme/r5rs.scm | 247 ++++++++ module/scheme/read.scm | 23 + module/scheme/repl.scm | 23 + module/scheme/time.scm | 47 ++ module/scheme/write.scm | 31 + test-suite/Makefile.am | 4 + test-suite/tests/r7rs-base.test | 339 ++++++++++ test-suite/tests/r7rs-char.test | 35 + test-suite/tests/r7rs-lazy.test | 29 + test-suite/tests/r7rs-time.test | 43 ++ 26 files changed, 3072 insertions(+), 14 deletions(-) create mode 100644 doc/ref/r7rs.texi create mode 100644 module/scheme/base.scm create mode 100644 module/scheme/case-lambda.scm create mode 100644 module/scheme/char.scm create mode 100644 module/scheme/complex.scm create mode 100644 module/scheme/cxr.scm create mode 100644 module/scheme/eval.scm create mode 100644 module/scheme/file.scm create mode 100644 module/scheme/inexact.scm create mode 100644 module/scheme/lazy.scm create mode 100644 module/scheme/load.scm create mode 100644 module/scheme/process-context.scm create mode 100644 module/scheme/r5rs.scm create mode 100644 module/scheme/read.scm create mode 100644 module/scheme/repl.scm create mode 100644 module/scheme/time.scm create mode 100644 module/scheme/write.scm create mode 100644 test-suite/tests/r7rs-base.test create mode 100644 test-suite/tests/r7rs-char.test create mode 100644 test-suite/tests/r7rs-lazy.test create mode 100644 test-suite/tests/r7rs-time.test diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 05393cd..9381d29 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -73,6 +73,7 @@ guile_TEXINFOS = preface.texi \ repl-modules.texi \ srfi-modules.texi \ r6rs.texi \ + r7rs.texi \ match.texi \ misc-modules.texi \ libguile-autoconf.texi \ diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 4bc3b74..beb6d88 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -360,6 +360,7 @@ available through both Scheme and C interfaces. * getopt-long:: Command line handling. * SRFI Support:: Support for various SRFIs. * R6RS Support:: Modules defined by the R6RS. +* R7RS Support:: Modules defined by the R7RS. * Pattern Matching:: Generic pattern matching constructs. * Readline Support:: Module for using the readline library. * Pretty Printing:: Nicely formatting Scheme objects for output. @@ -383,6 +384,7 @@ available through both Scheme and C interfaces. @include mod-getopt-long.texi @include srfi-modules.texi @include r6rs.texi address@hidden r7rs.texi @include match.texi @include repl-modules.texi @include misc-modules.texi diff --git a/doc/ref/intro.texi b/doc/ref/intro.texi index 28da4ac..ed6250b 100644 --- a/doc/ref/intro.texi +++ b/doc/ref/intro.texi @@ -71,23 +71,28 @@ dynamic linking, a foreign function call interface, powerful string processing, and many other features needed for programming in the real world. -The Scheme community has recently agreed and published R6RS, the -latest installment in the RnRS series. R6RS significantly expands the -core Scheme language, and standardises many non-core functions that -implementations---including Guile---have previously done in -different ways. Guile has been updated to incorporate some of the -features of R6RS, and to adjust some existing features to conform to -the R6RS specification, but it is by no means a complete R6RS -implementation. @xref{R6RS Support}. - -Between R5RS and R6RS, the SRFI process (@url{http://srfi.schemers.org/}) -standardised interfaces for many practical needs, such as multithreaded -programming and multidimensional arrays. Guile supports many SRFIs, as -documented in detail in @ref{SRFI Support}. +The Scheme community has recently agreed and published R7RS, the +latest installment in the RnRS series, and not long before that R6RS. +R6RS significantly expands the core Scheme language, and standardises +many non-core functions that implementations---including Guile---have +previously done in different ways. R7RS is a much smaller expansion +from R5RS but in a bit of a different direction than than R6RS +(the upcoming R7RS-large will significantly expand the libraries). +Guile has been updated to incorporate some of the features of R6RS and +R7RS, and to adjust some existing features to conform to the R6RS and +R7RS specifications, but it is by no means a complete R6RS +implementation @xref{R6RS Support} nor a complete R7RS implementation address@hidden Support}. + +Between R5RS, R6RS, R7RS, the SRFI process +(@url{http://srfi.schemers.org/}) standardised interfaces for many +practical needs, such as multithreaded programming and multidimensional +arrays. Guile supports many SRFIs, as documented in detail in address@hidden Support}. In summary, so far as relationship to the Scheme standards is concerned, Guile is an R5RS implementation with many extensions, some -of which conform to SRFIs or to the relevant parts of R6RS. +of which conform to SRFIs or to the relevant parts of R6RS and R7RS. @node Combining with C @section Combining with C Code diff --git a/doc/ref/r7rs.texi b/doc/ref/r7rs.texi new file mode 100644 index 0000000..a632fd3 --- /dev/null +++ b/doc/ref/r7rs.texi @@ -0,0 +1,1265 @@ address@hidden -*-texinfo-*- address@hidden This is part of the GNU Guile Reference Manual. address@hidden Copyright (C) 2010, 2011, 2012, 2013, address@hidden 2014, 2017 Free Software Foundation, Inc. address@hidden See the file guile.texi for copying conditions. + address@hidden R7RS Support address@hidden R7RS Support address@hidden R7RS + +Preliminary support for the R7RS libraries is now provided, though +support for the additional syntax introduced in R7RS is more limited. + address@hidden Support}, for more information on how to define R7RS +libraries, and their integration with Guile modules. + +We use the R6RS exception and condition system for the R7RS libraries +but with the @var{who} field being inaccessible from within the R7RS +libraries. The @code{(rnrs exceptions)} and @code{(rnrs conditions)} +may be used to get the @var{who} fields or get more information about +error objects; @xref{rnrs exceptions} and @xref{rnrs conditions}. + +Guile's binary and textual port interface was heavily inspired by R6RS, +so many R6RS port interfaces are documented elsewhere. Note that R7RS +ports are not disjoint from Guile's native ports and R6RS ports, so each +API will work on ports created by each other API. Also note that in +Guile, all ports are both textual and binary. @xref{Input and Output}, +for more on Guile's core port API. The R7RS procedures working with +ports wrap R6RS's Guile's I/O routines in helpers. address@hidden File Ports}, for documentation on the R6RS file port +interface. + address@hidden +* R7RS Incompatibilities:: Guile partially implements R7RS. +* R7RS Standard Libraries:: Modules defined by the R7RS. address@hidden menu + address@hidden R7RS Incompatibilities address@hidden Incompatibilities with the R7RS + +Preliminary support is provided for R7RS in Guile. + +There are some incompatibilities between Guile and the R7RS. Some of +them are intentional, some of them are bugs, and some are simply +unimplemented features. Please let the Guile developers know if you +find one that is not on this list. + address@hidden address@hidden +The R7RS @code{define-library} syntax for defining modules/libraries is +not yet supported. address@hidden address@hidden does not support the R7RS additions yet. address@hidden address@hidden and @code{read-error?} in module @code{(scheme base)} +are not able to correctly identify all file opening and port reading +errors. Specifically, they can fail for error objects not produced by +R6RS or R7RS file opening and port reading procedures. address@hidden +Data written bytevector output ports opened by R6RS address@hidden in the @code{(rnrs io ports)} module +cannot be read with the R7RS @code{get-output-bytevector} procedure. address@hidden address@hidden is currently aliased to @code{write} in module address@hidden(scheme write)} which means the expected R7RS behavior will not be +produced, which is hanging if writing a cyclic object. address@hidden itemize + address@hidden R7RS Standard Libraries address@hidden R7RS Standard Libraries + +Similar to R6RS, R7RS organizes the procedures and syntactic forms +required of conforming implementations into a set of +``standard libraries'' which can be imported as necessary by user +programs and libraries. Here we briefly list the libraries that have +been implemented for Guile. + +We do not attempt to document these libraries fully here, as most of +their functionality is already available in Guile itself. The +expectation is that most Guile users will use the well-known and +well-documented Guile modules. These R7RS libraries are mostly useful +to users who want to port their code to other R7RS systems. + +The documentation in the following sections reproduces some of the +content of the library section of the Report, but is mostly intended to +provide supplementary information about Guile's implementation of the +R7RS standard libraries. For complete documentation, design rationales +and further examples, we advise you to consult the ``Standard +Libraries'' section of the Report (@pxref{Standard Libraries, +R7RS Standard Libraries,, r7rs, The Revised^7 Report on the Algorithmic +Language Scheme}). + address@hidden +* R7RS Library Usage:: What to know about Guile's library support. +* scheme base:: The base library. +* scheme case-lambda:: Provides case-lambda. +* scheme char:: Functions for working with characters and strings. +* scheme complex:: Functions for working with complex numbers. +* scheme cxr:: Various compositions of car and cdr. +* scheme eval:: Support for on-the-fly evaluation. +* scheme file:: Functions for working with files. +* scheme inexact:: Functions for inexact (floating point) math. +* scheme lazy:: Provides lazy evaluation. +* scheme load:: Support for loading scheme files. +* scheme process-context:: Funcions to access the program's calling context. +* scheme read:: Procedure to read scheme objects. +* scheme repl:: Procedure to get the current context. +* scheme time:: Functions for getting the time and runtime. +* scheme write:: Functions to write scheme objects. +* scheme r5rs:: Compatibility layer for R5RS Scheme. + address@hidden menu + + address@hidden R7RS Library Usage address@hidden R7RS Library Usage + +Guile implements the R7RS `library' form as a transformation to a native +Guile module definition. As a consequence of this, all of the libraries +described in the following subsections, in addition to being available +for use by R7RS libraries and top-level programs, can also be imported +as if they were normal Guile modules---via a @code{use-modules} form, +say. For example, the R7RS ``base'' library can be imported by: + address@hidden + (import (scheme base)) address@hidden lisp + address@hidden + (use-modules ((scheme base))) address@hidden lisp + +For more information on Guile's library implementation, see +(@pxref{R7RS Support}). + + address@hidden scheme base address@hidden scheme base + +The @code{(scheme base)} library exports the procedures and syntactic +forms described in the main section of the Report +(@pxref{Base library, R7RS Base library,, r7rs, +The Revised^7 Report on the Algorithmic Language Scheme}). They are +grouped below by the existing manual sections to which they correspond. + address@hidden {Scheme Syntax} quote expr address@hidden Syntax}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} lambda formals body address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} if test consequence [alternate] address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} set! variable-name value address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} include filename1 @dots{} address@hidden {Scheme Syntax} include-ci filename1 @dots{} +Case-sensitive and case-insenstivie, respectively, nclude the contents +of the given filenames at the current location in execution much like +the C/C++ preprocessor macro @code{#include}. @code{include} uses a +different syntax than the Guile version; @xref{Local Inclusion}. address@hidden deffn + address@hidden {Scheme Syntax} cond clause1 clause2 ... address@hidden {Scheme Syntax} case key clause1 clause2 ... address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} and expr ... address@hidden {Scheme Syntax} or expr ... address@hidden or}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} when test expression1 expression2 ... address@hidden {Scheme Syntax} unless test expression1 expression2 ... +The @code{when} form is evaluated by evaluating the specified @var{test} +expression; if the result is a true value, the @var{expression}s that +follow it are evaluated in order, and the value of the final address@hidden becomes the value of the entire @code{when} expression. + +The @code{unless} form behaves similarly, with the exception that the +specified @var{expression}s are only evaluated if the value of address@hidden is false. address@hidden deffn + address@hidden {Scheme Syntax} cond-expand (feature body @dots{}) @dots{} address@hidden, see documentation. @code{cond-expand} does not support +the R7RS additions yet. address@hidden deffn + address@hidden {Scheme Syntax} let bindings body address@hidden {Scheme Syntax} let* bindings body address@hidden {Scheme Syntax} letrec bindings body address@hidden {Scheme Syntax} letrec* bindings body address@hidden Bindings}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} let-values bindings body address@hidden {Scheme Syntax} let*-values bindings body address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} begin expr1 expr2 ... address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} do ((variable init step) ...) (test expression ...) command ... +This form is identical to the one provided by Guile's core library. address@hidden do}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} make-parameter init [converter] address@hidden {Scheme Syntax} parameterize ((param1 value1)) @dots{}) body1 body2 @dots{} address@hidden, see documentation. address@hidden deffn + address@hidden {Scheme Syntax} guard (variable clause1 clause2 ...) body +Evaluates the expression given by @var{body}, first creating an ad hoc +exception handler that binds a raised exception to @var{variable} and +then evaluates the specified @var{clause}s as if they were part of a address@hidden expression, with the value of the first matching clause +becoming the value of the @code{guard} expression +(@pxref{Conditionals}). If none of the clause's test expressions +evaluates to @code{#t}, the exception is re-raised, with the exception +handler that was current before the evaluation of the @code{guard} form. + +For example, the expression + address@hidden +(guard (ex ((eq? ex 'foo) 'bar) ((eq? ex 'bar) 'baz)) + (raise 'bar)) address@hidden lisp + +evaluates to @code{baz}. address@hidden deffn + address@hidden {Scheme Syntax} quasiquote expr address@hidden {Scheme Syntax} unquote expr address@hidden {Scheme Syntax} unquote-splicing expr address@hidden Syntax}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} let-syntax ((keyword transformer) @dots{}) exp1 exp2 @dots{} address@hidden {Scheme Syntax} letrec-syntax ((keyword transformer) @dots{}) exp1 exp2 @dots{} address@hidden Macros}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} syntax-error message [arg @dots{}] address@hidden Rules}, see documentation. address@hidden deffn + address@hidden {Scheme Syntax} define name value address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} define-values formals expressions address@hidden Multiple Values}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} define-syntax keyword expression address@hidden Macros}, for documentation. address@hidden deffn + address@hidden {Scheme Syntax} define-record-type type (constructor fieldname @dots{}) predicate (fieldname accessor [modifier]) @dots{} address@hidden Records}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} eqv? x y address@hidden {Scheme Procedure} eq? x y address@hidden {Scheme Procedure} equal? x y address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} number? obj address@hidden Tower}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} complex? z address@hidden Numbers}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} real? x address@hidden {Scheme Procedure} rational? x address@hidden and Rationals}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} integer? x address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} exact? x address@hidden {Scheme Procedure} inexact? x address@hidden, for documentation. The @code{exact} and address@hidden procedures are identical to the @code{inexact->exact} and address@hidden>inexact} procedures provided by Guile's code library. address@hidden deffn + address@hidden {Scheme Procedure} exact-integer? x address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} finite? z address@hidden {Scheme Procedure} infinite? z address@hidden {Scheme Procedure} nan? z +Returns whether or not @var{z} is finite/infinite/nan for real @var{z}, +or if both components (@code{finite?}) or at least one component +(@code{infinite?} and @code{nan?}) are finite/infinite/nan for complex address@hidden address@hidden deffn + address@hidden {Scheme Procedure} = address@hidden {Scheme Procedure} < address@hidden {Scheme Procedure} > address@hidden {Scheme Procedure} <= address@hidden {Scheme Procedure} >= address@hidden {Scheme Procedure} zero? x address@hidden {Scheme Procedure} positive? x address@hidden {Scheme Procedure} negative? x address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} odd? n address@hidden {Scheme Procedure} even? n address@hidden Operations}, for documentation. address@hidden deffn + + address@hidden {Scheme Procedure} max x1 x2 ... address@hidden {Scheme Procedure} min x1 x2 ... address@hidden {Scheme Procedure} + z1 ... address@hidden {Scheme Procedure} * z1 .. address@hidden {Scheme Procedure} - z1 z2 ... address@hidden {Scheme Procedure} / z1 z2 ... address@hidden {Scheme Procedure} abs x address@hidden {Scheme Procedure} floor/ x y address@hidden {Scheme Procedure} floor-quotient x y address@hidden {Scheme Procedure} floor-remainder x y address@hidden {Scheme Procedure} truncate/ x y address@hidden {Scheme Procedure} truncate-quotient x y address@hidden {Scheme Procedure} truncate-remainder x y address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} quotient x y address@hidden {Scheme Procedure} remainder x y address@hidden {Scheme Procedure} modulo x y address@hidden {Scheme Procedure} gcd x ... address@hidden {Scheme Procedure} lcm x ... address@hidden Operations}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} numerator x address@hidden {Scheme Procedure} denominator x address@hidden and Rationals}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} floor x address@hidden {Scheme Procedure} ceiling x address@hidden {Scheme Procedure} truncate x address@hidden {Scheme Procedure} round x address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} rationalize x eps address@hidden and Rationals}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} square z +Returns the square of the number @var{z}. Equivalent to @code{(* z z)}. address@hidden deffn + address@hidden {Scheme Procedure} exact-integer-sqrt k address@hidden Operations}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} expt z1 z2 address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} exact z address@hidden {Scheme Procedure} inexact z address@hidden, for documentation. The @code{exact} and address@hidden procedures are identical to the @code{inexact->exact} and address@hidden>inexact} procedures provided by Guile's code library. address@hidden deffn + address@hidden {Scheme Procedure} number->string n [radix] address@hidden {Scheme Procedure} string->number str [radix] address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} not x address@hidden {Scheme Procedure} boolean? obj address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} boolean=? obj1 obj2 ... +Returns @code{#t} if all the arguments are @code{#t}, and @code{#f} +otherwise. address@hidden deffn + address@hidden {Scheme Procedure} pair? x address@hidden {Scheme Procedure} cons x y address@hidden {Scheme Procedure} car pair address@hidden {Scheme Procedure} cdr pair address@hidden {Scheme Procedure} set-car! pair value address@hidden {Scheme Procedure} set-cdr! pair value address@hidden {Scheme Procedure} caar pair address@hidden {Scheme Procedure} cadr pair address@hidden {Scheme Procedure} cdar pair address@hidden {Scheme Procedure} cddr pair address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} null? x address@hidden {Scheme Procedure} list? x address@hidden Predicates}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} make-list count [init] address@hidden {Scheme Procedure} list elem @dots{} address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} length lst address@hidden Selection}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} append lst @dots{} address@hidden {Scheme Procedure} reverse lst address@hidden/Reverse}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} list-tail lst k address@hidden {Scheme Procedure} list-ref lst k address@hidden Selection}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} list-set! lst k obj address@hidden Modification}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} memq obj list address@hidden {Scheme Procedure} memv obj list address@hidden {Scheme Procedure} member obj list address@hidden {Scheme Procedure} member obj list [predicate] address@hidden, and @code{memv} are identical to the +procedures provided by Guile's core library; @xref{List Searching}, +for their documentation. @code{member} is identical to the procedure +in SRFI-1; @xref{SRFI-1 Searching}. address@hidden deffn + address@hidden {Scheme Procedure} assq obj alist address@hidden {Scheme Procedure} assv obj alist address@hidden {Scheme Procedure} assoc obj alist [predicate] address@hidden and @code{assv} are identical to the +procedures provided by Guile's core library; address@hidden Key Equality}, for their documentation. +association list @var{alist}. @code{assoc} is identical to the procedure +in SRFI-1; @xref{SRFI-1 Association Lists}. address@hidden deffn + address@hidden {Scheme Procedure} list-copy lst address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} symbol? obj address@hidden Primitives}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} symbol=? symbol1 symbol2 ... address@hidden, for documentation. + address@hidden is identical to @code{eq?}. address@hidden deffn + address@hidden {Scheme Procedure} symbol->string sym address@hidden {Scheme Procedure} string->symbol str address@hidden Primitives}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} char? obj address@hidden {Scheme Procedure} char=? address@hidden {Scheme Procedure} char? address@hidden {Scheme Procedure} char<=? address@hidden {Scheme Procedure} char>=? address@hidden {Scheme Procedure} char->integer chr address@hidden {Scheme Procedure} integer->char n address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string? obj address@hidden Predicates}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} make-string k [chr] address@hidden {Scheme Procedure} string char ... address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-length str address@hidden {Scheme Procedure} string-ref str k address@hidden Selection}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-set! str k chr address@hidden Modification}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string=? s1 s2 s3 @dots{} address@hidden {Scheme Procedure} string? s1 s2 s3 @dots{} address@hidden {Scheme Procedure} string<=? s1 s2 s3 @dots{} address@hidden {Scheme Procedure} string>=? s1 s2 s3 @dots{} address@hidden Comparison}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} substring str start [end] address@hidden Selection}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-append arg @dots{} address@hidden and Appending Strings}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string->list str [start [end]] address@hidden/String Conversion}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} list->string lst address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-copy str [start [end]] address@hidden Selection}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-copy! target tstart s [start [end]] address@hidden {Scheme Procedure} string-fill! str chr [start [end]] address@hidden Modification}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector? obj address@hidden {Scheme Procedure} make-vector len [fill] address@hidden {Scheme Procedure} vector arg @dots{} address@hidden Creation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector-length vector address@hidden {Scheme Procedure} vector-ref vector k address@hidden {Scheme Procedure} vector-set! vector k obj address@hidden Accessors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} list->vector l address@hidden Creation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector->list v [start [end]] address@hidden Conversion}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector->string v [start [end]] address@hidden {Scheme Procedure} string->vector s [start [end]] +Convert vector of characters @var{v} or string @var{s} to a string or a +vector of characters respectively starting at index @var{start} (default +is 0) to index @var{end} (default is the end of @var{v} or @var{s}). address@hidden deffn + address@hidden {Scheme Procedure} vector-copy v [start [end [fill]]] address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector-copy! target tstart source [sstart [send]] address@hidden Mutators}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector-append v @dots{} address@hidden Constructors}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} vector-fill! v fill [start [end]] address@hidden Mutators}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} bytevector? obj address@hidden {Scheme Procedure} make-bytevector? len [fill] address@hidden Manipulation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} bytevector byte1 @dots{} +Returns a newly allocated bytevector consisting of the provided byte +values. address@hidden deffn + address@hidden {Scheme Procedure} bytevector-length obj address@hidden Manipulation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} bytevector-u8-ref bv index address@hidden {Scheme Procedure} bytevector-u8-set! bv index value address@hidden as Integers}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} bytevector-copy bv [start [end]] +Return a new bytevector copying bytevector @var{bf} from index address@hidden (default is 0) to index @var{end} (default is end of address@hidden). address@hidden deffn + address@hidden {Scheme Procedure} bytevector-copy! target tstart source [sstart [send]] +Copies bytevector @var{source} into bytevector @var{target} at index address@hidden @var{source} is copied starting from index @var{sstart} +(default is 0) up to index @var{send} (default is end of bytevector). +The argument order is different than the Guile and R6RS procedures of +the same name; @xref{Bytevector Manipulation}. address@hidden deffn + address@hidden {Scheme Procedure} bytevector-append bv @dots{} +Appends all the given bytevectors in order and returns the resulting new +bytevector. address@hidden deffn + address@hidden {Scheme Procedure} utf8->string bv [start [end]] address@hidden {Scheme Procedure} string->utf8 s [start [end]] +Converts the bytevector @var{bv} or string @var{s} to a string or a +bytevector respectively using utf-8 encoding from index @var{start} +(default is 0) to index @var{end} (default is the end of @var{bv} or address@hidden). address@hidden deffn + address@hidden {Scheme Procedure} procedure? obj address@hidden Properties}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} apply proc arg @dots{} arglst address@hidden Evaluation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} map proc arg1 arg2 @dots{} address@hidden Mapping}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-map proc string1 string2 @dots{} +Applies @var{proc} (which must return a single character) elementwise to +the elements of the argument strings and returns the string composed of +the outputs in the same way @code{map} does for lists; @xref{List Mapping}. address@hidden deffn + address@hidden {Scheme Procedure} vector-map proc vec1 vec2 @dots{} address@hidden Iteration}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} for-each f lst1 lst2 @dots{} address@hidden Fold and Map}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-for-each proc string1 string2 @dots{} +Applies @var{proc} elementwise to the elements of the argument strings +for the side effects in the same way @code{for-each} does for lists; address@hidden Mapping}. address@hidden deffn + address@hidden {Scheme Procedure} vector-for-each proc vec1 vec2 @dots{} address@hidden Iteration}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} call-with-current-continuation proc address@hidden {Scheme Procedure} call/cc proc address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} values arg @dots{} address@hidden {Scheme Procedure} call-with-values producer consumer address@hidden Values}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} dynamic-wind in_guard thunk out_guard address@hidden Wind}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} with-exception-handler handler thunk +Installs @var{handler}, which must be a procedure taking one argument, +as the current exception handler during the invocation of @var{thunk}, a +procedure taking zero arguments. The handler in place at the time address@hidden is called is made current again once +either @var{thunk} returns or @var{handler} is invoked after an +exception is thrown from within @var{thunk}. + +This procedure is similar to the @code{with-throw-handler} procedure +provided by Guile's code library; (@pxref{Throw Handlers}). address@hidden deffn + address@hidden {Scheme Procedure} raise obj +Raises a non-continuable exception by invoking the currently-installed +exception handler on @var{obj}. If the handler returns, a address@hidden&non-continuable} exception will be raised in the dynamic context +in which the handler was installed. address@hidden deffn + address@hidden {Scheme Procedure} raise-continuable obj +Raises a continuable exception by invoking currently-installed exception +handler on @var{obj}. address@hidden deffn + address@hidden {Scheme Procedure} error message irritant1 ... +These procedures raise compound conditions based on their arguments: +a @code{&message} condition will be included with a @code{message} field +equal to @var{message}; an @code{&irritants} condition will be included +with its @code{irritants} list given by @code{irritant1 ...}. + address@hidden produces a compound condition with the simple conditions +described above, as well as an @code{&error} condition. + +Note that the syntax is different than the R6RS procedure of the same +name, which it uses under the hood (the @var{who} argument of the R6RS +version is set to @code{#f}). @xref{rnrs base}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} error-object? obj address@hidden {Scheme Procedure} error-object-message obj address@hidden {Scheme Procedure} error-object-irritants obj +Equivalent to @code{error?}, @code{message-condition?}, and address@hidden; @xref{rnrs conditions} address@hidden deffn + address@hidden {Scheme Procedure} read-error? obj address@hidden {Scheme Procedure} file-error? obj +Whether @var{obj} is an error object thrown reading from a port or +trying to open up a file port respectively. Note that they may not +be able to successfully identify such errors if using procedures +outside of R6RS and R7RS. + address@hidden looks for error objects with a @var{who} of address@hidden"read"} or are @code{&i/o-read-error}; address@hidden I/O Conditions}. + address@hidden looks for error objects that are address@hidden/o-file-already-exists}, @code{i/o-file-does-not-exist}, address@hidden/o-file-is-read-only}, @code{i/o-filename}, and/or address@hidden/o-file-protection}; @xref{R6RS I/O Conditions}. address@hidden deffn + address@hidden {Scheme Procedure} call-with-port port proc +Call @var{proc}, passing it @var{port} and closing @var{port} upon exit +of @var{proc}. Return the return values of @var{proc}. address@hidden deffn + address@hidden {Scheme Procedure} input-port? obj address@hidden {Scheme Procedure} output-port? obj address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} textual-port? port address@hidden {Scheme Procedure} binary-port? port +Return @code{#t}, as all ports in Guile are suitable for binary and +textual I/O. @xref{Encoding}, for more details. address@hidden deffn + address@hidden {Scheme Procedure} port? obj address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} input-port-open? port address@hidden {Scheme Procedure} output-port-open? port +Return @code{#t} if @var{port} is open and is an input or output port +respectively. address@hidden deffn + address@hidden {Scheme Procedure} current-input-port address@hidden {Scheme Procedure} current-output-port address@hidden {Scheme Procedure} current-error-port address@hidden Ports}. address@hidden deffn + address@hidden {Scheme Procedure} close-port port address@hidden {Scheme Procedure} close-input-port input-port address@hidden {Scheme Procedure} close-output-port output-port +Closes the given @var{port}, @var{input-port}, or @var{output-port}. address@hidden deffn + address@hidden {Scheme Procedure} open-input-string str address@hidden {Scheme Procedure} open-output-string address@hidden {Scheme Procedure} get-output-string port address@hidden Ports}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} open-input-bytevector bv address@hidden {Scheme Procedure} open-output-bytevector address@hidden {Scheme Procedure} get-output-bytevector port address@hidden and @code{open-output-bytevecotr} open a +binary bytevector port, input port from @var{bv} or output port +respectively, and return the port. The data written to an output +bytevector port can be read using @var{get-output-bytevector}. + +These procedures are equivalent to the similar ones for string ports; address@hidden Ports}. Note that data written bytevector output ports +opened by R6RS @var{open-bytevector-output-port} in the address@hidden(rnrs io ports)} module cannot be read with address@hidden address@hidden deffn + address@hidden {Scheme Procedure} read-char [textual-input-port] address@hidden {Scheme Procedure} peek-char [textual-input-port] address@hidden Port Interfaces}, see documentation. address@hidden deffn + address@hidden {Scheme Procedure} read-line [textual-input-port] +Read and return a string of @var{count} characters (or less if the end +of file is reached) from @var{port} (default is current input). address@hidden deffn + address@hidden {Scheme Procedure} eof-object? obj address@hidden I/O}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} eof-object +Return the end-of-file (EOF) object. + address@hidden +(eof-object? (eof-object)) address@hidden #t address@hidden lisp address@hidden deffn + address@hidden {Scheme Procedure} char-ready? [port] address@hidden Port Interfaces}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} read-string count [port] +Read and return a string of @var{count} characters (or less if the end of +file is reached) from @var{port} (default is current input). address@hidden deffn + address@hidden {Scheme Procedure} read-u8 [port] +Read the next byte from @var{port} (default is current input). address@hidden deffn + address@hidden {Scheme Procedure} peek-u8 [port] +Read the next byte from @var{port} (default is current input) without +updating the file position. address@hidden deffn + address@hidden {Scheme Procedure} u8-ready? [port] +Equivalent to @code{char-ready?}. @xref{Venerable Port Interfaces}, for +documentation. address@hidden deffn + address@hidden {Scheme Procedure} read-bytevector count [port] +Read @var{count} bytes, or till end of file, from binary input port address@hidden (default is current input) and returns them in a new +bytevector. address@hidden deffn + address@hidden {Scheme Procedure} read-bytevector! bv [port [start [end]]] +Read bytes from @var{port} (default is current input) into bytevector address@hidden starting at index @var{start} (default is 0) up to index @var{end} +(default is end of @var{bv}) until the desired number of bytes are read or the +end of the file is reached. Returns the number of bytes read. address@hidden deffn + address@hidden {Scheme Procedure} newline [textual-output-port] address@hidden Port Interfaces}, see documentation. address@hidden deffn + address@hidden {Scheme Procedure} write-char char [port] address@hidden Port Interfaces}, see documentation. address@hidden deffn + address@hidden {Scheme Procedure} write-string s [port [start [count]]] +Write characters to @var{port} (default is current output) from string address@hidden starting at index @var{start} (default is 0) up to index address@hidden (default is end of @var{s}). address@hidden deffn + address@hidden {Scheme Procedure} write-u8 byte [port] +Write the byte @var{byte} to @var{port} (default is current output). address@hidden deffn + address@hidden {Scheme Procedure} write-bytevector bv [port [start [end]]] +Write bytes to @var{port} (default is current output) from bytevector address@hidden starting at index @var{start} (default is 0) up to index address@hidden (default is end of @var{bv}). address@hidden deffn + address@hidden {Scheme Procedure} flush-output-port port address@hidden, for documentation on @code{force-output}. address@hidden deffn + address@hidden {Scheme Procedure} features +Returns the list of features available/supported in cond-expand; address@hidden address@hidden deffn + + address@hidden scheme case-lambda address@hidden scheme case-lambda + +The @code{(scheme case-lambda)} library exports the @code{case-lamba} +syntax. + address@hidden {Scheme Syntax} case-lambda clause ... +This form is identical to the one provided by Guile's core library. address@hidden, for documentation. address@hidden deffn + + address@hidden scheme char address@hidden scheme char + +The @code{(scheme char)} library exports procedures for unicode +aware char and string operations. + address@hidden {Scheme Procedure} char-alphabetic? char address@hidden {Scheme Procedure} char-numeric? char address@hidden {Scheme Procedure} char-whitespace? char address@hidden {Scheme Procedure} char-upper-case? char address@hidden {Scheme Procedure} char-lower-case? char +These procedures implement various Unicode character set predicates. +They are identical to the procedures provided by Guile's core library. address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} char-ci=? char1 char2 char3 ... address@hidden {Scheme Procedure} char-ci? char1 char2 char3 ... address@hidden {Scheme Procedure} char-ci<=? char1 char2 char3 ... address@hidden {Scheme Procedure} char-ci>=? char1 char2 char3 ... +These procedures facilitate case-insensitive comparison of Unicode +characters. They are identical to the procedures provided by Guile's +core library. @xref{Characters}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} string-ci=? string1 string2 string3 ... address@hidden {Scheme Procedure} string-ci? string1 string2 string3 ... address@hidden {Scheme Procedure} string-ci<=? string1 string2 string3 ... address@hidden {Scheme Procedure} string-ci>=? string1 string2 string3 ... +These procedures perform case-insensitive comparison on their input. address@hidden Comparison}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} char-upcase char address@hidden {Scheme Procedure} char-downcase char address@hidden {Scheme Procedure} char-foldcase char +These procedures translate their arguments from one Unicode character +set to another. @code{char-upcase} and @code{char-downcase} are +identical to their counterparts in the Guile core library; address@hidden, for documentation. + address@hidden returns the result of applying @code{char-upcase} +to its argument, followed by @code{char-downcase}---except in the case +of the Turkic characters @code{U+0130} and @code{U+0131}, for which the +procedure acts as the identity function. address@hidden deffn + address@hidden {Scheme Procedure} string-upcase string address@hidden {Scheme Procedure} string-downcase string address@hidden {Scheme Procedure} string-foldcase string +These procedures perform Unicode case folding operations on their input. address@hidden Case Mapping}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} digit-value char +Returns the numeric value of @var{char} if @var{char} is a decimal +numeric digit (includes digits from several scripts in addition to Latin +script), or @code{#f} if it is any other character. address@hidden deffn + + address@hidden scheme complex address@hidden scheme complex + +The @code{(scheme complex)} library exports procedures for creating and +working with complex numbers. + address@hidden {Scheme Procedure} real-part z address@hidden {Scheme Procedure} imag-part z address@hidden {Scheme Procedure} make-rectangular real_part imaginary_part address@hidden {Scheme Procedure} make-polar x y address@hidden {Scheme Procedure} magnitude z address@hidden {Scheme Procedure} angle z address@hidden, for documentation. address@hidden deffn + + address@hidden scheme cxr address@hidden scheme cxr + +The @code{(scheme cxr)} library exports procedures that combine three +to four @code{car} and/or @code{cdr} in various orders. + address@hidden {Scheme Procedure} caaar pair address@hidden {Scheme Procedure} caadr pair address@hidden {Scheme Procedure} cadar pair address@hidden {Scheme Procedure} cdaar pair address@hidden {Scheme Procedure} caddr pair address@hidden {Scheme Procedure} cdadr pair address@hidden {Scheme Procedure} cddar pair address@hidden {Scheme Procedure} cdddr pair address@hidden {Scheme Procedure} caaaar pair address@hidden {Scheme Procedure} caaadr pair address@hidden {Scheme Procedure} caadar pair address@hidden {Scheme Procedure} cadaar pair address@hidden {Scheme Procedure} cdaaar pair address@hidden {Scheme Procedure} cddaar pair address@hidden {Scheme Procedure} cdadar pair address@hidden {Scheme Procedure} cdaadr pair address@hidden {Scheme Procedure} cadadr pair address@hidden {Scheme Procedure} caaddr pair address@hidden {Scheme Procedure} caddar pair address@hidden {Scheme Procedure} cadddr pair address@hidden {Scheme Procedure} cdaddr pair address@hidden {Scheme Procedure} cddadr pair address@hidden {Scheme Procedure} cdddar pair address@hidden {Scheme Procedure} cddddr pair address@hidden, for documentation. address@hidden deffn + + address@hidden scheme eval address@hidden scheme eval + +The @code{(scheme eval)} library exports procedures for creating +environments and evaluating scheme code in different environments +(``on-the-fly'' evaluation of expressions). + address@hidden {Scheme Procedure} eval expression environment +Evaluates @var{expression}, which must be a datum representation of a +valid Scheme expression, in the environment specified by address@hidden This procedure is identical to the one provided by +Guile's code library; @xref{Fly Evaluation}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} environment import-spec ... +Constructs and returns a new environment based on the specified address@hidden, which must be datum representations of the import +specifications used with the @code{import} form. @xref{R6RS Libraries}, +for documentation. address@hidden deffn + + address@hidden scheme file address@hidden scheme file + +The @code{(scheme file)} library exports procedures to open and interact +with files. + address@hidden {Scheme Procedure} call-with-input-file filename proc address@hidden {Scheme Procedure} call-with-output-file filename proc +These procedures are identical to the ones provided by Guile's core +library. @xref{File Ports}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} open-binary-input-file filename address@hidden {Scheme Procedure} open-binary-output-file filename +Renames of @code{open-file-input-port} and @code{open-file-output-port} +respectively; @xref{rnrs io ports}. Without additional options, as +described here, the returned port is binary. address@hidden deffn + address@hidden {Scheme Procedure} open-input-file filename address@hidden {Scheme Procedure} open-output-file filename +These procedures are identical to the ones provided by Guile's core +library. @xref{File Ports}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} with-input-from-file filename thunk address@hidden {Scheme Procedure} with-output-to-file filename thunk +These procedures are identical to the ones provided by Guile's core +library. @xref{File Ports}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} file-exists? filename address@hidden {Scheme Procedure} delete-file filename address@hidden System}, for documentation. address@hidden deffn + + address@hidden scheme inexact address@hidden scheme inexact + +The @code{(scheme inexact)} library exports procedures for doing +mathematical operations in addition to addition, subtraction, +multiplication, division, and raising to powers for inexact numbers as +well as querying whether they are @code{nan?} or finite. + address@hidden {Scheme Procedure} sqrt z address@hidden {Scheme Procedure} exp z address@hidden {Scheme Procedure} log z address@hidden {Scheme Procedure} sin z address@hidden {Scheme Procedure} cos z address@hidden {Scheme Procedure} tan z address@hidden {Scheme Procedure} asin z address@hidden {Scheme Procedure} acos z address@hidden {Scheme Procedure} atan z address@hidden, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} finite? z address@hidden {Scheme Procedure} infinite? z address@hidden {Scheme Procedure} nan? z +Returns whether or not @var{z} is finite/infinite/nan for real @var{z}, +or if both components (@code{finite?}) or at least one component +(@code{infinite?} and @code{nan?}) are finite/infinite/nan for complex address@hidden address@hidden deffn + + address@hidden scheme lazy address@hidden scheme lazy + +The @code{(scheme lazy)} library exports procedures for lazy evaluation. + address@hidden {Scheme Procedure} promise? obj address@hidden {Scheme Procedure} delay expression address@hidden {Scheme Procedure} force promise address@hidden {Scheme Procedure} delay-force expression address@hidden, for documentation. @code{delay-force} is equivalent to address@hidden address@hidden deffn + address@hidden {Scheme Procedure} make-promise value +Returns a promise that will return @var{value} when forced, or in the case +that @var{value} is a promise it returns @var{value}. Note, if @var{value} is +an expression, it is evaluated first. address@hidden deffn + + address@hidden scheme load address@hidden scheme load + +The @code{(scheme load)} library exports the @code{load} procedure. + address@hidden {Scheme Procedure} load filename [env] +Loads the file @var{filename} into the environment @var{env} (default is address@hidden(interaction-environment)}. Note the support of the @var{env} +argument compared to the native Guile procedure; address@hidden address@hidden deffn + + address@hidden scheme process-context address@hidden scheme process-context + +The @code{(scheme process-context)} library exports procedures to access +the program's calling context. + address@hidden {Scheme Procedure} command-line +This procedure is identical to the one provided by Guile's core library. address@hidden Environment}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} exit [status] +This procedure is identical to the one provided by Guile's core +library. @xref{Processes}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} emergency-exit [status] +This procedure is identical to the @code{primitive-exit} procedure +provided by Guile's core library. @xref{Processes}, for documentation. address@hidden deffn + address@hidden {Scheme Procedure} get-environment-variable name address@hidden {Scheme Procedure} get-environment-variables address@hidden, for documentation. address@hidden deffn + + address@hidden scheme read address@hidden scheme read + +The @code{(scheme read)} library exports the @code{read} procedure. + address@hidden {Scheme Procedure} read [port] +This procedure is identical to the one provided by Guile's core library. address@hidden Read}, for documentation. address@hidden deffn + + address@hidden scheme repl address@hidden scheme repl + +The @code{(scheme repl)} library exports the address@hidden procedure to get the current context. + address@hidden {Scheme Procedure} interaction-environment address@hidden Evaluation}, for documentation. address@hidden deffn + + address@hidden scheme time address@hidden scheme time + +The @code{(scheme time)} library exports procedures for getting the time +and runtime. + +A jiffy is an implementation specific time unit. + address@hidden {Scheme Procedure} current-second address@hidden {Scheme Procedure} current-jiffy +Return the number of seconds since 1970-01-01 00:00:00 UTC, excluding +leap seconds, as an inexact or the number of jiffies elapsed since the +start of the interpreter as an exact. + address@hidden is equivalent to @code{get-internal-real-time}; address@hidden address@hidden deffn + address@hidden {Scheme Procedure} jiffies-per-second +Return the number of jiffies defined to be a second. It is quivalent to address@hidden; @xref{Time}. address@hidden deffn + + address@hidden scheme write address@hidden scheme write + +The @code{(scheme write)} library exports procedures to write scheme +objects. + address@hidden {Scheme Procedure} display obj [port] address@hidden {Scheme Procedure} write obj [port] +These procedures are identical to the ones provided by Guile's core +library. @xref{Venerable Port Interfaces}, and @xref{Scheme Write}, for +documentation. address@hidden deffn + address@hidden {Scheme Procedure} write-shared obj [port] address@hidden {Scheme Procedure} write-simple obj [port] +Write @var{obj} to @var{port} (default is current output) using +different methods to handle cyclic structures and duplicate data. + address@hidden uses datums to represent every duplicate scheme +object represented by locations instead of values. It is equivalent to address@hidden; @xref{SRFI-38}. + address@hidden should not use datums to represent duplicate +scheme objects of any sort including cyclic references. If @var{obj} +is cyclic, calling this procedure should hang. However, at the +present time, @code{write-simple} is an alias for @var{write} so this +behavior is not produced. address@hidden deffn + + address@hidden scheme r5rs address@hidden scheme r5rs + +The @code{(scheme r5rs)} library exports a compatibility layer for R5RS +Scheme. Every procedure and syntax in R5RS is exported except address@hidden and @code{transcript-off}. + + address@hidden r7rs.texi ends here + address@hidden Local Variables: address@hidden TeX-master: "guile.texi" address@hidden End: diff --git a/module/Makefile.am b/module/Makefile.am index 67f041d..b06947f 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -238,6 +238,23 @@ SOURCES = \ oop/goops/accessors.scm \ oop/goops/simple.scm \ \ + scheme/base.scm \ + scheme/case-lambda.scm \ + scheme/char.scm \ + scheme/complex.scm \ + scheme/cxr.scm \ + scheme/eval.scm \ + scheme/file.scm \ + scheme/inexact.scm \ + scheme/lazy.scm \ + scheme/load.scm \ + scheme/process-context.scm \ + scheme/r5rs.scm \ + scheme/read.scm \ + scheme/repl.scm \ + scheme/time.scm \ + scheme/write.scm \ + \ scripts/compile.scm \ scripts/disassemble.scm \ scripts/display-commentary.scm \ diff --git a/module/scheme/base.scm b/module/scheme/base.scm new file mode 100644 index 0000000..6391ba4 --- /dev/null +++ b/module/scheme/base.scm @@ -0,0 +1,598 @@ +;;; base.scm --- The R7RS-small base library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme base) + #:re-export (* + + + - + / + < + <= + = + > + >= + abs + and + append + apply + assoc + assq + assv + begin + binary-port? + boolean=? + boolean? + bytevector-copy + bytevector-length + bytevector-u8-ref + bytevector-u8-set! + bytevector? + caar + cadr + call-with-current-continuation + call-with-port + call-with-values + call/cc + car + case + cdar + cddr + cdr + ceiling + char->integer + char-ready? + char<=? + char=? + char>? + char? + close-input-port + close-output-port + close-port + complex? + cond + cond-expand + cons + current-error-port + current-input-port + current-output-port + define + define-record-type + define-syntax + define-values + denominator + do + dynamic-wind + eof-object + eof-object? + eq? + equal? + eqv? + error-object-irritants + error-object-message + error-object? + even? + exact + exact-integer-sqrt + exact-integer? + exact? + expt + floor + floor-quotient + floor-remainder + floor/ + flush-output-port + for-each + gcd + get-output-string + guard + if + inexact + inexact? + input-port? + integer->char + integer? + lambda + lcm + length + let + let* + let*-values + let-syntax + let-values + letrec + letrec* + letrec-syntax + list + list->string + list->vector + list-copy + list-ref + list-set! + list-tail + list? + make-bytevector + make-list + make-parameter + make-string + make-vector + map + max + member + memq + memv + min + modulo + negative? + newline + not + null? + number->string + number? + numerator + odd? + open-input-bytevector + open-input-string + open-output-string + or + output-port? + pair? + parameterize + peek-char + port? + positive? + procedure? + quasiquote + quote + quotient + raise + raise-continuable + rational? + rationalize + read-char + real? + remainder + reverse + round + set! + set-car! + set-cdr! + string + string->list + string->number + string->symbol + string-append + string-copy + string-copy! + string-fill! + string-length + string-ref + string-set! + string<=? + string=? + string>? + string? + substring + symbol->string + symbol=? + symbol? + syntax-error + syntax-rules + textual-port? + truncate + truncate-quotient + truncate-remainder + truncate/ + u8-ready? + unless + unquote + unquote-splicing + values + vector + vector->list + vector-append + vector-copy + vector-copy! + vector-fill! + vector-for-each + vector-length + vector-map + vector-ref + vector-set! + vector? + when + with-exception-handler + write-char + zero?) + #:export (bytevector + bytevector-append + bytevector-copy! + error + features + file-error? + get-output-bytevector + include + include-ci + input-port-open? + open-output-bytevector + output-port-open? + peek-u8 + read-bytevector + read-bytevector! + read-error? + read-line + read-string + read-u8 + square + string->utf8 + string->vector + utf8->string + vector->string + write-bytevector + write-string + write-u8) + #:replace (string-map string-for-each) + #:duplicates (last) + #:use-module ((guile)) + #:use-module ((guile) #:select ((inexact->exact . exact) (exact->inexact . inexact) + (force-output . flush-output-port) (include . guile-include) + (error . guile-error))) + #:use-module ((ice-9 ports) #:select (char-ready? (char-ready? . u8-ready?))) + #:use-module ((ice-9 rdelim) #:select ((read-line . guile-read-line))) + #:use-module ((rnrs base) #:select (boolean=? let*-values let-values symbol=?)) + #:use-module ((rnrs lists) #:select (find)) + #:use-module ((rnrs io ports) + #:select (binary-port? call-with-port eof-object eof-object? + get-bytevector-n + get-bytevector-n! + get-string-n + get-u8 + i/o-error-port + i/o-file-already-exists-error? + i/o-file-does-not-exist-error? + i/o-file-is-read-only-error? + i/o-filename-error? + i/o-file-protection-error? + i/o-read-error? + input-port? + lookahead-u8 + make-custom-binary-output-port + make-transcoder + (open-bytevector-input-port . open-input-bytevector) + open-bytevector-output-port + output-port? + port-position + put-bytevector + put-string + put-u8 + set-port-position! + textual-port?)) + #:use-module ((rnrs bytevectors) #:select ((bytevector-copy! . r6rs-bytevector-copy!) + bytevector-copy bytevector-length + bytevector-u8-ref bytevector-u8-set! + bytevector? make-bytevector + (string->utf8 . r6rs-string->utf8) + (utf8->string . r6rs-utf8->string) + u8-list->bytevector)) + #:use-module ((rnrs exceptions)) + #:use-module ((rnrs conditions) #:select ((condition-message . error-object-message) + (error? . error-object?) + (condition-irritants . error-object-irritants) + condition + condition? condition-who + make-message-condition make-who-condition + make-irritants-condition)) + #:use-module ((srfi srfi-1) #:select (assoc member)) + #:use-module ((srfi srfi-9)) + #:use-module ((srfi srfi-43) #:select (vector->list vector-append vector-copy! vector-map + vector-for-each))) + +(define (bytevector . args) + "- Scheme Procedrure: bytevector byte1 byte2 ... + Returns a newly allocated bytevector consisting of the unsigned 8-bit + integers given as arguments." + (u8-list->bytevector args)) + +(define bytevector-copy! + (case-lambda + "- Scheme Procedrure: bytevector-copy! target target-start source [source-start [source-end]] + Copies bytevector @var{source} into bytevector @var{target} at index + @var{target-start}. @{source} is copied starting from index @var{source-start} + (default is 0) up to index @var{source-end} (default is end of bytevector). + The argument order is different than the R6RS procedure of the same name." + ((target target-start source) + (r6rs-bytevector-copy! source 0 target target-start (bytevector-length source))) + ((target target-start source source-start) + (r6rs-bytevector-copy! source source-start target target-start + (- (bytevector-length source) source-start))) + ((target target-start source source-start source-end) + (r6rs-bytevector-copy! source source-start target target-start (- source-end source-start))))) + +(define (bytevector-append . args) + "- Scheme Procedrure: bytevector-append bv1 bv2 ... + Appends all the given bytevectors in order and returns the resulting new bytevector." + (let* ((lengths (map bytevector-length args)) + (bv (make-bytevector (if (null? lengths) 0 (apply + lengths))))) + (let loop ((start 0) (vecs args) (lens lengths)) + (if (null? vecs) bv + (begin + (bytevector-copy! bv start (car vecs)) + (loop (+ start (car lens)) (cdr vecs) (cdr lens))))))) + +(define string->utf8 + (case-lambda + "- Scheme Procedrure: string->utf8 s [start [end]] + Convert string @var{s} of characters to a bytevector using utf-8 encoding + starting from index @var{start} (default 0) to index @var{end} (default is + end of @var{s})." + ((s) (string->utf8 s 0)) + ((s start) (string->utf8 s 0 (string-length s))) + ((s start end) (r6rs-string->utf8 (substring s start end))))) + +(define (utf8->string . args) + "- Scheme Procedrure: utf8->string bv [start [end]] + Convert bytevector @var{bv} to a stringr using utf-8 encoding starting + from index @var{start} (default 0) to index @var{end} (default is end of + @var{bv})." + (r6rs-utf8->string (apply bytevector-copy args))) + +(define-syntax error + (syntax-rules () + "- Scheme Procedrure: error message irritant1 ... + Throws an error with the specified @var{message} and @var{irritants}. Note + that the syntax is different than the R6RS procedures of the same name." + ((error message . irritants) (guile-error #f message . irritants)))) + + +(define (features) + "- Scheme Procedrure: features + Returns the list of features available/supported in cond-expand." + (list-copy %cond-expand-features)) + + +;;; TODO +;;; +;;; It likely won't catch all such errors, so this procedure may give incorrect +;;; results. +(define (read-error? obj) + "- Scheme Procedrure: read-error? obj + Returns whether @var{obj} was an error object raised by @code{read} or + not." + (or (i/o-read-error? obj) + (and (condition? obj) (string? (condition-who obj)) + (string=? "read" (condition-who obj))))) + + +;;; TODO +;;; +;;; It won't catch all such errors, only those produced by R6RS file openings, +;;; so if using other file opening procedures, this procedure may give +;;; incorrect results. +(define (file-error? obj) + "- Scheme Procedrure: file-error? + Returns whether @var{obj} was an error object raised by a file opening + or not." + (or (i/o-file-already-exists-error? obj) + (i/o-file-does-not-exist-error? obj) + (i/o-file-is-read-only-error? obj) + (i/o-filename-error? obj) + (i/o-file-protection-error? obj))) + + +(define (input-port-open? port) + "- Scheme Procedrure: input-port-open? port + Returns whether @var{port} is an open input port or not." + (and (input-port? port) (not (port-closed? port)))) + +(define (output-port-open? port) + "- Scheme Procedrure: output-port-open? port + Returns whether @var{port} is an open output port or not." + (and (output-port? port) (not (port-closed? port)))) + +(define* (peek-u8 #:optional (port (current-input-port))) + "- Scheme Procedrure: peak-u8 [port] + Read the next byte from @var{port} (default is current input) without + updating the file position." + (lookahead-u8 port)) + +(define* (read-bytevector count #:optional (port (current-input-port))) + "- Scheme Procedrure: read-bytevector count [port] + Read @var{count} bytes, or till end of file, from binary input port + @var{port} (default is current input) and returns them in a new + bytevector." + (get-bytevector-n port count)) + +(define read-bytevector! + (case-lambda + "- Scheme Procedrure: read-bytevector! bv [port [start [end]]] + Read bytes from @var{port} (default is current input) into bytevector + @var{bv} starting at index @var{start} (default is 0) up to index @var{end} + (default is end of @var{bv}) until the desired number of bytes are read or + the end of the file is reached. Returns the number of bytes read." + ((bv) (read-bytevector! bv (current-input-port))) + ((bv port) (read-bytevector! bv port 0)) + ((bv port start) (read-bytevector! bv port start (bytevector-length bv))) + ((bv port start end) (get-bytevector-n! port bv start (- end start))))) + +(define* (read-line #:optional (port (current-input-port))) + "- Scheme Procedrure: read-line [port] + Read and return as a string one line (including linefeed or end of file) + from @var{port} (default is current input)." + (guile-read-line port 'concat)) + +(define* (read-string count #:optional (port (current-input-port))) + "- Scheme Procedrure: read-string count [port] + Read and return a string of @var{count} characters (or less if the end of + file is reached) from @var{port} (default is current input)." + (get-string-n port count)) + +(define* (read-u8 #:optional (port (current-input-port))) + "- Scheme Procedrure: read-u8 [port] + Read the next byte from @var{port} (default is current input)." + (get-u8 port)) + +(define (square z) + "- Scheme Procedrure: square z + Returns the square of @var{z}." + (* z z)) + +(define string->vector + (case-lambda + "- Scheme Procedrure: string->vector s [start [end]] + Convert string @var{s} to a vector of its characters starting from index + @var{start} (default 0) to index @var{end} (default is end of @var{s})." + ((s) (string->vector s 0)) + ((s start) (string->vector s start (string-length s))) + ((s start end) (list->vector (string->list s start end))))) + +(define vector->string + (case-lambda + "- Scheme Procedrure: vector->string v [start [end]] + Convert vector @var{v} of characters to a string starting from index + @var{start} (default 0) to index @var{end} (default is end of @var{v})." + ((v) (vector->string v 0)) + ((v start) (vector->string v start (vector-length v))) + ((v start end) (list->string (vector->list v start end))))) + +(define (string-map proc . args) + "- Scheme Procedrure: string-map proc string1 ... + Applies @var{proc} (which must return a single character) elementwise to + the elements of the argument strings and returns the string composed of + the outputs in the same way @code{map} does for lists." + (list->string (apply map (cons proc (map string->list args))))) + +(define (string-for-each proc . args) + "- Scheme Procedrure: string-for-each proc string1 ... + Applies @var{proc} elementwise to the elements of the argument strings for + the side effects in the same way @code{for-each} does for lists." + (apply for-each (cons proc (map string->list args)))) + +(define write-bytevector + (case-lambda + "- Scheme Procedrure: write-bytevector bv [port [start [end]]] + Write bytes to @var{port} (default is current output) from bytevector + @var{bv} starting at index @var{start} (default is 0) up to index @var{end} + (default is end of @var{bv})." + ((bv) (write-bytevector bv (current-input-port))) + ((bv port) (write-bytevector bv port 0)) + ((bv port start) (write-bytevector bv port start (bytevector-length bv))) + ((bv port start end) (put-bytevector port bv start (- end start))))) + +(define write-string + (case-lambda + "- Scheme Procedrure: write-string s [port [start [end]]] + Write characters to @var{port} (default is current output) from string + @var{s} starting at index @var{start} (default is 0) up to index @var{end} + (default is end of @var{s})." + ((s) (write-string s (current-input-port))) + ((s port) (write-string s port 0)) + ((s port start) (write-string s port start (string-length s))) + ((s port start end) (put-string port s start (- end start))))) + +(define* (write-u8 byte #:optional (port (current-input-port))) + "- Scheme Procedrure: write-u8 byte [port] + Write the byte @var{byte} to @var{port} (default is current output)." + (put-u8 port byte)) + +(define-syntax lowlevel-include + (syntax-rules () + "- Scheme Syntax: lowlevel-include filename1 ... + Include the scheme filenames provided in order." + ((include filename) (guile-include filename)) + ((include filename1 filename2 . filenames) (begin (guile-include filename1) + (include filename2 . filenames))))) + +;;; TODO +;;; +;;; This is a hack and there are likely unusual cases that will break it. +(define-syntax include + (syntax-rules () + "- Scheme Syntax: include filename1 ... + Case sensitive include the scheme filenames provided in order." + ((include-ci . filenames) + (let* ((option 'case-insensitive) + (was-set (symbol? (find (lambda (v) (symbol=? option v)) (read-options))))) + (dynamic-wind (lambda () (read-disable option)) + (lambda () (include . args)) + (lambda () (read-set! option was-set))))))) + +(define-syntax include-ci + (syntax-rules () + "- Scheme Syntax: include-ci filename1 ... + Case insensitive include the scheme filenames provided in order." + ((include-ci . filenames) + (let* ((option 'case-insensitive) + (was-set (symbol? (find (lambda (v) (symbol=? option v)) (read-options))))) + (dynamic-wind (lambda () (read-enable option)) + (lambda () (include . args)) + (lambda () (read-set! option was-set))))))) + + +;;; TODO +;;; +;;; This is an ugly hack that will need to be improved. +;;; +;;; Unlike string output ports which have a procedure that can read the +;;; contents of any string output port given to it (get-output-string), +;;; bytevector output ports have no such general procedure. Instead, the +;;; only way provided by libguile to read them is the port specific +;;; reading thunk returned with an opened port by open-bytevector-output-port. +;;; +;;; +;;; In order to imitate a general bytevector output port reading procedure, +;;; the reading thunk isput into a global hashtable using the port as the +;;; key. The reading procedure, when handed the port, looks up the reading thunk +;;; in the hashtable and runs it. Unfortunately, old closed ports do not get +;;; removed from the table unless the table is explicitly iterated through to +;;; remove them. This is done every time open-output-bytevector is called. + +(define *bytevector-output-ports-table* + (make-hash-table)) + +(define (remove-closed-bytevector-output-ports) + (let ((closeds '())) + (hash-for-each (lambda (key value) (if (port-closed? key) (set! closeds (cons key closeds)))) + *bytevector-output-ports-table*) + (for-each (lambda (key) (hash-remove! *bytevector-output-ports-table* key)) closeds))) + +(define (open-output-bytevector) + "- Scheme Procedrure: open-output-bytevector + Returns an open binary bytevector output port." + (remove-closed-bytevector-output-ports) + (let-values (((port reader) (open-bytevector-output-port))) + (hash-set! *bytevector-output-ports-table* port reader) + port)) + +(define (get-output-bytevector port) + "- Scheme Procedrure: get-output-bytevector port + Returns a bytevector containing all the bytes written so far into the + bytevector output port @var{port}." + (let ((handle (hash-get-handle *bytevector-output-ports-table* port))) + (if handle + (let ((bv ((cdr handle)))) + ;; Need to write back because the reader clears the port. + (write-bytevector bv port) + bv) + (raise (i/o-error-port (condition + (make-who-condition "get-output-bytevector") + (make-message-condition "not an output-bytevector port") + (make-irritants-condition port))))))) diff --git a/module/scheme/case-lambda.scm b/module/scheme/case-lambda.scm new file mode 100644 index 0000000..6cbe925 --- /dev/null +++ b/module/scheme/case-lambda.scm @@ -0,0 +1,23 @@ +;;; case-lambda.scm --- The R7RS-small case-lambda library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme case-lambda) + #:re-export (case-lambda) + #:duplicates (check) + #:use-module ((guile))) diff --git a/module/scheme/char.scm b/module/scheme/char.scm new file mode 100644 index 0000000..628406f --- /dev/null +++ b/module/scheme/char.scm @@ -0,0 +1,73 @@ +;;; char.scm --- The R7RS-small char library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Everything except digit-value is in (rnrs unicode). + +(define-module (scheme char) + #:re-export (char-alphabetic? + char-ci<=? + char-ci=? + char-ci>? + char-downcase + char-foldcase + char-lower-case? + char-numeric? + char-upcase + char-upper-case? + char-whitespace? + string-ci<=? + string-ci=? + string-ci>? + string-downcase + string-foldcase + string-upcase) + #:export (digit-value) + #:duplicates (check) + #:use-module ((rnrs unicode)) + #:use-module ((ice-9 unicode)) + #:use-module ((srfi srfi-1) #:select (last))) + + +;;; digit-value needs to be able to convert digit characters to their respective +;;; numbers for more than just the ASCII digits (many other unicode characters +;;; are digits). The char->formal-name procedure in (ice-9 unicode) returns the +;;; the formal unicode name of the character. For example, the name of #\8 is +;;; "DIGIT EIGHT" and the name of #\рек is "DEVANAGARI DIGIT FOUR". The +;;; common feature is that the last word of their formal names indicates their +;;; value, which can be obtained by splitting the name about spaces and grabbing +;;; the last part and then using that as a key for lookup in an alist. + +;;; An alist to lookup numbers from digit names. +(define *digit-names* '(("zero" . 0) ("one" . 1) ("two" . 2) ("three" . 3) ("four" . 4) + ("five" . 5) ("six" . 6) ("seven" . 7) ("eight" . 8) ("nine" . 9))) + +(define (digit-value c) + "- Scheme Procedrure: digit-value c + Returns the numeric value of @var{c} if @var{c} is a decimal numeric digit + (includes digits from several scripts in addition to Latin script), or + @code{#f} if it is any other character." + (if (not (char? c)) #f + (let ((name (char->formal-name c))) + (if (not (string? name)) #f + (let* ((last-word-of-name (last (string-split name #\space))) + (value (assoc (string-downcase last-word-of-name) *digit-names*))) + (if value (cdr value) value)))))) diff --git a/module/scheme/complex.scm b/module/scheme/complex.scm new file mode 100644 index 0000000..2e47c14 --- /dev/null +++ b/module/scheme/complex.scm @@ -0,0 +1,23 @@ +;;; complex.scm --- The R7RS-small complex library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme complex) + #:re-export (angle imag-part magnitude make-polar make-rectangular real-part) + #:duplicates (check) + #:use-module ((guile))) diff --git a/module/scheme/cxr.scm b/module/scheme/cxr.scm new file mode 100644 index 0000000..e1a99a2 --- /dev/null +++ b/module/scheme/cxr.scm @@ -0,0 +1,46 @@ +;;; cxr.scm --- The R7RS-small cxr library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme cxr) + #:re-export (caaaar + caaadr + caaar + caadar + caaddr + caadr + cadaar + cadadr + cadar + caddar + cadddr + caddr + cdaaar + cdaadr + cdaar + cdadar + cdaddr + cdadr + cddaar + cddadr + cddar + cdddar + cddddr + cdddr) + #:duplicates (check) + #:use-module ((guile))) diff --git a/module/scheme/eval.scm b/module/scheme/eval.scm new file mode 100644 index 0000000..e3aa49a --- /dev/null +++ b/module/scheme/eval.scm @@ -0,0 +1,23 @@ +;;; eval.scm --- The R7RS-small eval library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme eval) + #:re-export (environment eval) + #:duplicates (check) + #:use-module ((rnrs eval))) diff --git a/module/scheme/file.scm b/module/scheme/file.scm new file mode 100644 index 0000000..f27e1b0 --- /dev/null +++ b/module/scheme/file.scm @@ -0,0 +1,36 @@ +;;; file.scm --- The R7RS-small file library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme file) + #:re-export (call-with-input-file + call-with-output-file + delete-file + file-exists? + open-binary-input-file + open-binary-output-file + open-input-file + open-output-file + with-input-from-file + with-output-to-file) + #:duplicates (last) + #:use-module ((rnrs io simple)) + #:use-module ((rnrs io ports) #:select ((open-file-input-port . open-binary-input-file) + (open-file-output-port . open-binary-output-file))) + #:use-module ((rnrs files))) + diff --git a/module/scheme/inexact.scm b/module/scheme/inexact.scm new file mode 100644 index 0000000..4e3c9bd --- /dev/null +++ b/module/scheme/inexact.scm @@ -0,0 +1,25 @@ +;;; inexact.scm --- The R7RS-small inexact library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme inexact) + #:re-export (acos asin atan cos exp finite? infinite? log nan? sin sqrt tan) + #:duplicates (check) + #:use-module ((guile) + #:select (acos asin atan cos exp finite? log nan? sin sqrt tan + (inf? . infinite?)))) diff --git a/module/scheme/lazy.scm b/module/scheme/lazy.scm new file mode 100644 index 0000000..087bfcd --- /dev/null +++ b/module/scheme/lazy.scm @@ -0,0 +1,35 @@ +;;; lazy.scm --- The R7RS-small lazy library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Using SRFI-45 since the eager and lazy procedures are needed, which makes +;;; sense given R7RS-small directly states that promises were enhanced based +;;; on SRFI-45. + +(define-module (scheme lazy) + #:re-export (delay force delay-force promise?) + #:replace (make-promise) + #:duplicates (last) + #:use-module ((srfi srfi-45) + #:select (eager delay force promise? (lazy . delay-force)))) + +(define (make-promise value) + "- Scheme Procedrure: make-promise value + Returns a promise that will return @var{value} when forced, or in the case + that @var{value} is a promise it returns @var{value}. Note, if @var{value} + is an expression, it is evaluated first." + (if (promise? value) value (eager value))) diff --git a/module/scheme/load.scm b/module/scheme/load.scm new file mode 100644 index 0000000..3d3feb5 --- /dev/null +++ b/module/scheme/load.scm @@ -0,0 +1,36 @@ +;;; load.scm --- The R7RS-small load library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme load) + #:re-export (load) + #:duplicates (check) + #:use-module ((guile) #:select ((load . guile-load))) + #:use-module ((scheme eval))) + + +;;; Copied Mark H Weaver commit +;;; 2d76447bda2f3d61c94d80b3b78732648a0a511d in the r7rs-wip branch. +(define* (load filename #:optional (env (interaction-environment))) + "- Scheme Procedrure: load filename [env] + Loads the file @var{filename} into the environment @var{env} (default is + @code{(interaction-environment)}." + (save-module-excursion + (lambda () + (set-current-module env) + (guile-load filename)))) diff --git a/module/scheme/process-context.scm b/module/scheme/process-context.scm new file mode 100644 index 0000000..5626d1b --- /dev/null +++ b/module/scheme/process-context.scm @@ -0,0 +1,29 @@ +;;; process-context.scm --- The R7RS-small process-context library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Environmental variable access is done with the SRFI-98 procedures. The rest +;;; of the required functionality is in the guile module. + + +(define-module (scheme process-context) + #:re-export (command-line emergency-exit exit get-environment-variable get-environment-variables) + #:duplicates (check) + #:use-module ((srfi srfi-98)) + #:use-module ((guile) #:select (command-line + exit + (primitive-exit . emergency-exit)))) diff --git a/module/scheme/r5rs.scm b/module/scheme/r5rs.scm new file mode 100644 index 0000000..b899cfa --- /dev/null +++ b/module/scheme/r5rs.scm @@ -0,0 +1,247 @@ +;;; r5rs.scm --- The R7RS-small R5RS compatibility library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Just re-exports all the r5rs symbols from the guile module as well as +;;; null-environment (ice-9 safe-r5rs) and scheme-report-environment +;;; (ice-9 r5rs). Sorted list of (scheme r5rs) symbols copy and pasted from +;;; R7RS-small report. + +(define-module (scheme r5rs) + #:re-export (< + <= + = + > + >= + - + / + * + + + abs + acos + and + angle + append + apply + asin + assoc + assq + assv + atan + begin + boolean? + caaaar + caaadr + caaar + caadar + caaddr + caadr + caar + cadaar + cadadr + cadar + caddar + cadddr + caddr + cadr + call-with-current-continuation + call-with-input-file + call-with-output-file + call-with-values + car + case + cdaaar + cdaadr + cdaar + cdadar + cdaddr + cdadr + cdar + cddaar + cddadr + cddar + cdddar + cddddr + cdddr + cddr + cdr + ceiling + char<=? + char=? + char>? + char? + char-alphabetic? + char-ci<=? + char-ci=? + char-ci>? + char-downcase + char->integer + char-lower-case? + char-numeric? + char-ready? + char-upcase + char-upper-case? + char-whitespace? + close-input-port + close-output-port + complex? + cond + cons + cos + current-input-port + current-output-port + define + define-syntax + delay + denominator + display + do + dynamic-wind + eof-object? + eq? + equal? + eqv? + eval + even? + exact? + exact->inexact + exp + expt + floor + force + for-each + gcd + if + imag-part + inexact? + inexact->exact + input-port? + integer? + integer->char + interaction-environment + lambda + lcm + length + let + let* + letrec + letrec-syntax + let-syntax + list + list? + list-ref + list->string + list-tail + list->vector + load + log + magnitude + make-polar + make-rectangular + make-string + make-vector + map + max + member + memq + memv + min + modulo + negative? + newline + not + null? + null-environment + number? + number->string + numerator + odd? + open-input-file + open-output-file + or + output-port? + pair? + peek-char + positive? + procedure? + quasiquote + quote + quotient + rational? + rationalize + read + read-char + real? + real-part + remainder + reverse + round + scheme-report-environment + set! + set-car! + set-cdr! + sin + sqrt + string + string<=? + string=? + string>? + string? + string-append + string-ci<=? + string-ci=? + string-ci>? + string-copy + string-fill! + string-length + string->list + string->number + string-ref + string-set! + string->symbol + substring + symbol? + symbol->string + syntax-rules + tan + truncate + values + vector + vector? + vector-fill! + vector-length + vector->list + vector-ref + vector-set! + with-input-from-file + with-output-to-file + write + write-char + zero?) + #:duplicates (check) + #:use-module ((ice-9 safe-r5rs) #:select (null-environment)) + #:use-module ((ice-9 r5rs) #:select (scheme-report-environment)) + #:use-module ((guile))) + diff --git a/module/scheme/read.scm b/module/scheme/read.scm new file mode 100644 index 0000000..caa8c08 --- /dev/null +++ b/module/scheme/read.scm @@ -0,0 +1,23 @@ +;;; read.scm --- The R7RS-small read library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme read) + #:re-export (read) + #:duplicates (last) + #:use-module ((rnrs io simple) #:select (read))) diff --git a/module/scheme/repl.scm b/module/scheme/repl.scm new file mode 100644 index 0000000..5e3bf92 --- /dev/null +++ b/module/scheme/repl.scm @@ -0,0 +1,23 @@ +;;; repl.scm --- The R7RS-small repl library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (scheme repl) + #:re-export (interaction-environment) + #:duplicates (check) + #:use-module ((guile))) diff --git a/module/scheme/time.scm b/module/scheme/time.scm new file mode 100644 index 0000000..f896ac0 --- /dev/null +++ b/module/scheme/time.scm @@ -0,0 +1,47 @@ +;;; time.scm --- The R7RS-small time library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; A jiffy is going to be defined as the unit of +;;; internal-time-units-per-second. The arbitrary start epoch for jiffies +;;; will be when the interpreter was started (will use get-internal-real-time). + + +(define-module (scheme time) + #:export (current-second current-jiffy jiffies-per-second) + #:duplicates (check) + #:use-module ((guile))) + +(define (current-second) + "- Scheme Procedrure: current-second + Return the number of seconds since 1970-01-01 00:00:00 UTC, excluding leap + seconds, as an inexact." + (let ((time (gettimeofday))) + (+ (exact->inexact (car time)) (* 1e-6 (cdr time))))) + +(define (jiffies-per-second) + "- Scheme Procedrure: jiffies-per-second + Return the number of jiffies defined to be a second." + internal-time-units-per-second) + +(define (current-jiffy) + "- Scheme Procedrure: current-jiffy + Return the number of jiffies elapsed since the start of the interpreter as + an exact." + (get-internal-real-time)) + + diff --git a/module/scheme/write.scm b/module/scheme/write.scm new file mode 100644 index 0000000..68af115 --- /dev/null +++ b/module/scheme/write.scm @@ -0,0 +1,31 @@ +;;; write.scm --- The R7RS-small write library + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (scheme write) + #:re-export (display write write-shared) + #:export (write-simple) + #:duplicates (check) + #:use-module ((guile)) + #:use-module ((srfi srfi-38) #:select ((write-with-shared-structure . write-shared)))) + +;;; TODO +;;; +;;; Just assigning write from (guile) to write-simple, which will use datum labels +;;; for cyclic structures instead of the proper behavior of never terminating. +(define write-simple write) + diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 3ce9070..775feb4 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -116,6 +116,10 @@ SCM_TESTS = tests/00-initial-env.test \ tests/r6rs-records-syntactic.test \ tests/r6rs-unicode.test \ tests/rnrs-libraries.test \ + tests/r7rs-base.test \ + tests/r7rs-char.test \ + tests/r7rs-lazy.test \ + tests/r7rs-time.test \ tests/array-map.test \ tests/random.test \ tests/rdelim.test \ diff --git a/test-suite/tests/r7rs-base.test b/test-suite/tests/r7rs-base.test new file mode 100644 index 0000000..662514d --- /dev/null +++ b/test-suite/tests/r7rs-base.test @@ -0,0 +1,339 @@ +;;; r7rs-base.test --- Test suite for R7RS (scheme base) + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (test-suite test-r7rs-base) + :use-module ((scheme base)) + :use-module ((scheme char)) + :use-module ((scheme file)) + :use-module ((rnrs bytevectors) #:select (bytevector->u8-list u8-list->bytevector)) + :use-module ((rnrs io ports) #:select (port-position make-i/o-filename-error)) + :use-module ((srfi srfi-1)) + :use-module (test-suite lib)) + + +(define thai-digits "\u0E50\u0E51\u0E52\u0E53\u0E54\u0E55\u0E56\u0E57\u0E58\u0E59") + +;;; Conversion gotten using CPython 3.5.2 +(define thai-digits-utf8 #vu8(224 185 144 224 185 145 224 185 146 224 185 147 224 185 148 224 + 185 149 224 185 150 224 185 151 224 185 152 224 185 153)) + +(define (grab-error thunk) + (let ((obj '())) + (guard (con ((= 1 1) (set! obj con))) (thunk)) + obj)) + + +(with-test-prefix "read-error?" + (pass-if "read-error? true" (read-error? (grab-error (lambda () (read "blaf8vhe"))))) + (pass-if "read-error? false for integer" (not (read-error? -4))) + (pass-if "read-error? false for file error" (not (read-error? (make-i/o-filename-error "hal"))))) + +(with-test-prefix "file-error?" + (pass-if "file-error? true" (file-error? (make-i/o-filename-error "hal"))) + (pass-if "file-error? false for integer" (not (file-error? -4))) + (pass-if "file-error? false for read error" + (not (file-error? (grab-error (lambda () (read "blaf8vhe"))))))) + +(with-test-prefix "features" + (pass-if "features list" (list? (features))) + (pass-if "features equal to %cond-expand-features" + (list= symbol=? (features) %cond-expand-features))) + +(with-test-prefix "square" + (pass-if "square same as (* x x)" + (let ((nums (append '(8.0 3/4 -3.3 -8) (iota 100)))) + (list= = (map square nums) (map (lambda (x) (* x x)) nums))))) + +(with-test-prefix "string->vector" + (pass-if "string->vector vector" (vector? (string->vector "aivi38vaAfva8hga#$"))) + (pass-if "string->vector compare to string->list" + (let ((s "a9vaEAva88nn4 aaiavAv aieavafa==34\av aA#$a")) + (list= char=? (vector->list (string->vector s)) (string->list s))))) + +(with-test-prefix "vector->string" + (pass-if "vector->string string" (string? (vector->string #(#\a #\b #\c #\d)))) + (pass-if "vector->string compare to vector->list" + (let ((v #(#\a #\5 #\E #\% #\space))) + (list= char=? (string->list (vector->string v)) (vector->list v))))) + +(with-test-prefix "string->utf8" + (pass-if "string->utf8 bytevector" (bytevector? (string->utf8 "a9v3naaviavaF#aavi3A\u0E59"))) + (pass-if "string->utf8 ascii digits" + (list= = (bytevector->u8-list (string->utf8 "0123456789")) (iota 10 48))) + (pass-if "string->utf8 length increases for non-ascii" + (let ((s thai-digits)) + (> (bytevector-length (string->utf8 s)) (string-length s))))) + +(with-test-prefix "utf8->string" + (pass-if "utf8->string string" (string? (utf8->string (u8-list->bytevector (iota 10 48))))) + (pass-if "utf8->string length decreases for non-ascii" + (let ((bv thai-digits-utf8)) + (> (bytevector-length bv) (string-length (utf8->string bv))))) + (pass-if "utf8->string works for Thai digits" (string=? (utf8->string thai-digits-utf8) thai-digits))) + +(with-test-prefix "string-map" + (pass-if "string-map char-downcase" + (let ((s "aavieEAIVAeaneai#aa9va#$")) + (string=? (string-map char-downcase s) (string-downcase s)))) + (pass-if "string-map selective char grab" + (let ((s1 "ueANezvfiHviae") + (s2 "UEanEZVFIhVIAE")) + (string=? (string-upcase s1) (string-map (lambda (x y) (if (char>? x y) y x)) s1 s2))))) + +(with-test-prefix "string-for-each" + (pass-if "string-for-each look for char" + (let ((s "avienfvavRau3$ava8vae#Afa") + (chr #\R) + (found #f)) + (string-for-each (lambda (c)(if (char=? chr c) (set! found #t))) s) + found))) + +(with-test-prefix "bytevector" + (pass-if "bytevector bytevector" (bytevector? (bytevector 3 9 32 204))) + (pass-if "bytevector apply to u8 list" + (let ((lst '(3 48 110 30 253 0))) + (list= = (bytevector->u8-list (apply bytevector lst)) lst)))) + +(with-test-prefix "bytevector-append" + (pass-if "bytevector-append bytevector" (bytevector? (bytevector-append #vu8(3 2) #vu8(90)))) + (pass-if "bytevector-append three u8 lists" + (let ((lst1 '(38 8 20 0 255)) + (lst2 '(82)) + (lst3 '(5 9 200 138))) + (list= = (append lst1 lst2 lst3) + (bytevector->u8-list (bytevector-append (u8-list->bytevector lst1) + (u8-list->bytevector lst2) + (u8-list->bytevector lst3))))))) + +(with-test-prefix "bytevector-copy!" + (pass-if "bytevector-copy!" + (let ((bv-t #vu8(0 0 0 0 0 0 0 0)) + (bv-s #vu8(1 2 3)) + (bv-r #vu8(0 0 0 1 2 3 0 0))) + (bytevector-copy! bv-t 3 bv-s) + (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r)))) + (pass-if "bytevector-copy! with source-start" + (let ((bv-t #vu8(0 0 0 0 0 0 0 0)) + (bv-s #vu8(1 2 3)) + (bv-r #vu8(0 0 0 2 3 0 0 0))) + (bytevector-copy! bv-t 3 bv-s 1) + (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r)))) + (pass-if "bytevector-copy! with source-start and source-end" + (let ((bv-t #vu8(0 0 0 0 0 0 0 0)) + (bv-s #vu8(1 2 3)) + (bv-r #vu8(0 0 0 2 0 0 0 0))) + (bytevector-copy! bv-t 3 bv-s 1 2) + (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-r))))) + +(with-test-prefix "bytevector output port" + (pass-if "open-output-bytevector open binary output port" + (let ((p (open-output-bytevector))) + (and (port? p) (output-port? p) (binary-port? p) (not (port-closed? p))))) + (pass-if "get-output-bytevector bytevector" + (bytevector? (get-output-bytevector (open-output-bytevector)))) + (pass-if "write and read back" + (let ((p (open-output-bytevector)) + (bv #vu8(0 1 2 3 255))) + (write-bytevector bv p) + ;; Compare twice to make sure get-output-bytevector doesn't cause + ;; bytevector output port to be cleared. + (let ((read1 (get-output-bytevector p)) + (read2 (get-output-bytevector p))) + (close-port p) + (and (list= = (bytevector->u8-list bv) (bytevector->u8-list read1)) + (list= = (bytevector->u8-list bv) (bytevector->u8-list read2))))))) + +(with-test-prefix "input-port-open?" + (pass-if "input-port-open? true on open input port" + (boolean=? #t (input-port-open? (open-input-string "abeeU")))) + (pass-if "input-port-open? false on closed input port" + (let ((p (open-input-string "avie$av9a"))) + (close-port p) + (boolean=? #f (input-port-open? p)))) + (pass-if "input-port-open? false on output port" + (boolean=? #f (input-port-open? (open-output-string)))) + (pass-if "inpt-port-open? false on integer" + (boolean=? #f (input-port-open? 3)))) + +(with-test-prefix "output-port-open?" + (pass-if "output-port-open? true on open output port" + (boolean=? #t (output-port-open? (open-output-string)))) + (pass-if "output-port-open? false on closed output port" + (let ((p (open-output-string))) + (close-port p) + (boolean=? #f (output-port-open? p)))) + (pass-if "output-port-open? false on input port" + (boolean=? #f (output-port-open? (open-input-string "abeeU")))) + (pass-if "inpt-port-open? false on integer" + (boolean=? #f (output-port-open? 3)))) + +(with-test-prefix "peek-u8" + (pass-if "peek-u8 read byte and doesn't advance" + (let* ((bv #vu8(239 39 184 94 38)) + (p (open-input-bytevector bv)) + (value (peek-u8 p)) + (pos (port-position p))) + (close-port p) + (and (= pos 0) (= value (bytevector-u8-ref bv 0)))))) + +(with-test-prefix "read-u8" + (pass-if "read-u8 read byte and does advance" + (let* ((bv #vu8(239 39 184 94 38)) + (p (open-input-bytevector bv)) + (value (read-u8 p)) + (pos (port-position p))) + (close-port p) + (and (= pos 1) (= value (bytevector-u8-ref bv 0)))))) + +(with-test-prefix "write-u8" + (pass-if "write-u8 write byte and does advance" + (let ((value 47) + (p (open-output-bytevector))) + (write-u8 value p) + (and (= (port-position p) 1) + (list= = (list value) (bytevector->u8-list (get-output-bytevector p))))))) + +(with-test-prefix "read-bytevector" + (pass-if "read-bytevector read correctly" + (let* ((bv #vu8(239 39 184 94 38)) + (num-to-read 3) + (p (open-input-bytevector bv)) + (value (read-bytevector num-to-read p)) + (pos (port-position p))) + (close-port p) + (and (= pos num-to-read) (list= = (bytevector->u8-list value) + (list-head (bytevector->u8-list bv) num-to-read)))))) + +(with-test-prefix "read-bytevector!" + (pass-if "read-bytevector! read" + (let* ((bv-s #vu8(1 2 3 4 5 6)) + (bv-t #vu8(0 0 0)) + (bv-correct #vu8(1 2 3)) + (p (open-input-bytevector bv-s)) + (num-read (read-bytevector! bv-t p)) + (pos (port-position p))) + (close-port p) + (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct)) + (= pos num-read) + (= num-read (bytevector-length bv-t))))) + (pass-if "read-bytevector! read with start" + (let* ((bv-s #vu8(1 2 3 4 5 6)) + (bv-t #vu8(0 0 0)) + (bv-correct #vu8(0 1 2)) + (p (open-input-bytevector bv-s)) + (num-read (read-bytevector! bv-t p 1)) + (pos (port-position p))) + (close-port p) + (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct)) + (= pos num-read) + (= (+ 1 num-read) (bytevector-length bv-t))))) + (pass-if "read-bytevector! read with start and end" + (let* ((bv-s #vu8(1 2 3 4 5 6)) + (bv-t #vu8(0 0 0)) + (bv-correct #vu8(0 1 0)) + (p (open-input-bytevector bv-s)) + (num-read (read-bytevector! bv-t p 1 2)) + (pos (port-position p))) + (close-port p) + (and (list= = (bytevector->u8-list bv-t) (bytevector->u8-list bv-correct)) + (= pos num-read) + (= (+ 2 num-read) (bytevector-length bv-t)))))) + +(with-test-prefix "write-bytevector" + (pass-if "write-bytevector write" + (let ((bv #vu8(1 2 3 4 5 6)) + (bv-correct #vu8(1 2 3 4 5 6)) + (p (open-output-bytevector))) + (write-bytevector bv p) + (and (list= = (bytevector->u8-list (get-output-bytevector p)) (bytevector->u8-list bv-correct)) + (= (port-position p) (bytevector-length bv-correct))))) + (pass-if "write-bytevector write with start" + (let ((bv #vu8(1 2 3 4 5 6)) + (bv-correct #vu8(3 4 5 6)) + (p (open-output-bytevector))) + (write-bytevector bv p 2) + (and (list= = (bytevector->u8-list (get-output-bytevector p)) (bytevector->u8-list bv-correct)) + (= (port-position p) (bytevector-length bv-correct))))) + (pass-if "write-bytevector write with start and end" + (let ((bv #vu8(1 2 3 4 5 6)) + (bv-correct #vu8(3 4 5)) + (p (open-output-bytevector))) + (write-bytevector bv p 2 5) + (and (list= = (bytevector->u8-list (get-output-bytevector p)) (bytevector->u8-list bv-correct)) + (= (port-position p) (bytevector-length bv-correct)))))) + +(with-test-prefix "read-string" + (pass-if "read-string read" + (let* ((str-s "aiviEenvae") + (count 5) + (str-correct "aiviE") + (p (open-input-string str-s)) + (str-out (read-string count p)) + (pos (port-position p))) + (close-port p) + (and (string=? str-out str-correct) (= count (string-length str-out)) (= count pos))))) + +(with-test-prefix "write-string" + (pass-if "write-string write" + (let* ((str-s "a*viRaiv") + (str-correct str-s) + (p (open-output-string))) + (write-string str-s p) + (let ((str-out (get-output-string p)) + (pos (port-position p))) + (close-port p) + (and (string=? str-out str-correct) (= pos (string-length str-out)))))) + (pass-if "write-string write with start" + (let ((str-s "a*viRaiv") + (str-correct "iRaiv") + (p (open-output-string))) + (write-string str-s p 3) + (let ((str-out (get-output-string p)) + (pos (port-position p))) + (close-port p) + (and (string=? str-out str-correct) (= pos (string-length str-out)))))) + (pass-if "write-string write with start and end" + (let ((str-s "a*viRaiv") + (str-correct "iRa") + (p (open-output-string))) + (write-string str-s p 3 6) + (let ((str-out (get-output-string p)) + (pos (port-position p))) + (close-port p) + (and (string=? str-out str-correct) (= pos (string-length str-out))))))) + +(with-test-prefix "read-line" + (pass-if "read-line read" + (let ((p (open-output-string))) + (newline p) + (let ((linefeed (get-output-string p)) + (line1 "avaie$Ava 3fai") + (line2 "vi38va$#ava aaf ") + (po (open-output-string))) + (write-string line1 po) + (newline po) + (write-string line2 po) + (newline po) + (let* ((str-intermediate (get-output-string po)) + (pi (open-input-string str-intermediate)) + (str-out (read-line pi))) + (close-port p) + (close-port po) + (close-port pi) + (string=? str-out (string-append line1 linefeed))))))) diff --git a/test-suite/tests/r7rs-char.test b/test-suite/tests/r7rs-char.test new file mode 100644 index 0000000..7cd9b0a --- /dev/null +++ b/test-suite/tests/r7rs-char.test @@ -0,0 +1,35 @@ +;;; r7rs-char.test --- Test suite for R7RS (scheme char) + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (test-suite test-r7rs-char) + :use-module ((scheme char)) + :use-module ((srfi srfi-1)) + :use-module (test-suite lib)) + + +(define (test-zero-to-nine s) + (every equal? (iota 10) (map digit-value (string->list s)))) + +(with-test-prefix "digit-value" + (pass-if "digit-values true on ascii digits" (test-zero-to-nine "0123456789")) + (pass-if "digit-values true on Thai digits" + (test-zero-to-nine "\u0E50\u0E51\u0E52\u0E53\u0E54\u0E55\u0E56\u0E57\u0E58\u0E59")) + (pass-if "digit-values false on ascii letters" + (not (any digit-value (string->list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")))) + (pass-if "digit-values false on whitespace" (not (any digit-value (char-set->list char-set:whitespace))))) diff --git a/test-suite/tests/r7rs-lazy.test b/test-suite/tests/r7rs-lazy.test new file mode 100644 index 0000000..78dd16e --- /dev/null +++ b/test-suite/tests/r7rs-lazy.test @@ -0,0 +1,29 @@ +;;; r7rs-lazy.test --- Test suite for R7RS (scheme lazy) + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (test-suite test-r7rs-lazy) + :use-module ((scheme lazy)) + :use-module (test-suite lib)) + + +(with-test-prefix "make-promise" + (pass-if "make-promise on integer" (promise? (make-promise 3))) + (pass-if "make-promise on promise" + (let ((p (delay (+ 3.28832193 8)))) + (and (promise? p) (inexact? (force p)))))) diff --git a/test-suite/tests/r7rs-time.test b/test-suite/tests/r7rs-time.test new file mode 100644 index 0000000..6453128 --- /dev/null +++ b/test-suite/tests/r7rs-time.test @@ -0,0 +1,43 @@ +;;; r7rs-time.test --- Test suite for R7RS (scheme time) + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (test-suite test-r7rs-time) + :use-module ((scheme time)) + :use-module (test-suite lib)) + + +(with-test-prefix "jiffies-per-second" + (pass-if "jiffies-per-second integer" (integer? (jiffies-per-second))) + (pass-if "jiffies-per-second positive" (> (jiffies-per-second) 0))) + +(with-test-prefix "current-second" + (pass-if "current-second inexact" (inexact? (current-second))) + (pass-if "current-second increasing" + (let ((first-time (current-second))) + (sleep 2) + (let ((second-time (current-second))) + (< first-time second-time))))) + +(with-test-prefix "current-jiffy" + (pass-if "current-jiffy exact" (exact? (current-jiffy))) + (pass-if "current-jiffy increasing" + (let ((first-time (current-jiffy))) + (sleep 2) + (let ((second-time (current-jiffy))) + (< first-time second-time))))) -- 2.9.3