/[cmucl]/src/pcl/pkg.lisp
ViewVC logotype

Contents of /src/pcl/pkg.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Sat Aug 1 15:29:41 1992 UTC (21 years, 8 months ago) by ram
Branch: MAIN
Changes since 1.7: +133 -55 lines
This is July 92 PCL
1 ;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*-
2 ;;;
3 ;;; *************************************************************************
4 ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
5 ;;; All rights reserved.
6 ;;;
7 ;;; Use and copying of this software and preparation of derivative works
8 ;;; based upon this software are permitted. Any distribution of this
9 ;;; software or derivative works must comply with all applicable United
10 ;;; States export control laws.
11 ;;;
12 ;;; This software is made available AS IS, and Xerox Corporation makes no
13 ;;; warranty about the software, its performance or its conformity to any
14 ;;; specification.
15 ;;;
16 ;;; Any person obtaining a copy of this software is requested to send their
17 ;;; name and post office or electronic mail address to:
18 ;;; CommonLoops Coordinator
19 ;;; Xerox PARC
20 ;;; 3333 Coyote Hill Rd.
21 ;;; Palo Alto, CA 94304
22 ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
23 ;;;
24 ;;; Suggestions, comments and requests for improvements are also welcome.
25 ;;; *************************************************************************
26 ;;;
27
28 (in-package ':walker :use '(:lisp))
29
30 (export '(define-walker-template
31 walk-form
32 walk-form-expand-macros-p
33 nested-walk-form
34 variable-lexical-p
35 variable-special-p
36 variable-globally-special-p
37 *variable-declarations*
38 variable-declaration
39 ))
40
41 (in-package :iterate :use '(:lisp :walker))
42
43 (export '(iterate iterate* gathering gather with-gathering interval elements
44 list-elements list-tails plist-elements eachtime while until
45 collecting joining maximizing minimizing summing
46 *iterate-warnings*))
47
48 (in-package :pcl :use '(:lisp :walker :iterate))
49
50 ;;;
51 ;;; Some CommonLisps have more symbols in the Lisp package than the ones that
52 ;;; are explicitly specified in CLtL. This causes trouble. Any Lisp that has
53 ;;; extra symbols in the Lisp package should shadow those symbols in the PCL
54 ;;; package.
55 ;;;
56 #+TI
57 (shadow '(string-append once-only destructuring-bind
58 memq assq delq neq true false
59 without-interrupts
60 defmethod)
61 *the-pcl-package*)
62
63 #+CMU
64 (shadow '(destructuring-bind)
65 *the-pcl-package*)
66
67 #+GCLisp
68 (shadow '(string-append memq assq delq neq make-instance)
69 *the-pcl-package*)
70
71 #+Genera
72 (shadowing-import '(zl:arglist zwei:indentation) *the-pcl-package*)
73
74 #+Lucid
75 (import '(#-LCL3.0 system:arglist #+LCL3.0 lcl:arglist
76 system:structurep system:structure-type system:structure-length
77 #-*lisp-hardware lucid::boolean
78 #+*lisp-hardware *lisp:boolean)
79 *the-pcl-package*)
80
81
82 #+lucid
83 (#-LCL3.0 progn #+LCL3.0 lcl:handler-bind
84 #+LCL3.0 ((lcl:warning #'(lambda (condition)
85 (declare (ignore condition))
86 (lcl:muffle-warning))))
87 (let ((importer
88 #+LCL3.0 #'sys:import-from-lucid-pkg
89 #-LCL3.0 (let ((x (find-symbol "IMPORT-FROM-LUCID-PKG" "LUCID")))
90 (if (and x (fboundp x))
91 (symbol-function x)
92 ;; Only the #'(lambda (x) ...) below is really needed,
93 ;; but when available, the "internal" function
94 ;; 'import-from-lucid-pkg' provides better checking.
95 #'(lambda (name)
96 (import (intern name "LUCID")))))))
97 ;;
98 ;; We need the following "internal", undocumented Lucid goodies:
99 (mapc importer '("%POINTER" "DEFSTRUCT-SIMPLE-PREDICATE"
100 #-LCL3.0 "LOGAND&" "%LOGAND&" #+VAX "LOGAND&-VARIABLE"))
101
102 ;;
103 ;; For without-interrupts.
104 ;;
105 #+LCL3.0
106 (mapc importer '("*SCHEDULER-WAKEUP*" "MAYBE-CALL-SCHEDULER"))
107
108 ;;
109 ;; We import the following symbols, because in 2.1 Lisps they have to be
110 ;; accessed as SYS:<foo>, whereas in 3.0 lisps, they are homed in the
111 ;; LUCID-COMMON-LISP package.
112 (mapc importer '("ARGLIST" "NAMED-LAMBDA" "*PRINT-STRUCTURE*"))
113 ;;
114 ;; We import the following symbols, because in 2.1 Lisps they have to be
115 ;; accessed as LUCID::<foo>, whereas in 3.0 lisps, they have to be
116 ;; accessed as SYS:<foo>
117 (mapc importer '(
118 "NEW-STRUCTURE" "STRUCTURE-REF"
119 "STRUCTUREP" "STRUCTURE-TYPE" "STRUCTURE-LENGTH"
120 "PROCEDUREP" "PROCEDURE-SYMBOL"
121 "PROCEDURE-REF" "SET-PROCEDURE-REF"
122 ))
123 ; ;;
124 ; ;; The following is for the "patch" to the general defstruct printer.
125 ; (mapc importer '(
126 ; "OUTPUT-STRUCTURE" "DEFSTRUCT-INFO"
127 ; "OUTPUT-TERSE-OBJECT" "DEFAULT-STRUCTURE-PRINT"
128 ; "STRUCTURE-TYPE" "*PRINT-OUTPUT*"
129 ; ))
130 ;;
131 ;; The following is for a "patch" affecting compilation of %logand&.
132 ;; On APOLLO, Domain/CommonLISP 2.10 does not include %logand& whereas
133 ;; Domain/CommonLISP 2.20 does; Domain/CommonLISP 2.20 includes :DOMAIN/OS
134 ;; on *FEATURES*, so this conditionalizes correctly for APOLLO.
135 #-(or (and APOLLO DOMAIN/OS) LCL3.0 VAX)
136 (mapc importer '("COPY-STRUCTURE" "GET-FDESC" "SET-FDESC"))
137
138 nil))
139
140 #+kcl
141 (progn
142 (import '(system:structurep))
143 (shadow 'lisp:dotimes)
144 )
145 #+kcl
146 (in-package "SI")
147 #+kcl
148 (export '(%structure-name
149 %compiled-function-name
150 %set-compiled-function-name))
151 #+kcl
152 (in-package 'pcl)
153
154 #+cmu (shadow 'lisp:dotimes)
155
156 #+cmu
157 (import '(kernel:funcallable-instance-p ext:structurep c::boolean)
158 *the-pcl-package*)
159
160 #+CMU
161 (eval-when (compile)
162 (setq c:*suppress-values-declaration* T))
163
164 #-(or cmu lucid)
165 (deftype boolean () '(member t nil))
166
167
168
169 (shadow 'documentation)
170
171
172 ;;;
173 ;;; These come from the index pages of 88-002R.
174 ;;;
175 ;;;
176 (eval-when (compile load eval)
177
178 (defvar *exports* '(add-method
179 built-in-class
180 call-method
181 call-next-method
182 change-class
183 class-name
184 class-of
185 compute-applicable-methods
186 defclass
187 defgeneric
188 define-method-combination
189 defmethod
190 describe-object
191 ensure-generic-function
192 find-class
193 find-method
194 function-keywords
195 generic-flet
196 generic-labels
197 initialize-instance
198 invalid-method-error
199 make-instance
200 make-instances-obsolete
201 method-combination-error
202 method-qualifiers
203 next-method-p
204 no-applicable-method
205 no-next-method
206 print-object
207 reinitialize-instance
208 remove-method
209 shared-initialize
210 slot-boundp
211 slot-exists-p
212 slot-makunbound
213 slot-missing
214 slot-unbound
215 slot-value
216 standard
217 standard-class
218 standard-generic-function
219 standard-method
220 standard-object
221 structure-class
222 #-cmu symbol-macrolet
223 update-instance-for-different-class
224 update-instance-for-redefined-class
225 with-accessors
226 with-added-methods
227 with-slots
228 ))
229
230 );eval-when
231
232 #-(or KCL IBCL CMU)
233 (export *exports* *the-pcl-package*)
234
235 #+CMU
236 (export '#.*exports* *the-pcl-package*)
237
238 #+(or KCL IBCL)
239 (mapc 'export (list *exports*) (list *the-pcl-package*))
240
241
242 (eval-when (compile load eval)
243
244 (defvar *class-exports*
245 '(standard-instance
246 funcallable-standard-instance
247 generic-function
248 standard-generic-function
249 method
250 standard-method
251 standard-accessor-method
252 standard-reader-method
253 standard-writer-method
254 method-combination
255 slot-definition
256 direct-slot-definition
257 effective-slot-definition
258 standard-slot-definition
259 standard-direct-slot-definition
260 standard-effective-slot-definition
261 specializer
262 eql-specializer
263 built-in-class
264 forward-referenced-class
265 standard-class
266 funcallable-standard-class))
267
268 (defvar *chapter-6-exports*
269 '(add-dependent
270 add-direct-method
271 add-direct-subclass
272 add-method
273 allocate-instance
274 class-default-initargs
275 class-direct-default-initargs
276 class-direct-slots
277 class-direct-subclasses
278 class-direct-superclasses
279 class-finalized-p
280 class-precedence-list
281 class-prototype
282 class-slots
283 compute-applicable-methods
284 compute-applicable-methods-using-classes
285 compute-class-precedence-list
286 compute-discriminating-function
287 compute-effective-method
288 compute-effective-slot-definition
289 compute-slots
290 direct-slot-definition-class
291 effective-slot-definition-class
292 ensure-class
293 ensure-class-using-class
294 ensure-generic-function
295 ensure-generic-function-using-class
296 eql-specializer-instance
297 extract-lambda-list
298 extract-specializer-names
299 finalize-inheritance
300 find-method-combination
301 funcallable-standard-instance-access
302 generic-function-argument-precedence-order
303 generic-function-declarations
304 generic-function-lambda-list
305 generic-function-method-class
306 generic-function-method-combination
307 generic-function-methods
308 generic-function-name
309 intern-eql-specializer
310 make-instance
311 make-method-lambda
312 map-dependents
313 method-function
314 method-generic-function
315 method-lambda-list
316 method-specializers
317 method-qualifiers
318 accessor-method-slot-definition
319 reader-method-class
320 remove-dependent
321 remove-direct-method
322 remove-direct-subclass
323 remove-method
324 set-funcallable-instance-function
325 slot-boundp-using-class
326 slot-definition-allocation
327 slot-definition-initargs
328 slot-definition-initform
329 slot-definition-initfunction
330 slot-definition-location
331 slot-definition-name
332 slot-definition-readers
333 slot-definition-writers
334 slot-definition-type
335 slot-exists-p-using-class
336 slot-makunbound-using-class
337 slot-value-using-class
338 specializer-direct-generic-function
339 specializer-direct-methods
340 standard-instance-access
341 update-dependent
342 validate-superclass
343 writer-method-class
344 ))
345
346 );eval-when
347
348 #-(or KCL IBCL)
349 (export *class-exports* *the-pcl-package*)
350
351 #+(or KCL IBCL)
352 (mapc 'export (list *class-exports*) (list *the-pcl-package*))
353
354 #-(or KCL IBCL)
355 (export *chapter-6-exports* *the-pcl-package*)
356
357 #+(or KCL IBCL)
358 (mapc 'export (list *chapter-6-exports*) (list *the-pcl-package*))
359
360 (defvar *slot-accessor-name-package*
361 (or (find-package :slot-accessor-name)
362 (make-package :slot-accessor-name
363 :use '()
364 :nicknames '(:s-a-n))))
365

  ViewVC Help
Powered by ViewVC 1.1.5