From 6d0bcef5bbf346ba99e3f9965b29596827929c10 Mon Sep 17 00:00:00 2001 From: "Taylor R. Campbell" Date: Fri, 16 Jan 2004 15:37:46 +0000 Subject: [PATCH] Added basic SRFI 10 implementation --- s48/srfi-10/AUTHORS | 1 + s48/srfi-10/BLURB | 1 + s48/srfi-10/README | 23 +++++++++++++++++++++++ s48/srfi-10/interfaces.scm | 6 ++++++ s48/srfi-10/packages.scm | 24 ++++++++++++++++++++++++ s48/srfi-10/srfi-10.scm | 37 +++++++++++++++++++++++++++++++++++++ s48/srfi-10/test/math.scm | 4 ++++ s48/srfi-10/test/pi.scm | 8 ++++++++ 8 files changed, 104 insertions(+) create mode 100644 s48/srfi-10/AUTHORS create mode 100644 s48/srfi-10/BLURB create mode 100644 s48/srfi-10/README create mode 100644 s48/srfi-10/interfaces.scm create mode 100644 s48/srfi-10/packages.scm create mode 100644 s48/srfi-10/srfi-10.scm create mode 100644 s48/srfi-10/test/math.scm create mode 100644 s48/srfi-10/test/pi.scm diff --git a/s48/srfi-10/AUTHORS b/s48/srfi-10/AUTHORS new file mode 100644 index 0000000..7468301 --- /dev/null +++ b/s48/srfi-10/AUTHORS @@ -0,0 +1 @@ +Taylor Campbell diff --git a/s48/srfi-10/BLURB b/s48/srfi-10/BLURB new file mode 100644 index 0000000..2fc5e24 --- /dev/null +++ b/s48/srfi-10/BLURB @@ -0,0 +1 @@ +A SRFI 10 implementation with a facility for user-defined reader constructors. diff --git a/s48/srfi-10/README b/s48/srfi-10/README new file mode 100644 index 0000000..1c1f2e3 --- /dev/null +++ b/s48/srfi-10/README @@ -0,0 +1,23 @@ +The SRFI-10 structure defines an octothorpe reader syntax, comma, as specified +in SRFI 10. It also defines a procedure, DEFINE-READER-CONSTRUCTOR, for user- +defined reader constructors. + +(DEFINE-READER-CONSTRUCTOR ) -> unspecific ;procedure + Define SYMBOL to be a reader constructor, calling PROCEDURE at read-time; + that is, for any instances of #,(SYMBOL ...), PROCEDURE will be applied + to the arguments ARG .... + +The test/ directory contains a couple of examples. A structure whose name is +of the form SRFI-10-TEST/ corresponds to test/.scm. + +This implementation of SRFI 10 is not perfect: it will give errors regarding +invalid data in quotations if your reader constructors construct anything that +isn't an S-expression, and all that's only if you quote those; if you don't +quote the things, you'll get even worse errors. + +There is one built-in reader constructor: + +#,(DEFINE-READER-CONSTRUCTOR ) ;reader constructor + Just like the DEFINE-READER-CONSTRUCTOR procedure, except that NAME must be a + literal symbol, and this operates at read-time. PROCEDURE-EXPRESSION will be + evaluated in the what interaction environment is in state during read-time. diff --git a/s48/srfi-10/interfaces.scm b/s48/srfi-10/interfaces.scm new file mode 100644 index 0000000..841e0d2 --- /dev/null +++ b/s48/srfi-10/interfaces.scm @@ -0,0 +1,6 @@ +;;; This file is part of the Scheme Untergrund Library. + +;; This code, written by Taylor Campbell, is in the public domain. + +(define-interface srfi-10-interface + (export define-reader-constructor)) diff --git a/s48/srfi-10/packages.scm b/s48/srfi-10/packages.scm new file mode 100644 index 0000000..8b15e90 --- /dev/null +++ b/s48/srfi-10/packages.scm @@ -0,0 +1,24 @@ +;;; This file is part of the Scheme Untergrund Library. + +;; This code, written by Taylor Campbell, is in the public domain. + +(define-structure srfi-10 srfi-10-interface + (open scheme + reading + tables + (subset signals (error))) + (files srfi-10)) + +(define-structure srfi-10-test/pi (export) + (open scheme + srfi-10 + floatnums) + (files (test pi))) + +(define-structure srfi-10-test/math (export circumference area) + ;; SRFI-10-TEST/PI already opens SRFI-10, and so the , octothorpe + ;; syntax is already defined in the reader; it is thus not necessary + ;; to open SRFI-10 again. + (open scheme + srfi-10-test/pi) + (files (test math))) diff --git a/s48/srfi-10/srfi-10.scm b/s48/srfi-10/srfi-10.scm new file mode 100644 index 0000000..b62b002 --- /dev/null +++ b/s48/srfi-10/srfi-10.scm @@ -0,0 +1,37 @@ +;;; This file is part of the Scheme Untergrund Library. + +;; This code, written by Taylor Campbell, is in the public domain. + +(define *reader-constructors* (make-symbol-table)) +(define (define-reader-constructor name proc) + (table-set! *reader-constructors* name proc)) +(define (reader-constructor name) + (table-ref *reader-constructors* name)) +(define-sharp-macro #\, + (lambda (c in) + (read-char in) + ;; We want SUB-READ-LIST, not READ, but READING doesn't export it. Oh + ;; well: it's just a bit more error checking here... + (let ((l (read in))) + (if (and (pair? l) (list? (cdr l)) (symbol? (car l))) + (cond ((reader-constructor (car l)) + => (lambda (p) (apply p (cdr l)))) + (else (error "Unrecognized reader constructor" (car l)))) + (error "Invalid #, syntax" l))))) +(define-reader-constructor 'define-reader-constructor + (lambda (name proc-expression) + (define-reader-constructor + (if (symbol? name) + name + (error "Bad reader constructor name" name)) + ;; A better version of this package would be integrated with the Scheme48 + ;; module system, with a new kind of clause -- FOR-READER --, with whose + ;; clauses PROC-EXPRESSION would be evaluated. Oh well. + (let ((p (eval proc-expression (interaction-environment)))) + (if (procedure? p) + p + (error "Reader constructor expr doesn't evaluate to procedure" + name proc-expression p)))) + ;; Must expand at read-time to a valid expression that doesn't really mean + ;; anything. + #t)) diff --git a/s48/srfi-10/test/math.scm b/s48/srfi-10/test/math.scm new file mode 100644 index 0000000..4ef9b81 --- /dev/null +++ b/s48/srfi-10/test/math.scm @@ -0,0 +1,4 @@ +;; This code, written by Taylor Campbell, is in the public domain. + +(define (circumference r) (* '#,(pi) 2 r)) +(define (area r) (* '#,(pi) (expt r 2))) diff --git a/s48/srfi-10/test/pi.scm b/s48/srfi-10/test/pi.scm new file mode 100644 index 0000000..4404460 --- /dev/null +++ b/s48/srfi-10/test/pi.scm @@ -0,0 +1,8 @@ +;; This code, written by Taylor Campbell, is in the public domain. + +;; If the #, is uncommented, the ' should be commented; and vice versa. + +#, +(define-reader-constructor + ;' + pi (lambda () (atan 0 -1)))