Commit | Line | Data |
---|---|---|
6be07c52 TTN |
1 | ;;; srfi-9.scm --- define-record-type |
2 | ||
3 | ;; Copyright (C) 2001, 2002 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 | |
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 | ||
6be07c52 TTN |
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 | |
a6fd89a4 | 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))) | |
6be07c52 TTN |
115 | |
116 | ;;; srfi-9.scm ends here |