document SRFIs

1 files changed, 267 insertions, 23 deletions

diff --git a/mcgoron/guix/srfi.scm b/mcgoron/guix/srfi.scm
index fb469ff..5a8e966 100644
--- a/mcgoron/guix/srfi.scm
+++ b/mcgoron/guix/srfi.scm
@@ -65,21 +65,6 @@
 
 (define srfi-1-special-forms
   ''(begin
-      (define-syntax let-optionals
-        (syntax-rules ()
-          ((_ expr ((v d) ... . tail) . body)
-           ($let-optionals (v ...) () (d ...) () f tail expr body))))
-      (define-syntax $let-optionals
-        (syntax-rules ()
-          ((_ () (vt ...) _ (cl ...) f tail expr body)
-           (letrec ((f (case-lambda cl ... ((vt ... . tail) . body))))
-             (apply f expr)))
-          ((_ (vrf . vr*) (vt ...) (df . dr*) (cl ...) f . tailexprbody)
-           ($let-optionals vr* (vt ... vrf) dr* (cl ... ((vt ...) (f vt ... df))) f . tailexprbody))))
-      (define-syntax receive
-        (syntax-rules ()
-          ((_ formals value body ...)
-           (let-values ((formals value)) body ...))))
       (define-syntax :optional
         (syntax-rules ()
           ((_ x y) (if (null? x) y (car x)))))
@@ -91,6 +76,116 @@
                   (apply f cars)
                   (loop cdrs))))))))
 
+(define (output-literal-form form lib-dir filename)
+  (list #:modules '((guix build utils))
+        #:builder
+        #~ (begin
+             (use-modules (guix build utils))
+             (let ((dir (string-append (assoc-ref %outputs "out")
+                                       "/"
+                                       #$lib-dir)))
+               (mkdir-p dir)
+               (with-output-to-file (string-append dir "/" #$filename)
+                 (lambda () (write ' #$form)))))))
+
+(define-public srfi-8-r7rs
+  (package
+   (name "srfi-8-r7rs")
+   (version "final")
+   (build-system trivial-build-system)
+   (home-page "https://srfi.schemers.org/srfi-8/srfi-8.html")
+   (synopsis "receive: Binding to multiple values (R7RS)")
+   (source #f)
+   (license expat)
+   (inputs '())
+   (description "The syntax proposed in this SRFI is used in the reference implementation of SRFI-1, “List library.”")
+   (arguments (output-literal-form
+               '(define-library (srfi 8)
+                  (import (scheme base))
+                  (export receive)
+                  (begin
+                    (define-syntax receive
+                      (syntax-rules ()
+                        ((receive formals expression body ...)
+                         (let-values ((formals expression))
+                           body ...))))))
+               (string-append r7rs-lib-dir "/srfi")
+               "8.sld"))))
+
+(define-public srfi-8-r6rs
+  (package
+   (name "srfi-8-r6rs")
+   (source #f)
+   (version "final")
+   (build-system trivial-build-system)
+   (home-page "https://srfi.schemers.org/srfi-8/srfi-8.html")
+   (synopsis "receive: Binding to multiple values (R6RS)")
+   (license expat)
+   (inputs '())
+   (description "The syntax proposed in this SRFI is used in the reference implementation of SRFI-1, “List library.”")
+   (arguments (output-literal-form
+               '(library (srfi :8)
+                  (import (rnrs base))
+                  (export receive)
+                  (begin
+                    (define-syntax receive
+                      (syntax-rules ()
+                        ((receive formals expression body ...)
+                         (let-values ((formals expression))
+                           body ...))))))
+               (string-append r6rs-lib-dir "/srfi")
+               ":8.sls"))))
+
+(define-public srfi-227-r7rs
+  (package
+   (name "srfi-227-r7rs")
+   (version "final")
+   (source (origin (method git-fetch)
+                   (uri (git-reference (url "https://github.com/scheme-requests-for-implementation/srfi-227")
+                                       (commit "final")))
+                   (sha256 (base32 "1325az0zmxxmkdvpz24v2nikp3dr1ihgyqcl55my61rwjpgcwjhl"))))
+   (build-system copy-build-system)
+   (home-page "https://srfi.schemers.org/srfi-227")
+   (synopsis "Optional Arguments (R7RS)")
+   (license expat)
+   (inputs '())
+   (description
+    "This SRFI specifies the opt-lambda syntax, which generalizes lambda. An opt-lambda expression evaluates to a procedure that takes a number of required and a number of optional (positional) arguments whose default values are determined by evaluating corresponding expressions when the procedure is called.
+
+This SRFI also specifies a variation opt*-lambda, which is to opt-lambda as let* is to let and the related binding constructs let-optionals and let-optionals*.
+
+Finally, for those who prefer less explicit procedure definitions, a sublibrary provides define-optionals and define-optionals*.")
+   (arguments
+    (list
+     #:install-plan
+     `(("lib/srfi/" ,(string-append r7rs-lib-dir "/srfi/")
+        #:include (".sld" ".scm")))))))
+
+(define-public srfi-227-r6rs
+  (package
+   (name "srfi-227-r6rs")
+   (version "final")
+   (source (origin (method git-fetch)
+                   (uri (git-reference (url "https://github.com/scheme-requests-for-implementation/srfi-227")
+                                       (commit "final")))
+                   (sha256 (base32 "1325az0zmxxmkdvpz24v2nikp3dr1ihgyqcl55my61rwjpgcwjhl"))))
+   (build-system copy-build-system)
+   (home-page "https://srfi.schemers.org/srfi-227")
+   (synopsis "Optional Arguments (R6RS)")
+   (license expat)
+   (inputs '())
+   (description
+    "This SRFI specifies the opt-lambda syntax, which generalizes lambda. An opt-lambda expression evaluates to a procedure that takes a number of required and a number of optional (positional) arguments whose default values are determined by evaluating corresponding expressions when the procedure is called.
+
+This SRFI also specifies a variation opt*-lambda, which is to opt-lambda as let* is to let and the related binding constructs let-optionals and let-optionals*.
+
+Finally, for those who prefer less explicit procedure definitions, a sublibrary provides define-optionals and define-optionals*.")
+   (arguments
+    (list
+     #:install-plan
+     `'(("lib/srfi/" ,(string-append r7rs-lib-dir "/srfi/")
+         #:include (".sls")))))))
+
 (define-public srfi-1-r7rs
   (package
    (name "srfi-1-r7rs")
@@ -103,9 +198,8 @@
    (build-system copy-build-system)
    (home-page "https://srfi.schemers.org/srfi-1")
    (synopsis "List library (R7RS)")
-   (license (non-copyleft "//srfi.schemers.org/srfi-1/srfi-1.html"))
+   (license (non-copyleft "https://srfi.schemers.org/srfi-1/srfi-1.html"))
    (inputs '())
-   (native-inputs '())
    (description " R5RS Scheme has an impoverished set of list-processing utilities, which is a problem for authors of portable code. This SRFI proposes a coherent and comprehensive set of list-processing procedures; it is accompanied by a reference implementation of the spec. The reference implementation is
 
     portable
@@ -128,7 +222,10 @@
                               7
                               '(srfi 1)
                               '#$srfi-1-exports
-                              '((scheme base) (scheme cxr) (scheme case-lambda))
+                              '((scheme base)
+                                (scheme cxr)
+                                (scheme case-lambda)
+                                (srfi 8) (srfi 227))
                               '(define-syntax check-arg
                                  (syntax-rules ()
                                    ((_ pred val caller)
@@ -154,7 +251,7 @@
    (home-page "https://srfi.schemers.org/srfi-1")
    (synopsis "List library (R6RS)")
    (license (non-copyleft "//srfi.schemers.org/srfi-1/srfi-1.html"))
-   (inputs '())
+   (inputs (list srfi-8-r6rs srfi-227-r6rs))
    (native-inputs '())
    (description " R5RS Scheme has an impoverished set of list-processing utilities, which is a problem for authors of portable code. This SRFI proposes a coherent and comprehensive set of list-processing procedures; it is accompanied by a reference implementation of the spec. The reference implementation is
 
@@ -174,16 +271,17 @@
                                         "/" #$r6rs-lib-dir
                                         "/srfi")))
                 (mkdir-p lib)
-                (splice-files (string-append lib "/srfi-1.sls")
+                (splice-files (string-append lib "/:1.sls")
                               6
-                              '(srfi srfi-1)
+                              '(srfi :1)
                               '#$srfi-1-exports
                               '((except (rename (rnrs base) (error %error))
                                         map
                                         for-each)
                                 (rnrs control)
                                 (except (rnrs lists) remove find partition filter fold-right cons* member assoc)
-                                (rnrs mutable-pairs) (rnrs r5rs))
+                                (rnrs mutable-pairs) (rnrs r5rs)
+                                (srfi :8) (srfi :227))
                               '(define-syntax check-arg
                                  (syntax-rules ()
                                    ((_ pred val caller)
@@ -198,4 +296,150 @@
                               '(define (error msg . irritants)
                                  (apply %error #f msg irritants))
                               #$srfi-1-special-forms
-                              "srfi-1-reference.scm")))))))))
\ No newline at end of file
+                              "srfi-1-reference.scm")))))))))
+
+(define-public srfi-128-r7rs
+  (package
+   (name "srfi-128-r7rs")
+   (version "errata-4")
+   (source
+    (origin (method git-fetch)
+            (uri (git-reference (url "https://github.com/scheme-requests-for-implementation/srfi-128")
+                                (commit "errata-4")))
+            (sha256 (base32 "1jlradj1m28m0gcl8dj1p7hydzvf151ylgyicv9k20xm8l5damks"))))
+   (build-system copy-build-system)
+   (home-page "https://srfi.schemers.org/srfi-128")
+   (synopsis "Comparators (reduced) (R7RS)")
+   (license expat)
+   (inputs '())
+   (native-inputs '())
+   (description
+    "This SRFI provides comparators, which bundle a type test predicate, an equality predicate, an ordering predicate, and a hash function (the last two are optional) into a single Scheme object. By packaging these procedures together, they can be treated as a single item for use in the implementation of data structures. ")
+   (arguments
+    (list
+     #:phases
+     #~ (modify-phases %standard-phases
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (let ((lib (string-append (assoc-ref %outputs "out")
+                                        "/" #$r7rs-lib-dir
+                                        "/srfi")))
+                (mkdir-p lib)
+                (copy-recursively "srfi" lib)))))))))
+
+(define-public srfi-9-r6rs
+  (package
+   (name "srfi-9-r6rs")
+   (source #f)
+   (version "final")
+   (synopsis "Defining Record Types (R6RS)")
+   (description "This SRFI describes syntax for creating new data types, called record types. A predicate, constructor, and field accessors and modifiers are defined for each record type. Each new record type is distinct from all existing types, including other record types and Scheme's predefined types.")
+   (home-page "https://github.com/arcfide/chez-srfi")
+   (build-system trivial-build-system)
+   (license expat)
+   (inputs '())
+   (native-inputs '())
+   (arguments
+    (output-literal-form
+     '(library (srfi :9)
+        (export (rename (my:define-record-type define-record-type)))
+        (import (rnrs))
+        (define-syntax my:define-record-type
+          (lambda (stx)
+            (syntax-case stx ()
+              ((_ type (constructor constructor-tag ...)
+                  predicate
+                  (field-tag accessor setter ...) ...)
+               (and (for-all identifier?
+                             #'(type constructor constructor-tag ... predicate
+                                     field-tag ... accessor ... setter ... ...))
+                    (for-all (lambda (s) (<= 0 (length s) 1))
+                             #'((setter ...) ...))
+                    (for-all (lambda (ct)
+                               (memp (lambda (ft) (bound-identifier=? ct ft))
+                                     #'(field-tag ...)))
+                             #'(constructor-tag ...)))
+               (with-syntax (((field-clause ...)
+                              (map (lambda (clause)
+                                     (if (= 2 (length clause))
+                                         #`(immutable . #,clause)
+                                         #`(mutable . #,clause)))
+                                   #'((field-tag accessor setter ...) ...)))
+                             ((unspec-tag ...)
+                              (remp (lambda (ft)
+                                      (memp (lambda (ct) (bound-identifier=? ft ct))
+                                            #'(constructor-tag ...)))
+                                    #'(field-tag ...))))
+                 #'(define-record-type (type constructor predicate)
+                     (protocol (lambda (ctor)
+                                 (lambda (constructor-tag ...)
+                                   (define unspec-tag) ...
+                                   (ctor field-tag ...))))
+                     (fields field-clause ...))))))))
+     (string-append r6rs-lib-dir "/srfi/")
+     ":9.sls"))))
+
+(define-public compatible-parameters-chez
+  (package
+   (name "compatible-parameters-chez")
+   (version "1.0.0")
+   (source #f)
+   (build-system trivial-build-system)
+   (license unlicense)
+   (home-page "https://florida.moe")
+   (synopsis "Shim library for parameters (Chez)")
+   (description "Shim library for parameters, mutable or immutable.")
+   (arguments
+    (output-literal-form
+     '(library (mcgoron compatible-parameters)
+        (export make-parameter parameterize)
+        (import (only (chezscheme) make-parameter parameterize)))
+     (string-append chez-lib-dir "/mcgoron")
+     "compatible-parameters.sls"))))
+
+(define-public srfi-128-r6rs
+  (package
+   (name "srfi-128-r6rs")
+   (version "errata-4")
+   (source
+    (origin (method git-fetch)
+            (uri (git-reference (url "https://github.com/scheme-requests-for-implementation/srfi-128")
+                                (commit "errata-4")))
+            (sha256 (base32 "1jlradj1m28m0gcl8dj1p7hydzvf151ylgyicv9k20xm8l5damks"))))
+   (build-system copy-build-system)
+   (home-page "https://srfi.schemers.org/srfi-128")
+   (synopsis "Comparators (reduced) (R6RS)")
+   (license expat)
+   (inputs '())
+   (description
+    "This SRFI provides comparators, which bundle a type test predicate, an equality predicate, an ordering predicate, and a hash function (the last two are optional) into a single Scheme object. By packaging these procedures together, they can be treated as a single item for use in the implementation of data structures. ")
+   (arguments
+    (list
+     #:imported-modules `(,@%copy-build-system-modules (mcgoron guix srfi-util))
+     #:phases
+     #~ (modify-phases %standard-phases
+          (replace 'install
+            (lambda* (#:key outputs #:allow-other-keys)
+              (use-modules (mcgoron guix srfi-util))
+              (let ((lib (string-append (assoc-ref %outputs "out")
+                                        "/" #$r6rs-lib-dir
+                                        "/srfi")))
+                (mkdir-p lib)
+                (splice-files (string-append lib "/:128.sls")
+                              6
+                              '(srfi :128)
+                              '(comparator? comparator-ordered? comparator-hashable? make-comparator make-pair-comparator make-list-comparator make-vector-comparator make-eq-comparator make-eqv-comparator make-equal-comparator boolean-hash char-hash char-ci-hash string-hash string-ci-hash symbol-hash number-hash make-default-comparator default-hash comparator-register-default! comparator-type-test-predicate comparator-equality-predicate comparator-ordering-predicate comparator-hash-function comparator-test-type comparator-check-type comparator-hash hash-bound hash-salt =? <? >? <=? >=? comparator-if<=>)
+                              '((except (rename (rnrs) (error %error))
+                                        define-record-type
+                                        string-hash
+                                        string-ci-hash
+                                        symbol-hash)
+                                (rnrs r5rs)
+                                (srfi :9)
+                                (mcgoron compatible-parameters))
+                              '(define (exact-integer? x)
+                                 (and (exact? x) (integer? x)))
+                              '(define (error msg . irritants)
+                                 (%error #f msg irritants))
+                              "srfi/128.body1.scm"
+                              "srfi/128.body2.scm")))))))))