[Guile-commits] 01/08: Add initial implementation of R7RS modules

[Andy Wingo]

wingo pushed a commit to branch wip-r7rs
in repository guile.

commit d914652c0abf9644d3e5c9e7394861af7a3a61f1
Author: Andy Wingo <address@hidden>
Date:   Sat Oct 5 21:30:33 2019 +0200

    Add initial implementation of R7RS modules
    
    * module/Makefile.am (SOURCES): Add new files.
    * module/scheme/base.scm:
    * module/scheme/case-lambda.scm:
    * module/scheme/char.scm:
    * module/scheme/complex.scm:
    * module/scheme/cxr.scm:
    * module/scheme/eval.scm:
    * module/scheme/file.scm:
    * module/scheme/inexact.scm:
    * module/scheme/lazy.scm:
    * module/scheme/load.scm:
    * module/scheme/process-context.scm:
    * module/scheme/r5rs.scm:
    * module/scheme/read.scm:
    * module/scheme/repl.scm:
    * module/scheme/time.scm:
    * module/scheme/write.scm: New files.  Thanks to Göran Weinholt for
      akku-scm and OKUMURA Yuki for yuni, off of which some of these files
      were based.
---
 module/Makefile.am                |  17 ++
 module/scheme/base.scm            | 593 ++++++++++++++++++++++++++++++++++++++
 module/scheme/case-lambda.scm     |  19 ++
 module/scheme/char.scm            |  85 ++++++
 module/scheme/complex.scm         |  22 ++
 module/scheme/cxr.scm             |  42 +++
 module/scheme/eval.scm            |  35 +++
 module/scheme/file.scm            |  24 ++
 module/scheme/inexact.scm         |  62 ++++
 module/scheme/lazy.scm            |  24 ++
 module/scheme/load.scm            |  25 ++
 module/scheme/process-context.scm |  58 ++++
 module/scheme/r5rs.scm            | 135 +++++++++
 module/scheme/read.scm            |  19 ++
 module/scheme/repl.scm            |  19 ++
 module/scheme/time.scm            |  31 ++
 module/scheme/write.scm           |  23 ++
 17 files changed, 1233 insertions(+)

diff --git a/module/Makefile.am b/module/Makefile.am
index dff2f95..c6dff76 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -236,6 +236,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..aec90d2
--- /dev/null
+++ b/module/scheme/base.scm
@@ -0,0 +1,593 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Based on code from https://gitlab.com/akku/akku-scm, written
+;;; 2018-2019 by Göran Weinholt <address@hidden>, as well as
+;;; https://github.com/okuoku/yuni, written 2014-2018 by OKUMURA Yuki
+;;; <address@hidden>.  This code was originally released under the
+;;; following terms:
+;;;
+;;;     To the extent possible under law, the author(s) have dedicated
+;;;     all copyright and related and neighboring rights to this
+;;;     software to the public domain worldwide. This software is
+;;;     distributed without any warranty.
+;;;
+;;;     See <http://creativecommons.org/publicdomain/zero/1.0/>, for a
+;;;     copy of the CC0 Public Domain Dedication.
+
+(define-module (scheme base)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (ice-9 exceptions)
+  #:use-module ((srfi srfi-34) #:select (guard))
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
+  #:export (error-object-message error-object-irritants
+            file-error?
+            (r7:error . error)
+            (r7:cond-expand . cond-expand)
+            (r7:include . include)
+            (r7:include-ci . include-ci)
+            (r7:let-syntax . let-syntax)
+            member assoc list-copy map for-each
+            binary-port? textual-port?
+            open-input-bytevector
+            open-output-bytevector get-output-bytevector
+            peek-u8 read-u8 read-bytevector read-bytevector!
+            read-string read-line
+            write-u8 write-bytevector write-string flush-output-port
+            (r7:string-map . string-map)
+            bytevector bytevector-append
+            string->vector vector->string
+            (r7:string->utf8 . string->utf8)
+            (r7:vector-copy . vector-copy)
+            (r7:vector->list . vector->list)
+            (r7:vector-fill! . vector-fill!)
+            vector-copy! vector-append vector-for-each vector-map
+            (r7:bytevector-copy . bytevector-copy)
+            (r7:bytevector-copy! . bytevector-copy!)
+            (r7:utf8->string . utf8->string)
+            square
+            (r7:expt . expt)
+            boolean=? symbol=?
+            call-with-port
+            features
+            input-port-open? output-port-open?)
+  #:re-export
+  (_
+   ... => else
+   * + - / < <= = > >= abs and append apply assq assv begin
+   boolean?
+   bytevector-length
+   bytevector-u8-ref bytevector-u8-set! bytevector? caar cadr
+   call-with-current-continuation call-with-values
+   call/cc car case cdar cddr cdr ceiling char->integer char-ready?
+   char<=? char<? char=? char>=? char>? char? close-input-port
+   close-output-port close-port complex? cond 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?
+   (exception? . error-object?)
+   even?
+   (inexact->exact . exact)
+   (exact->inexact . inexact)
+   exact-integer-sqrt exact-integer? exact?
+   floor floor-quotient floor-remainder floor/
+   gcd
+   get-output-string guard if inexact?
+   input-port? integer->char integer? lambda lcm
+   length let let* let*-values let-values letrec letrec*
+   letrec-syntax list list->string list->vector list-ref
+   list-set! list-tail list? make-bytevector make-list make-parameter
+   make-string make-vector max memq memv min modulo
+   negative? newline not null? number->string number? numerator odd?
+   open-input-string
+   open-output-string or output-port? pair?
+   parameterize peek-char port? positive? procedure?
+   quasiquote quote quotient
+   (raise-exception . raise)
+   raise-continuable
+   rational?
+   rationalize read-char
+   (lexical-error? . read-error?)
+   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-for-each
+   string-length string-ref string-set! string<=? string<?
+   string=? string>=? string>? string? substring symbol->string
+   symbol? syntax-error syntax-rules truncate
+   truncate-quotient truncate-remainder truncate/
+   (char-ready? . u8-ready?)
+   unless
+   unquote unquote-splicing values
+   vector
+   vector-length vector-ref vector-set! vector?
+   when with-exception-handler write-char
+   zero?))
+
+(define* (member x ls #:optional (= equal?))
+  (cond
+   ((eq? = eq?) (memq x ls))
+   ((eq? = eqv?) (memv x ls))
+   (else 
+    (unless (procedure? =)
+      (error "not a procedure" =))
+    (let lp ((ls ls))
+      (if (or (null? ls) (= (car ls) x))
+          ls
+          (lp (cdr ls)))))))
+
+(define* (assoc x ls #:optional (= equal?))
+  (cond
+   ((eq? = eq?) (assq x ls))
+   ((eq? = eqv?) (assv x ls))
+   (else 
+    (unless (procedure? =)
+      (error "not a procedure" =))
+    (let lp ((ls ls))
+      (cond
+       ((null? ls) #f)
+       ((= (caar ls) x) (car ls))
+       (else (lp (cdr ls))))))))
+
+(define (list-copy x)
+  (if (pair? x)
+      (cons (car x) (list-copy (cdr x)))
+      x))
+
+(define (circular-list? x)
+  (and (pair? x)
+       (let lp ((hare (cdr x)) (tortoise x))
+         (and (pair? hare)
+              (let ((hare (cdr hare)))
+               (and (pair? hare)
+                     (or (eq? hare tortoise)
+                         (lp (cdr hare) (cdr tortoise)))))))))
+
+(define map
+  (case-lambda
+    ((f l)
+     (unless (or (list? l)
+                 (circular-list? l))
+       (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                  (list l) #f))
+     (let map1 ((l l))
+       (if (pair? l)
+           (cons (f (car l)) (map1 (cdr l)))
+           '())))
+
+    ((f l1 l2)
+     (cond
+      ((list? l1)
+       (unless (or (list? l2) (circular-list? l2))
+         (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                    (list l2) #f)))
+      ((circular-list? l1)
+       (unless (list? l2)
+         (scm-error 'wrong-type-arg "map" "Not a finite list: ~S"
+                    (list l2) #f)))
+      (else
+       (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                  (list l1) #f)))
+     (let map2 ((l1 l1) (l2 l2))
+       (if (and (pair? l1) (pair? l2))
+           (cons (f (car l1) (car l2))
+                 (map2 (cdr l1) (cdr l2)))
+           '())))
+
+    ((f l1 . rest)
+     (let ((lists (cons l1 rest)))
+       (unless (and-map list? lists)
+         (unless (or-map list? lists)
+           (scm-error 'wrong-type-arg "map"
+                      "Arguments do not contain a finite list" '() #f))
+         (for-each (lambda (x)
+                     (unless (or (list? x) (circular-list? x))
+                       (scm-error 'wrong-type-arg "map" "Not a list: ~S"
+                                  (list x) #f)))
+                   lists))
+       (let mapn ((lists lists))
+         (if (and-map pair? lists)
+             (cons (apply f (map car lists)) (mapn (map cdr lists)))
+             '()))))))
+
+(define for-each
+  (case-lambda
+    ((f l)
+     (unless (or (list? l)
+                 (circular-list? l))
+       (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                  (list l) #f))
+     (let for-each1 ((l l))
+       (when (pair? l)
+         (f (car l))
+         (for-each1 (cdr l)))))
+
+    ((f l1 l2)
+     (cond
+      ((list? l1)
+       (unless (or (list? l2) (circular-list? l2))
+         (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                    (list l2) #f)))
+      ((circular-list? l1)
+       (unless (list? l2)
+         (scm-error 'wrong-type-arg "for-each" "Not a finite list: ~S"
+                    (list l2) #f)))
+      (else
+       (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                  (list l1) #f)))
+     (let for-each2 ((l1 l1) (l2 l2))
+       (when (and (pair? l1) (pair? l2))
+         (f (car l1) (car l2))
+         (for-each2 (cdr l1) (cdr l2)))))
+
+    ((f l1 . rest)
+     (let ((lists (cons l1 rest)))
+       (unless (and-map list? lists)
+         (unless (or-map list? lists)
+           (scm-error 'wrong-type-arg "for-each"
+                      "Arguments do not contain a finite list" '() #f))
+         (for-each (lambda (x)
+                     (unless (or (list? x) (circular-list? x))
+                       (scm-error 'wrong-type-arg "for-each" "Not a list: ~S"
+                                  (list x) #f)))
+                   lists))
+       (let for-eachn ((lists lists))
+         (when (and-map pair? lists)
+           (apply f (map car lists))
+           (for-eachn (map cdr lists))))))))
+
+;; FIXME.
+(define (file-error? x) #f)
+
+(define (error-object-message obj)
+  (and (exception-with-message? obj)
+       (exception-message obj)))
+
+(define (error-object-irritants obj)
+  (and (exception-with-irritants? obj)
+       (exception-irritants obj)))
+
+(define (r7:error message . irritants)
+  (raise-exception
+   (let ((exn (make-exception-with-message message)))
+     (if (null? irritants)
+         exn
+         (make-exception exn
+                         (make-exception-with-irritants irritants))))))
+
+(define-syntax r7:cond-expand
+  (lambda (x)
+    (define (has-req? req)
+      (syntax-case req (and or not library)
+        ((and req ...)
+         (and-map has-req? #'(req ...)))
+        ((or req ...)
+         (or-map has-req? #'(req ...)))
+        ((not req)
+         (not (has-req? #'req)))
+        ((library lib-name)
+         (->bool (resolve-interface (syntax->datum #'lib-name))))
+        (id
+         (identifier? #'id)
+         (memq (syntax->datum #'id) (features)))))
+    (syntax-case x (else)
+      ((_)
+       (syntax-violation 'cond-expand "Unfulfilled cond-expand" x))
+      ((_ (else body ...))
+       #'(begin body ...))
+      ((_ (req body ...) more-clauses ...)
+       (if (has-req? #'req)
+           #'(begin body ...)
+           #'(r7:cond-expand more-clauses ...))))))
+
+(define-syntax-rule (r7:include k fn* ...)
+  (begin (include k fn*) ...))
+
+;; FIXME
+(define-syntax-rule (r7:include-ci k fn* ...)
+  (r7:include k fn* ...))
+
+(define-syntax-rule (r7:let-syntax ((vars trans) ...) . expr)
+  (let-syntax ((vars trans) ...)
+    (let () . expr)))
+
+(define (boolean=? x y . y*)
+  (unless (boolean? x) (error "not a boolean" x))
+  (unless (boolean? y) (error "not a boolean" y))
+  (and (eq? x y)
+       (or (null? y*)
+           (apply boolean=? x y*))))
+
+(define (symbol=? x y . y*)
+  (unless (symbol? x) (error "not a symbol" x))
+  (unless (symbol? y) (error "not a symbol" y))
+  (and (symbol? x)
+       (eq? x y)
+       (or (null? y*)
+           (apply symbol=? x y*))))
+
+(define (binary-port? p) (port? p))
+(define (textual-port? p) (port? p))
+
+(define (open-input-bytevector bv) (open-bytevector-input-port bv))
+
+(define (open-output-bytevector)
+  (let-values (((p extract) (open-bytevector-output-port)))
+    (define pos 0)
+    (define buf #vu8())
+    (define (read! target target-start count)
+      (when (zero? (- (bytevector-length buf) pos))
+        (set! buf (bytevector-append buf (extract))))  ;resets p
+      (let ((count (min count (- (bytevector-length buf) pos))))
+        (bytevector-copy! buf pos
+                          target target-start count)
+        (set! pos (+ pos count))
+        count))
+    (define (write! bv start count)
+      (put-bytevector p bv start count)
+      (set! pos (+ pos count))
+      count)
+    (define (get-position)
+      pos)
+    (define (set-position! new-pos)
+      (set! pos new-pos))
+    (define (close)
+      (close-port p))
+    ;; It's actually an input/output port, but only
+    ;; get-output-bytevector should ever read from it. If it was just
+    ;; an output port then there would be no good way for
+    ;; get-output-bytevector to read the data. -weinholt
+    (make-custom-binary-input/output-port
+     "bytevector" read! write! get-position set-position! close)))
+
+(define (get-output-bytevector port)
+  ;; R7RS says "It is an error if port was not created with
+  ;; open-output-bytevector.", so we can safely assume that the port
+  ;; was created by open-output-bytevector. -weinholt
+  (seek port 0 SEEK_SET)
+  (let ((bv (get-bytevector-all port)))
+    (if (eof-object? bv)
+        #vu8()
+        bv)))
+
+(define* (peek-u8 #:optional (port (current-input-port)))
+  (lookahead-u8 port))
+
+(define* (read-u8 #:optional (port (current-output-port)))
+  (get-u8 port))
+
+(define* (read-bytevector len #:optional (port (current-input-port)))
+  (get-bytevector-n port len))
+
+(define* (read-string len #:optional (port (current-input-port)))
+  (get-string-n port len))
+
+(define* (read-bytevector! bv #:optional (port (current-input-port))
+                           (start 0) (end (bytevector-length bv)))
+  (get-bytevector-n! port bv start (- end start)))
+
+(define* (read-line #:optional (port (current-input-port)))
+  (get-line port))
+
+(define* (write-u8 obj #:optional (port (current-output-port)))
+  (put-u8 port obj))
+
+(define* (write-bytevector bv #:optional (port (current-output-port))
+                           (start 0) (end (bytevector-length bv)))
+  (put-bytevector port bv start (- end start)))
+
+(define* (write-string str #:optional (port (current-output-port))
+                       (start 0) (end (string-length str)))
+  (put-string port str start (- end start)))
+
+(define* (flush-output-port #:optional (port (current-output-port)))
+  (force-output port))
+
+(define (r7:string-map proc s . s*)
+  (if (null? s*)
+      (string-map proc s)
+      (list->string (apply map proc (string->list s) (map string->list s*)))))
+
+(define (bytevector . lis)
+  (u8-list->bytevector lis))
+
+(define (call-with-bytevector-output-port proc)
+  (call-with-values (lambda () (open-bytevector-output-port))
+    (lambda (port get)
+      (proc port)
+      (get))))
+
+(define (bytevector-append . bvs)
+  (call-with-bytevector-output-port
+    (lambda (p)
+      (for-each (lambda (bv) (put-bytevector p bv)) bvs))))
+
+(define string->vector
+  (case-lambda
+    ((str) (list->vector (string->list str)))
+    ((str start) (string->vector (substring str start)))
+    ((str start end) (string->vector (substring str start end)))))
+
+(define r7:string->utf8
+  (case-lambda
+    ((str) (string->utf8 str))
+    ((str start) (string->utf8 (substring str start)))
+    ((str start end) (string->utf8 (substring str start end)))))
+
+;;; vector
+
+(define (%subvector v start end)
+  (define mlen (- end start))
+  (define out (make-vector (- end start)))
+  (define (itr r)
+    (if (= r mlen)
+      out
+      (begin
+        (vector-set! out r (vector-ref v (+ start r)))
+        (itr (+ r 1)))))
+  (itr 0))
+
+(define r7:vector-copy
+  (case-lambda*
+    ((v) (vector-copy v))
+    ((v start #:optional (end (vector-length v)))
+     (%subvector v start end))))
+
+(define* (vector-copy! target tstart source
+                       #:optional (sstart 0) (send (vector-length source)))
+  "Copy a block of elements from SOURCE to TARGET, both of which must be
+vectors, starting in TARGET at TSTART and starting in SOURCE at SSTART,
+ending when SEND - SSTART elements have been copied.  It is an error for
+TARGET to have a length less than TSTART + (SEND - SSTART).  SSTART
+defaults to 0 and SEND defaults to the length of SOURCE."
+  (let ((tlen (vector-length target))
+        (slen (vector-length source)))
+    (if (< tstart sstart)
+        (vector-move-left!  source sstart send target tstart)
+        (vector-move-right! source sstart send target tstart))))
+
+(define r7:vector->list
+  (case-lambda*
+    ((v) (vector->list v))
+    ((v start #:optional (end (vector-length v)))
+     (vector->list (%subvector v start end)))))
+
+(define vector-map
+  (case-lambda*
+   ((f v)
+    (let* ((len (vector-length v))
+           (out (make-vector len #f)))
+      (let lp ((i 0))
+        (when (< i len)
+          (vector-set! out i (f (vector-ref v i)))
+          (lp (1+ i))))
+      out))
+   ((f v . v*)
+    (list->vector (apply map f (map vector->list (cons v v*)))))))
+
+(define vector-for-each
+  (case-lambda*
+   ((f v)
+    (let lp ((i 0))
+      (when (< i (vector-length v))
+        (f (vector-ref v i))
+        (lp (1+ i)))))
+   ((f v . v*)
+    (let ((len (apply min (vector-length v) (map vector-length v*))))
+      (let lp ((i 0))
+        (when (< i len)
+          (apply f (vector-ref v i) (map (lambda (v) (vector-ref v i)) v*))
+          (lp (1+ i))))))))
+
+(define (vector-append . vectors)
+  (if (null? vectors)
+      #()
+      (let* ((len (let lp ((vectors vectors))
+                    (if (null? vectors)
+                        0
+                        (+ (vector-length (car vectors)) (lp (cdr vectors))))))
+             (out (make-vector len #f)))
+        (let lp ((i 0) (j 0) (v (car vectors)) (v* (cdr vectors)))
+          (cond
+           ((< j (vector-length v))
+            (vector-set! out i (vector-ref v j))
+            (lp (1+ i) (1+ j) v v*))
+           ((null? v*)
+            out)
+           (else
+            (lp i 0 (car v*) (cdr v*))))))))
+
+(define vector->string
+  (case-lambda*
+    ((v) (list->string (vector->list v)))
+    ((v start #:optional (end (vector-length v)))
+     (vector->string (%subvector v start end)))))
+
+(define r7:vector-fill!
+  (case-lambda*
+    ((vec fill) (vector-fill! vec fill))
+    ((vec fill start #:optional (end (vector-length vec)))
+     (let lp ((r start))
+       (unless (= r end)
+         (vector-set! vec r fill)
+         (lp (+ r 1)))))))
+
+(define (%subbytevector bv start end)
+  (define mlen (- end start))
+  (define out (make-bytevector mlen))
+  (bytevector-copy! bv start out 0 mlen)
+  out)
+
+(define (%subbytevector1 bv start)
+  (%subbytevector bv start (bytevector-length bv)))
+
+(define r7:bytevector-copy!
+  (case-lambda*
+   ((to at from #:optional
+        (start 0)
+        (end (+ start
+                (min (- (bytevector-length from) start)
+                     (- (bytevector-length to) at)))))
+    (bytevector-copy! from start to at (- end start)))))
+
+(define r7:bytevector-copy
+  (case-lambda*
+    ((bv) (bytevector-copy bv))
+    ((bv start #:optional (end (bytevector-length bv)))
+     (%subbytevector bv start end))))
+
+(define r7:utf8->string
+  (case-lambda*
+    ((bv) (utf8->string bv))
+    ((bv start #:optional (end (bytevector-length bv)))
+     (utf8->string (%subbytevector bv start end)))))
+
+(define (square x) (* x x))
+
+(define (r7:expt x y)
+  (if (eqv? x 0.0)
+      (exact->inexact (expt x y))
+      (expt x y)))
+
+(define (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}."
+  (call-with-values
+      (lambda () (proc port))
+    (lambda vals
+      (close-port port)
+      (apply values vals))))
+
+(define (features)
+  (append
+   %cond-expand-features
+   (case (native-endianness)
+     ((big) '(big-endian))
+     ((little) '(little-endian))
+     (else '()))
+   '(r6rs
+     syntax-case
+     r7rs exact-closed ieee-float full-unicode ratios)))
+
+(define (input-port-open? port)
+  (and (not (port-closed? port)) (input-port? port)))
+
+(define (output-port-open? port)
+  (and (not (port-closed? port)) (output-port? port)))
diff --git a/module/scheme/case-lambda.scm b/module/scheme/case-lambda.scm
new file mode 100644
index 0000000..992d768
--- /dev/null
+++ b/module/scheme/case-lambda.scm
@@ -0,0 +1,19 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme case-lambda)
+  #:re-export (case-lambda))
diff --git a/module/scheme/char.scm b/module/scheme/char.scm
new file mode 100644
index 0000000..b5251fa
--- /dev/null
+++ b/module/scheme/char.scm
@@ -0,0 +1,85 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Based on code from https://gitlab.com/akku/akku-scm, written
+;;; 2018-2019 by Göran Weinholt <address@hidden>, as well as
+;;; https://github.com/okuoku/yuni, written 2014-2018 by OKUMURA Yuki
+;;; <address@hidden>.  This code was originally released under the
+;;; following terms:
+;;;
+;;;     To the extent possible under law, the author(s) have dedicated
+;;;     all copyright and related and neighboring rights to this
+;;;     software to the public domain worldwide. This software is
+;;;     distributed without any warranty.
+;;;
+;;;     See <http://creativecommons.org/publicdomain/zero/1.0/>, for a
+;;;     copy of the CC0 Public Domain Dedication.
+
+(define-module (scheme char)
+  #:use-module ((srfi srfi-43) #:select (vector-binary-search))
+  #:use-module (ice-9 i18n)
+  #:export (char-foldcase
+            string-foldcase
+            digit-value)
+  #:re-export (char-alphabetic?
+               char-ci<=? char-ci<? char-ci=? char-ci>=?
+               char-ci>? char-downcase char-lower-case?
+               char-numeric? char-upcase char-upper-case? char-whitespace?
+               string-ci<=? string-ci<? string-ci=?
+               string-ci>=? string-ci>?
+               (string-locale-downcase . string-downcase)
+               (string-locale-upcase . string-upcase)))
+
+(define (char-foldcase char)
+    (if (or (eqv? char #\460) (eqv? char #\461))
+       char
+        (char-downcase (char-upcase char))))
+
+(define (string-foldcase str)
+  (string-locale-downcase (string-locale-upcase str)))
+
+;; The table can be extracted with:
+;; awk -F ';' '/ZERO;Nd/ {print "#x"$1}' UnicodeData.txt
+;; Up to date with Unicode 11.0.0
+
+(define *decimal-zeroes* '#(#x0030 #x0660 #x06F0 #x07C0 #x0966 #x09E6
+  #x0A66 #x0AE6 #x0B66 #x0BE6 #x0C66 #x0CE6 #x0D66 #x0DE6 #x0E50
+  #x0ED0 #x0F20 #x1040 #x1090 #x17E0 #x1810 #x1946 #x19D0 #x1A80
+  #x1A90 #x1B50 #x1BB0 #x1C40 #x1C50 #xA620 #xA8D0 #xA900 #xA9D0
+  #xA9F0 #xAA50 #xABF0 #xFF10 #x104A0 #x10D30 #x11066 #x110F0 #x11136
+  #x111D0 #x112F0 #x11450 #x114D0 #x11650 #x116C0 #x11730 #x118E0
+  #x11C50 #x11D50 #x11DA0 #x16A60 #x16B50 #x1D7CE #x1D7D8 #x1D7E2
+  #x1D7EC #x1D7F6 #x1E950))
+
+(define (digit-value char)
+  (define (cmp zero ch)
+    (if (integer? ch)
+        (- (cmp zero ch))
+        (let ((i (char->integer ch)))
+          (cond ((< i zero) 1)
+                ((> i (+ zero 9)) -1)
+                (else 0)))))
+  (unless (char? char)
+    (error "Expected a char" char))
+  (cond
+    ((char<=? #\0 char #\9)             ;fast case
+     (- (char->integer char) (char->integer #\0)))
+    ((vector-binary-search *decimal-zeroes* char cmp)
+     => (lambda (zero)
+          (- (char->integer char)
+             (vector-ref *decimal-zeroes* zero))))
+    (else #f)))
diff --git a/module/scheme/complex.scm b/module/scheme/complex.scm
new file mode 100644
index 0000000..c7403bc
--- /dev/null
+++ b/module/scheme/complex.scm
@@ -0,0 +1,22 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme complex)
+  #:re-export (make-polar
+               magnitude angle
+               make-rectangular
+               imag-part real-part))
diff --git a/module/scheme/cxr.scm b/module/scheme/cxr.scm
new file mode 100644
index 0000000..97856f2
--- /dev/null
+++ b/module/scheme/cxr.scm
@@ -0,0 +1,42 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(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))
diff --git a/module/scheme/eval.scm b/module/scheme/eval.scm
new file mode 100644
index 0000000..e11698d
--- /dev/null
+++ b/module/scheme/eval.scm
@@ -0,0 +1,35 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme eval)
+  #:use-module (ice-9 match)
+  #:export (environment)
+  #:re-export (eval))
+
+(define (environment . import-specs)
+  (let ((module (make-module)))
+    (beautify-user-module! module)
+    (purify-module! module)
+    (module-use! module (resolve-interface '(guile) #:select '(import)))
+    (for-each (lambda (import-spec)
+                (eval (list 'import import-spec) module))
+             import-specs)
+    ;; Remove the "import" import.  FIXME: this is pretty hacky stuff :(
+    (set-module-uses! module (cdr (module-uses module)))
+    (hash-clear! (module-import-obarray module))
+    (module-modified module)
+    module))
diff --git a/module/scheme/file.scm b/module/scheme/file.scm
new file mode 100644
index 0000000..b92849a
--- /dev/null
+++ b/module/scheme/file.scm
@@ -0,0 +1,24 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme file)
+  #:re-export ((open-input-file . open-binary-input-file)
+               (open-output-file . open-binary-output-file)
+               call-with-input-file call-with-output-file
+               delete-file file-exists?
+               open-input-file open-output-file with-input-from-file
+               with-output-to-file))
diff --git a/module/scheme/inexact.scm b/module/scheme/inexact.scm
new file mode 100644
index 0000000..d597b1a
--- /dev/null
+++ b/module/scheme/inexact.scm
@@ -0,0 +1,62 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Based on code from https://gitlab.com/akku/akku-scm, written
+;;; 2018-2019 by Göran Weinholt <address@hidden>, as well as
+;;; https://github.com/okuoku/yuni, written 2014-2018 by OKUMURA Yuki
+;;; <address@hidden>.  This code was originally released under the
+;;; following terms:
+;;;
+;;;     To the extent possible under law, the author(s) have dedicated
+;;;     all copyright and related and neighboring rights to this
+;;;     software to the public domain worldwide. This software is
+;;;     distributed without any warranty.
+;;;
+;;;     See <http://creativecommons.org/publicdomain/zero/1.0/>, for a
+;;;     copy of the CC0 Public Domain Dedication.
+
+(define-module (scheme inexact)
+  #:re-export ((exact->inexact . inexact)
+               (inexact->exact . exact)
+               acos asin atan cos exp sin sqrt tan)
+  #:export ((r7:finite? . finite?)
+            (r7:infinite? . infinite?)
+            (r7:nan? . nan?)
+            (r7:log . log)))
+
+(define (r7:finite? z)
+  (if (complex? z)
+      (and (finite? (real-part z))
+           (finite? (imag-part z)))
+      (finite? z)))
+
+(define (r7:infinite? z)
+  (if (complex? z)
+      (or (inf? (real-part z))
+          (inf? (imag-part z)))
+      (inf? z)))
+
+(define (r7:nan? z)
+  (if (complex? z)
+      (or (nan? (real-part z))
+          (nan? (imag-part z)))
+      (nan? z)))
+
+(define r7:log
+  (case-lambda
+   ((x) (log x))
+   ((x y) (/ (log x) (log y)))))
diff --git a/module/scheme/lazy.scm b/module/scheme/lazy.scm
new file mode 100644
index 0000000..c8cf8e1
--- /dev/null
+++ b/module/scheme/lazy.scm
@@ -0,0 +1,24 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme lazy)
+  #:use-module (srfi srfi-45)
+  #:re-export ((eager . make-promise)
+               (lazy . delay-force)
+               delay
+               force
+               promise?))
diff --git a/module/scheme/load.scm b/module/scheme/load.scm
new file mode 100644
index 0000000..0be8d4b
--- /dev/null
+++ b/module/scheme/load.scm
@@ -0,0 +1,25 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme load)
+  #:export ((r7:load . load)))
+
+(define* (r7:load fn #:optional (env (current-module)))
+  (save-module-excursion
+   (lambda ()
+     (set-current-module env)
+     (load fn))))
diff --git a/module/scheme/process-context.scm 
b/module/scheme/process-context.scm
new file mode 100644
index 0000000..5119cf0
--- /dev/null
+++ b/module/scheme/process-context.scm
@@ -0,0 +1,58 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Based on code from https://gitlab.com/akku/akku-scm, written
+;;; 2018-2019 by Göran Weinholt <address@hidden>, as well as
+;;; https://github.com/okuoku/yuni, written 2014-2018 by OKUMURA Yuki
+;;; <address@hidden>.  This code was originally released under the
+;;; following terms:
+;;;
+;;;     To the extent possible under law, the author(s) have dedicated
+;;;     all copyright and related and neighboring rights to this
+;;;     software to the public domain worldwide. This software is
+;;;     distributed without any warranty.
+;;;
+;;;     See <http://creativecommons.org/publicdomain/zero/1.0/>, for a
+;;;     copy of the CC0 Public Domain Dedication.
+
+(define-module (scheme process-context)
+  #:use-module (srfi srfi-98)
+  #:re-export (command-line
+               get-environment-variable
+               get-environment-variables)
+  #:export (emergency-exit
+            (r7:exit . exit)))
+
+(define (translate-status status)
+  (case status
+    ((#t) 0)
+    ((#f) 1)
+    (else status)))
+
+(define r7:exit
+  (case-lambda
+    (()
+     (exit))
+    ((status)
+     (exit (translate-status status)))))
+
+(define emergency-exit
+  (case-lambda
+    (()
+     (primitive-_exit))
+    ((status)
+     (primitive-_exit (translate-status status)))))
diff --git a/module/scheme/r5rs.scm b/module/scheme/r5rs.scm
new file mode 100644
index 0000000..c08c21d
--- /dev/null
+++ b/module/scheme/r5rs.scm
@@ -0,0 +1,135 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme r5rs)
+  #:use-module ((scheme base) #:select ((expt . r7:expt)))
+  #:use-module ((ice-9 safe-r5rs) #:select (null-environment))
+  #:use-module ((ice-9 r5rs) #:select (scheme-report-environment
+                                       interaction-environment))
+  #:re-export (quote
+               quasiquote
+               unquote unquote-splicing
+               define-syntax let-syntax letrec-syntax
+               define lambda let let* letrec begin do
+               if set! delay and or
+               syntax-rules _ ... else =>
+
+               eqv? eq? equal?
+               number? complex? real? rational? integer?
+               exact? inexact?
+               = < > <= >=
+               zero? positive? negative? odd? even?
+               max min
+               + * - /
+               abs
+               quotient remainder modulo
+               gcd lcm
+               numerator denominator
+               rationalize
+               floor ceiling truncate round
+               exp log sin cos tan asin acos atan
+               sqrt
+               (r7:expt . expt)
+               make-rectangular make-polar real-part imag-part magnitude angle
+               exact->inexact inexact->exact
+
+               number->string string->number
+
+               boolean?
+               not
+
+               pair?
+               cons car cdr
+               set-car! set-cdr!
+               caar cadr cdar cddr
+               caaar caadr cadar caddr cdaar cdadr cddar cdddr
+               caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
+               cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
+               null?
+               list?
+               list
+               length
+               append
+               reverse
+               list-tail list-ref
+               memq memv member
+               assq assv assoc
+
+               symbol?
+               symbol->string string->symbol
+
+               char?
+               char=? char<? char>? char<=? char>=?
+               char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
+               char-alphabetic? char-numeric? char-whitespace?
+               char-upper-case? char-lower-case?
+               char->integer integer->char
+               char-upcase
+               char-downcase
+
+               string?
+               make-string
+               string
+               string-length
+               string-ref string-set!
+               string=? string-ci=?
+               string<? string>? string<=? string>=?
+               string-ci<? string-ci>? string-ci<=? string-ci>=?
+               substring
+               string-length
+               string-append
+               string->list list->string
+               string-copy string-fill!
+
+               vector?
+               make-vector
+               vector
+               vector-length
+               vector-ref vector-set!
+               vector->list list->vector
+               vector-fill!
+
+               procedure?
+               apply
+               map
+               for-each
+               force
+
+               call-with-current-continuation
+
+               values
+               call-with-values
+               dynamic-wind
+
+               eval
+
+               input-port? output-port?
+               current-input-port current-output-port
+
+               read
+               read-char
+               peek-char
+               eof-object?
+               char-ready?
+
+               write
+               display
+               newline
+               write-char
+
+               null-environment
+               scheme-report-environment interaction-environment))
diff --git a/module/scheme/read.scm b/module/scheme/read.scm
new file mode 100644
index 0000000..89f3a1b
--- /dev/null
+++ b/module/scheme/read.scm
@@ -0,0 +1,19 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme read)
+  #:re-export (read))
diff --git a/module/scheme/repl.scm b/module/scheme/repl.scm
new file mode 100644
index 0000000..b25efd8
--- /dev/null
+++ b/module/scheme/repl.scm
@@ -0,0 +1,19 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme repl)
+  #:re-export (interaction-environment))
diff --git a/module/scheme/time.scm b/module/scheme/time.scm
new file mode 100644
index 0000000..a5d43df
--- /dev/null
+++ b/module/scheme/time.scm
@@ -0,0 +1,31 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme time)
+  #:use-module (srfi srfi-19)
+  #:export (current-jiffy current-second jiffies-per-second))
+
+(define (jiffies-per-second)
+  internal-time-units-per-second)
+
+(define (current-jiffy)
+  (get-internal-real-time))
+
+(define (current-second)
+  (let ((t (current-time time-tai)))
+    (+ (time-second t)
+       (* 1e-9 (time-nanosecond t)))))
diff --git a/module/scheme/write.scm b/module/scheme/write.scm
new file mode 100644
index 0000000..945827b
--- /dev/null
+++ b/module/scheme/write.scm
@@ -0,0 +1,23 @@
+;;; R7RS compatibility libraries
+;;; Copyright (C) 2019 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 program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (scheme write)
+  #:use-module (srfi srfi-38)
+  #:re-export (display
+               write
+               (write-with-shared-structure . write-shared)
+               (write . write-simple)))