Re: [PATCH] Add preliminary versions of the R7RS libraries along with documentation and tests

[Freja Nordsiek <fnordsie@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 4513 bytes --]

Copied over the docstrings that I had written over to the existing
R7RS modules in r7rs-wip. There are still procedures that need
docstrings, though.



Freja Nordsiek

On Sat, Jun 17, 2017 at 2:02 AM, Freja Nordsiek <fnordsie@gmail.com> wrote:
> I was able to add the unit tests I had written to the r7rs-wip branch
> and run them (patch is attached). The things that they tested mostly
> worked out of the box, which is a good sign. Had to fix a couple
> errors in some of the tests (checked the R7RS-small standard and my
> tests were indeed in error).
>
> Also, I found one error in the get-output-bytevector procedure in
> (scheme base), which was that the procedure discarded the bytes
> already written. get-output-bytevector is not supposed to be
> destructive to the bytes already written, but the R6RS output
> bytevector reading procedures are destructive. I made a patch with a
> very simple fix, which is to just write the bytes back. It has one
> major problem, though, and that is it is not threadsafe, so while it
> is an improvement, there is still some more work to do on it.
>
> Next thing I am going to do is copy over the docstrings I wrote for
> code going to the bitbucket (my versions of the r7rs modules) to the
> ones already in r7rs-wip since they are lacking docstrings.
>
>
> Freja Nordsiek
>
> On Tue, May 30, 2017 at 12:02 AM, Mark H Weaver <mhw@netris.org> wrote:
>> Hi Freja,
>>
>> Freja Nordsiek <fnordsie@gmail.com> writes:
>>
>>> As far as splitting it into parts and discarding the scheme modules
>>> and keeping the documentation, that sounds like a good idea. I just
>>> did a quick perusal of the r7rs-wip branch and it does not seem to
>>> have any R7RS unit tests. Did I miss any? If not, the test code, as
>>> limited as it is, might also be useful.
>>
>> You didn't miss any.  I agree that we need a good R7RS test suite.  The
>> tests you wrote could be a useful starting point, but clearly more
>> coverage is needed.
>>
>> Some existing free R7RS Scheme implementations include test suites that
>> we might be able to incorporate.  Chibi Scheme includes one which I
>> found useful while developing 'r7rs-wip', and as I vaguely recall there
>> were at least two others.  Kawa might have one.
>>
>> I think we should aim to adapt and incorporate one or more existing R7RS
>> test suites from elsewhere, if the relevant licenses are favorable.
>>
>>> As for the question/puzzlement of why I wrote all of this, that is
>>> complicated, and kind of silly in retrospect. The r7rs-wip branch
>>> looked like it was most of the way to complete but was three years
>>> behind the master branch and thus seemed like it was possibly dead for
>>> unknown reasons [...]
>>
>>> Honestly, I should have just emailed the
>>> list and what not and asked about the status of the r7rs-wip branch
>>> and why it stalled, and then go from there (e.g. write the
>>> documentation and possibly tests). I ended up duplicating a lot of
>>> effort in a sloppy way.
>>
>> I can understand this.  Unnecessarily rewriting code seems to be a
>> common tendency in our community, and I confess that I've been known to
>> do it myself.  Hopefully the work had some educational value at least.
>>
>> I would guess that the overwhelming majority of the new Scheme code in
>> 'r7rs-wip' does not depend on the C changes.
>>
>> I stalled on the 'r7rs-wip' work for a few reasons.  For a couple of
>> years, I had doubts about whether the R7RS should be promoted at all,
>> given that it is gratuitously incompatible with the R6RS, which I
>> consider to be more competently designed even though I disagree with
>> some aspects of R6RS.
>>
>> Apart from that, I encountered difficulties implementing
>> cyclic-data-aware R7RS 'write' and 'write-shared' in a way that's
>> efficient, compatible with existing APIs (custom printers, print states,
>> etc), and not too gross.  I have an idea how to fix those issues, but
>> haven't gotten around to implementing it yet.
>>
>> There are some details that are not yet addressed, e.g. supporting
>> integers as components of module names, and deciding how to implement
>> (library <library-name>) clauses in 'cond-expand'.
>>
>> Finally, the lack of a comprehensive test suite made me concerned that
>> the code was not adequately tested.
>>
>>> I will split the documentation and possibly the tests out into their
>>> own patches and modify them to work with r7rs-wip branch instead of
>>> master branch.
>>
>> Thank you for your efforts!
>>
>>        Mark

[-- Attachment #2: 0001-Added-docstrings-to-many-R7RS-small-procedures.patch --]
[-- Type: text/x-patch, Size: 13070 bytes --]

From e3724ea7079211466b041796f2a87e62e25b1d1e Mon Sep 17 00:00:00 2001
From: Freja Nordsiek <fnordsie@gmail.com>
Date: Sun, 18 Jun 2017 12:37:35 +0200
Subject: [PATCH] Added docstrings to many R7RS-small procedures.

* module/scheme/base.scm: added docstrings
* module/scheme/char.scm: added docstrings
* module/scheme/load.scm: added docstrings
* module/scheme/time.scm: added docstrings
---
 module/scheme/base.scm | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++
 module/scheme/char.scm |  4 +++
 module/scheme/load.scm |  3 ++
 module/scheme/time.scm |  5 +++
 4 files changed, 102 insertions(+)

diff --git a/module/scheme/base.scm b/module/scheme/base.scm
index b851be3..f967273 100644
--- a/module/scheme/base.scm
+++ b/module/scheme/base.scm
@@ -138,12 +138,20 @@
 
   (begin
     (define (features)
+      "- Scheme Procedure: features
+         Returns the list of features available/supported in cond-expand."
       %cond-expand-features)     ; XXX also include per-module features?
 
     (define (error msg . objs)
+      "- Scheme Procedure: 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."
       (apply r6rs-error #f msg objs))
 
     (define (square z)
+      "- Scheme Procedure: square z
+         Returns the square of @var{z}."
       (* z z))
 
     ;; XXX FIXME When Guile's 'char-ready?' is fixed, this will need
@@ -206,11 +214,19 @@
                          (cons (apply f (map car ls)) out)))))))))
 
     (define* (vector->string v #:optional (start 0) (end (vector-length v)))
+      "- Scheme Procedure: 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})."
       (string-tabulate (lambda (i)
                          (vector-ref v (+ i start)))
                        (- end start)))
 
     (define* (string->vector s #:optional (start 0) (end (string-length s)))
+      "- Scheme Procedure: 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})."
       (let ((v (make-vector (- end start))))
         (let loop ((i 0) (j start))
           (when (< j end)
@@ -220,6 +236,10 @@
 
     (define string-map
       (case-lambda
+        "- Scheme Procedure: 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."
         ((proc s) (srfi-13-string-map proc s))
         ((proc s1 s2)
          (let* ((len (min (string-length s1)
@@ -246,6 +266,9 @@
 
     (define string-for-each
       (case-lambda
+        "- Scheme Procedure: 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."
         ((proc s) (srfi-13-string-for-each proc s))
         ((proc s1 s2)
          (let ((len (min (string-length s1)
@@ -311,9 +334,15 @@
                (loop (+ i 1))))))))
 
     (define (bytevector . u8-list)
+      "- Scheme Procedure: bytevector byte1 byte2 ...
+         Returns a newly allocated bytevector consisting of the unsigned 8-bit
+         integers given as arguments."
       (u8-list->bytevector u8-list))
 
     (define (bytevector-append . bvs)
+      "- Scheme Procedure: bytevector-append bv1 bv2 ...
+         Appends all the given bytevectors in order and returns the resulting
+         new bytevector."
       (let* ((total-len (apply + (map bytevector-length bvs)))
              (result (make-bytevector total-len)))
         (let loop ((i 0) (bvs bvs))
@@ -341,6 +370,12 @@
 
     (define bytevector-copy!
       (case-lambda
+        "- Scheme Procedure: 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."
         ((to at from)
          (r6rs-bytevector-copy! from 0 to at
                                 (bytevector-length from)))
@@ -353,6 +388,10 @@
 
     (define utf8->string
       (case-lambda
+        "- Scheme Procedure: 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})."
         ((bv) (r6rs-utf8->string bv))
         ((bv start)
          (r6rs-utf8->string (bytevector-copy bv start)))
@@ -361,6 +400,10 @@
 
     (define string->utf8
       (case-lambda
+        "- Scheme Procedure: 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) (r6rs-string->utf8 s))
         ((s start)
          (r6rs-string->utf8 (substring s start)))
@@ -380,6 +423,8 @@
       (open-bytevector-input-port bv))
 
     (define (open-output-bytevector)
+      "- Scheme Procedure: open-output-bytevector
+         Returns an open binary bytevector output port."
       (call-with-values
           (lambda () (open-bytevector-output-port))
         (lambda (port proc)
@@ -387,6 +432,9 @@
           port)))
 
     (define (get-output-bytevector port)
+      "- Scheme Procedure: get-output-bytevector port
+         Returns a bytevector containing all the bytes written so far into the
+         bytevector output port @var{port}."
       (let ((proc (%port-property port 'get-output-bytevector)))
         (unless proc
           (error "get-output-bytevector: port not created by open-output-bytevector"))
@@ -395,15 +443,26 @@
           out)))
 
     (define* (peek-u8 #:optional (port (current-input-port)))
+      "- Scheme Procedure: peak-u8 [port]
+         Read the next byte from @var{port} (default is current input) without
+         updating the file position."
       (lookahead-u8 port))
 
     (define* (read-u8 #:optional (port (current-input-port)))
+      "- Scheme Procedure: read-u8 [port]
+         Read the next byte from @var{port} (default is current input)."
       (get-u8 port))
 
     (define* (write-u8 byte #:optional (port (current-output-port)))
+      "- Scheme Procedure: write-u8 byte [port]
+         Write the byte @var{byte} to @var{port} (default is current output)."
       (put-u8 port byte))
 
     (define* (read-bytevector k #:optional (port (current-input-port)))
+      "- Scheme Procedure: 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 k))
 
     (define* (read-bytevector! bv
@@ -411,6 +470,12 @@
                                (port (current-input-port))
                                (start 0)
                                (end (bytevector-length bv)))
+      "- Scheme Procedure: 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."
       (get-bytevector-n! port bv start (- end start)))
 
     (define* (write-bytevector bv
@@ -418,15 +483,26 @@
                                (port (current-output-port))
                                (start 0)
                                (end (bytevector-length bv)))
+      "- Scheme Procedure: 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})."
       (put-bytevector port bv start (- end start)))
 
     (define read-string
       (case-lambda
+        "- 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)."
         ((k) (get-string-n (current-input-port) k))
         ((k port) (get-string-n port k))))
 
     (define write-string
       (case-lambda
+        "- Scheme Procedure: 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) (put-string (current-output-port) s))
         ((s port)
          (put-string port s))
@@ -437,6 +513,10 @@
 
     (define write-bytevector
       (case-lambda
+        "- Scheme Procedure: 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) (put-bytevector (current-output-port) bv))
         ((bv port)
          (put-bytevector port bv))
@@ -446,20 +526,30 @@
          (put-bytevector port bv start (- end start)))))
 
     (define (input-port-open? port)
+      "- Scheme Procedure: input-port-open? port
+         Returns whether @var{port} is an open input port or not."
       (unless (input-port? port)
         (error "input-port-open?: not an input port" port))
       (not (port-closed? port)))
 
     (define (output-port-open? port)
+      "- Scheme Procedure: output-port-open? port
+         Returns whether @var{port} is an open output port or not."
       (unless (output-port? port)
         (error "output-port-open?: not an output port" port))
       (not (port-closed? port)))
 
     (define (read-error? obj)
+      "- Scheme Procedure: read-error? obj
+         Returns whether @var{obj} was an error object raised by @code{read} or
+         not."
       (or (lexical-violation? obj)
           (i/o-read-error? obj)))
 
     (define (file-error? obj)
+      "- Scheme Procedure: file-error?
+         Returns whether @var{obj} was an error object raised by a file opening
+         or not."
       (or (i/o-file-protection-error? obj)
           (i/o-file-is-read-only-error? obj)
           (i/o-file-already-exists-error? obj)
diff --git a/module/scheme/char.scm b/module/scheme/char.scm
index 9a6210b..cfc0dab 100644
--- a/module/scheme/char.scm
+++ b/module/scheme/char.scm
@@ -508,6 +508,10 @@
                 (#x1D7FF . 9))); MATHEMATICAL MONOSPACE DIGIT NINE
              (num-digits (vector-length digit-table)))
         (lambda (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."
           (let ((ci (char->integer c)))
             (let search ((lo 0) (hi num-digits))
               (and (< lo hi)
diff --git a/module/scheme/load.scm b/module/scheme/load.scm
index e585b71..0abe177 100644
--- a/module/scheme/load.scm
+++ b/module/scheme/load.scm
@@ -30,6 +30,9 @@
                   (load guile-load)))
   (begin
     (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)
diff --git a/module/scheme/time.scm b/module/scheme/time.scm
index 9058974..56fd6de 100644
--- a/module/scheme/time.scm
+++ b/module/scheme/time.scm
@@ -27,8 +27,13 @@
                   (get-internal-real-time current-jiffy)))
   (begin
     (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 (current-time time-tai)))
         (+ (time-second time)
            (* 1e-9 (time-nanosecond 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)))
-- 
2.9.4