Commit | Line | Data |
---|---|---|
e1633bf3 MG |
1 | ;;;; srfi-10.scm --- SRFI-10 read hash extension for Guile |
2 | ;;;; | |
3 | ;;;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ;;;; | |
5 | ;;;; This program is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU General Public License as | |
7 | ;;;; published by the Free Software Foundation; either version 2, or | |
8 | ;;;; (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This program is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU General Public License | |
16 | ;;;; along with this software; see the file COPYING. If not, write to | |
17 | ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
18 | ;;;; Boston, MA 02111-1307 USA | |
f480396b MV |
19 | ;;;; |
20 | ;;;; As a special exception, the Free Software Foundation gives permission | |
21 | ;;;; for additional uses of the text contained in its release of GUILE. | |
22 | ;;;; | |
23 | ;;;; The exception is that, if you link the GUILE library with other files | |
24 | ;;;; to produce an executable, this does not by itself cause the | |
25 | ;;;; resulting executable to be covered by the GNU General Public License. | |
26 | ;;;; Your use of that executable is in no way restricted on account of | |
27 | ;;;; linking the GUILE library code into it. | |
28 | ;;;; | |
29 | ;;;; This exception does not however invalidate any other reasons why | |
30 | ;;;; the executable file might be covered by the GNU General Public License. | |
31 | ;;;; | |
32 | ;;;; This exception applies only to the code released by the | |
33 | ;;;; Free Software Foundation under the name GUILE. If you copy | |
34 | ;;;; code from other Free Software Foundation releases into a copy of | |
35 | ;;;; GUILE, as the General Public License permits, the exception does | |
36 | ;;;; not apply to the code that you add in this way. To avoid misleading | |
37 | ;;;; anyone as to the status of such modified files, you must delete | |
38 | ;;;; this exception notice from them. | |
39 | ;;;; | |
40 | ;;;; If you write modifications of your own for GUILE, it is your choice | |
41 | ;;;; whether to permit this exception to apply to your modifications. | |
42 | ;;;; If you do not wish that, delete this exception notice. | |
e1633bf3 MG |
43 | |
44 | ;;; Commentary: | |
45 | ||
46 | ;;; This module implements the syntax extension #,(), also called | |
47 | ;;; hash-comma, which is defined in SRFI-10. | |
48 | ;;; | |
49 | ;;; The support for SRFI-10 consists of the procedure | |
50 | ;;; `define-reader-ctor' for defining new reader constructors and the | |
51 | ;;; read syntax form | |
52 | ;;; | |
53 | ;;; #,(<ctor> <datum> ...) | |
54 | ;;; | |
55 | ;;; where <ctor> must be a symbol for which a read constructor was | |
56 | ;;; defined previously. | |
57 | ;;; | |
58 | ;;; Example: | |
59 | ;;; | |
60 | ;;; (define-reader-ctor 'file open-input-file) | |
61 | ;;; (define f '#,(file "/etc/passwd")) | |
62 | ;;; (read-line f) | |
63 | ;;; => | |
2d953700 | 64 | ;;; "root:x:0:0:root:/root:/bin/bash" |
e1633bf3 MG |
65 | ;;; |
66 | ;;; Please note the quote before the #,(file ...) expression. This is | |
67 | ;;; necessary because ports are not self-evaluating in Guile. | |
68 | ||
69 | ;;; Code: | |
70 | ||
71 | (define-module (srfi srfi-10) | |
1a179b03 MD |
72 | :use-module (ice-9 rdelim) |
73 | :export (define-reader-ctor)) | |
e1633bf3 | 74 | |
1b2f40b9 MG |
75 | (cond-expand-provide (current-module) '(srfi-10)) |
76 | ||
e1633bf3 MG |
77 | ;; This hash table stores the association between comma-hash tags and |
78 | ;; the corresponding constructor procedures. | |
79 | ;; | |
80 | (define reader-ctors (make-hash-table 31)) | |
81 | ||
82 | ;; This procedure installs the procedure @var{proc} as the constructor | |
83 | ;; for the comma-hash tag @var{symbol}. | |
84 | ;; | |
85 | (define (define-reader-ctor symbol proc) | |
86 | (hashq-set! reader-ctors symbol proc) | |
87 | (if #f #f)) ; Return unspecified value. | |
88 | ||
89 | ;; Retrieve the constructor procedure for the tag @var{symbol} or | |
90 | ;; throw an error if no such tag is defined. | |
91 | ;; | |
92 | (define (lookup symbol) | |
93 | (let ((p (hashq-ref reader-ctors symbol #f))) | |
94 | (if (procedure? p) | |
95 | p | |
96 | (error "unknown hash-comma tag " symbol)))) | |
97 | ||
98 | ;; This is the actual reader extension. | |
99 | ;; | |
100 | (define (hash-comma char port) | |
101 | (let* ((obj (read port))) | |
102 | (if (and (list? obj) (positive? (length obj)) (symbol? (car obj))) | |
103 | (let ((p (lookup (car obj)))) | |
104 | (let ((res (apply p (cdr obj)))) | |
105 | res)) | |
106 | (error "syntax error in hash-comma expression")))) | |
107 | ||
108 | ;; Install the hash extension. | |
109 | ;; | |
110 | (read-hash-extend #\, hash-comma) |