1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
#| rep.module-system bootstrap
$Id$
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
This file is part of librep.
librep is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
librep 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 General Public License for more details.
You should have received a copy of the GNU General Public License
along with librep; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|#
(declare (in-module rep.module-system))
(open-structures '(rep.lang.symbols
rep.structures
rep.data))
;; rename the bindings required by exported macros
(%define %make-structure make-structure)
(%define %make-interface make-interface)
(%define %parse-interface parse-interface)
(%define %external-structure-ref external-structure-ref)
(%define %alias-structure alias-structure)
;; module syntax
(defmacro define-interface (name sig)
"Associate the symbol NAME with the module interface SIG (in a
separate interface-name namespace). An interface specification must be
of the form:
INTERFACE -> (export [ID...])
or NAME
or (compound-interface [INTERFACE...])
or (structure-interface [STRUCTURE-NAME...])
where an ID is a symbol naming a top-level binding to export, and NAME
is the name of an interface previously defined using define-interface.
The `export' form adds top-level definitions ID... to the interface;
the `compound-interface' clauses forms the union of the given
interfaces."
(list '%make-interface (list 'quote name)
(list '%parse-interface (list 'quote sig))))
(defmacro structure (#!optional sig config . body)
"Create a new module whose interface is SIG, whose configuration is
defined by CONFIG (either a single clause, or a list of clauses), and
whose definitions are defined by the list of forms BODY.
See `define-interface' for the interface syntax, each configuration
clause must have the syntax:
CLAUSE -> (open [NAME...])
or (access [NAME...])
where NAME is the name of a module. Opening a module imports all of its
exported definitions into the currently module, while accessing a
module makes the exported definitions available from the current module
using the `structure-ref' form."
(unless (listp (car config))
(setq config (list config)))
(list '%make-structure (list '%parse-interface (list 'quote sig))
(list* 'lambda nil (cons '(open rep.module-system) config))
(list* 'lambda nil body)))
(defmacro define-structure (name #!optional sig config . body)
"Create a module called NAME whose interface is SIG, whose
configuration is defined by CONFIG (either a single clause, or a list
of clauses), and whose definitions are defined by the list of forms
BODY.
See the `define-interface' and `structure' macros for descriptions of
the interface and configuration clause syntaxes respectively."
(unless (listp (car config))
(setq config (list config)))
(list '%make-structure (list '%parse-interface (list 'quote sig))
(list* 'lambda nil (cons '(open rep.module-system) config))
(list* 'lambda nil body)
(list 'quote name)))
(defmacro define-structures (structs config . body)
"Similar to `define-structure' except that multiple structures are
created, each exporting a particular view of the underlying bindings.
STRUCTS is a list defining the names and interfaces of the created
modules, each item has the form `(NAME INTERFACE)'. CONFIG and BODY are
exactly the same as in the `define-structure' syntax."
(unless (listp (car config))
(setq config (list config)))
(require 'rep.lang.backquote)
(let ((tem (gensym)))
`(let ((,tem (list (structure () ((export-all) ,@config) ,@body))))
,@(mapcar (lambda (x)
(let ((name (car x))
(interface (cadr x)))
`(%make-structure
(%parse-interface ',interface)
(lambda ()
(open rep.module-system)
(%open-structures ,tem))
() ',name)))
structs))))
(defmacro define-structure-alias (to from)
"Create a secondary name TO for the structure called FROM."
(list '%alias-structure (list 'quote from) (list 'quote to)))
(defmacro structure-ref (struct-name var-name)
"Evaluates to the current value of the global binding of symbol
VAR-NAME in the module called STRUCT-NAME. This structure must
previously have been opened or accessed by the current module.
When read, the syntax `FOO#BAR' expands to `(structure-ref FOO BAR)'."
(list '%external-structure-ref
(list 'quote struct-name) (list 'quote var-name)))
;; `%meta' structure used for configuring modules
;; helper definitions
(defmacro structure-open names
(list '%open-structures (list 'quote names)))
(defmacro structure-access names
(list '%access-structures (list 'quote names)))
(defmacro set-binds ()
(list '%structure-set-binds (list '%current-structure) ''t))
(defmacro export-all ()
(list '%structure-exports-all (list '%current-structure) ''t))
(let ((meta-struct (make-structure '(open %open-structures
access %access-structures
set-binds %structure-set-binds
export-all %structure-exports-all
%current-structure quote)
nil nil '%meta)))
(structure-define meta-struct 'quote quote)
(structure-define meta-struct 'open structure-open)
(structure-define meta-struct '%open-structures open-structures)
(structure-define meta-struct 'access structure-access)
(structure-define meta-struct '%access-structures access-structures)
(structure-define meta-struct 'set-binds set-binds)
(structure-define meta-struct '%structure-set-binds structure-set-binds)
(structure-define meta-struct 'export-all export-all)
(structure-define meta-struct '%structure-exports-all structure-exports-all)
(structure-define meta-struct '%current-structure current-structure))
;; exports
(export-bindings '(define-interface structure define-structure
define-structures define-structure-alias structure-ref
%make-structure %make-interface %parse-interface
%external-structure-ref %alias-structure))
(export-bindings '(lambda validate-byte-code run-byte-code load))
|
