Commit | Line | Data |
---|---|---|
a6fd89a4 MG |
1 | ;;;; srfi-9.scm --- SRFI-9 procedures 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. | |
a6fd89a4 | 43 | |
e1633bf3 MG |
44 | ;;; Commentary: |
45 | ||
a6fd89a4 MG |
46 | ;;; This module exports the syntactic form `define-record-type', which |
47 | ;;; is the means for creating record types defined in SRFI-9. | |
48 | ;;; | |
49 | ;;; The syntax of a record type definition is: | |
50 | ;;; | |
51 | ;;; <record type definition> | |
52 | ;;; -> (define-record-type <type name> | |
53 | ;;; (<constructor name> <field tag> ...) | |
54 | ;;; <predicate name> | |
55 | ;;; <field spec> ...) | |
56 | ;;; | |
57 | ;;; <field spec> -> (<field tag> <accessor name>) | |
58 | ;;; -> (<field tag> <accessor name> <modifier name>) | |
59 | ;;; | |
60 | ;;; <field tag> -> <identifier> | |
61 | ;;; <... name> -> <identifier> | |
62 | ;;; | |
63 | ;;; Usage example: | |
64 | ;;; | |
65 | ;;; guile> (use-modules (srfi srfi-9)) | |
66 | ;;; guile> (define-record-type :foo (make-foo x) foo? | |
67 | ;;; (x get-x) (y get-y set-y!)) | |
68 | ;;; guile> (define f (make-foo 1)) | |
69 | ;;; guile> f | |
70 | ;;; #<:foo x: 1 y: #f> | |
71 | ;;; guile> (get-x f) | |
72 | ;;; 1 | |
73 | ;;; guile> (set-y! f 2) | |
74 | ;;; 2 | |
75 | ;;; guile> (get-y f) | |
76 | ;;; 2 | |
77 | ;;; guile> f | |
78 | ;;; #<:foo x: 1 y: 2> | |
79 | ;;; guile> (foo? f) | |
80 | ;;; #t | |
81 | ;;; guile> (foo? 1) | |
82 | ;;; #f | |
83 | ||
e1633bf3 MG |
84 | ;;; Code: |
85 | ||
1a179b03 MD |
86 | (define-module (srfi srfi-9) |
87 | :export-syntax (define-record-type)) | |
a6fd89a4 | 88 | |
1b2f40b9 MG |
89 | (cond-expand-provide (current-module) '(srfi-9)) |
90 | ||
a6fd89a4 MG |
91 | (define-macro (define-record-type type-name constructor/field-tag |
92 | predicate-name . field-specs) | |
93 | `(begin | |
94 | (define ,type-name | |
95 | (make-record-type ',type-name ',(map car field-specs))) | |
96 | (define ,(car constructor/field-tag) | |
97 | (record-constructor ,type-name ',(cdr constructor/field-tag))) | |
98 | (define ,predicate-name | |
99 | (record-predicate ,type-name)) | |
100 | ,@(map | |
101 | (lambda (spec) | |
102 | (cond | |
103 | ((= (length spec) 2) | |
104 | `(define ,(cadr spec) | |
105 | (record-accessor ,type-name ',(car spec)))) | |
106 | ((= (length spec) 3) | |
107 | `(begin | |
108 | (define ,(cadr spec) | |
109 | (record-accessor ,type-name ',(car spec))) | |
110 | (define ,(caddr spec) | |
111 | (record-modifier ,type-name ',(car spec))))) | |
112 | (else | |
113 | (error "invalid field spec " spec)))) | |
114 | field-specs))) |