~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/clos/kernel.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLOS -*-
 
2
;;;;
1
3
;;;;  Copyright (c) 1992, Giuseppe Attardi.
2
4
;;;;
3
5
;;;;    This program is free software; you can redistribute it and/or
86
88
  (defparameter +standard-generic-function-slots+
87
89
    '((name :initarg :name :initform nil
88
90
       :accessor generic-function-name)
89
 
      (method-hash :accessor generic-function-method-hash
90
 
       :initform (make-hash-table
91
 
                  :test #'eql
92
 
                  ;; use fixnums as limits for efficiency:
93
 
                  :size *default-method-cache-size*
94
 
                  :rehash-size #.(/ *default-method-cache-size* 2)
95
 
                  :rehash-threshold 0.5f0))
96
91
      (spec-list :initform nil :accessor generic-function-spec-list)
97
92
      (method-combination 
98
93
       :initarg :method-combination :initform '(standard)
202
197
      (fdefinition name)
203
198
      ;; create a fake standard-generic-function object:
204
199
      (let ((gfun (si:allocate-raw-instance nil (find-class 't)
205
 
                     #.(length +standard-generic-function-slots+)))
206
 
            (hash (make-hash-table
207
 
                   :test #'eql
208
 
                   ;; use fixnums as limits for efficiency:
209
 
                   :size *default-method-cache-size*
210
 
                   :rehash-size #.(/ *default-method-cache-size* 2)
211
 
                   :rehash-threshold 0.5f0)))
 
200
                     #.(length +standard-generic-function-slots+))))
212
201
        (declare (type standard-object gfun))
213
202
        ;; create a new gfun
214
203
        (si::instance-sig-set gfun)
216
205
              (generic-function-lambda-list gfun) lambda-list
217
206
              (generic-function-method-combination gfun) '(standard)
218
207
              (generic-function-methods gfun) nil
219
 
              (generic-function-spec-list gfun) nil
220
 
              (generic-function-method-hash gfun) hash)
 
208
              (generic-function-spec-list gfun) nil)
221
209
        (when l-l-p
222
210
          (setf (generic-function-argument-precedence-order gfun)
223
211
                (rest (si::process-lambda-list lambda-list t))))
367
355
                              (list ,@a-p-o)))
368
356
                          'function))))))
369
357
    (setf (generic-function-a-p-o-function gf) function)
370
 
    (clrhash (generic-function-method-hash gf)))))
 
358
    (si:clear-gfun-hash gf))))
371
359
 
372
360
(defun print-object (object stream)
373
361
  (print-unreadable-object (object stream)))