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

Contents of /src/pcl/pkg.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5