[e5072a]: src / clos / builtin.lsp Maximize Restore History

Download this file

builtin.lsp    133 lines (114 with data), 4.0 kB

  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
;;;; Copyright (c) 1992, Giuseppe Attardi.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Library General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; See file '../Copyright' for full details.
(in-package "CLOS")
;;; ----------------------------------------------------------------------
;;; Methods
(defmethod make-instance ((class-name symbol) &rest initargs)
(apply #'make-instance (find-class class-name) initargs))
(defmethod change-class ((instance t) (new-class symbol))
(funcall #'change-class instance (find-class new-class)))
;;; ======================================================================
;;; STRUCTURES
;;;
(defclass structure-class (class)
(slot-descriptions initial-offset defstruct-form constructors documentation
copier predicate print-function))
;;; structure-classes cannot be instantiated
(defmethod make-instance ((class structure-class) &rest initargs)
(declare (ignore initargs))
(error "The structure-class (~A) cannot be instantiated" class))
(defmethod finalize-inheritance ((class structure-class))
(call-next-method)
(dolist (slot (class-slots class))
(unless (eq :INSTANCE (slotd-allocation slot))
(error "The structure class ~S can't have shared slots" name))))
;;; ----------------------------------------------------------------------
;;; Structure-object
;;;
;;; Structure-object has no slots and inherits only from t:
;;; (defclass structure-object (t) ())
(defclass structure-object (t) ()
(:metaclass structure-class))
(defmethod print-object ((obj structure-object) stream)
(let* ((class (si:instance-class obj))
(slotds (class-slots class)))
(princ "#S(" stream)
(prin1 (class-name class) stream)
(do ((scan slotds (cdr scan))
(i 0 (1+ i))
(sv))
((null scan))
(declare (fixnum i))
(setq sv (si:instance-ref obj i))
(princ " " stream)
(prin1 (slotd-name (car scan)) stream)
(princ " " stream)
(prin1 sv stream)
)
(princ ")" stream)
obj))
;;; ======================================================================
;;; Built-in classes
;;; ----------------------------------------------------------------------
;;;
;;; IMPORTANT!
;;; This class did not exist until now. This was no problem, because it is
;;; not used anywhere in ECL. However, we have to define and we have to
;;; ensure that "T" becomes an instance of BUILT-IN-CLASS.
(defclass built-in-class (class)
())
(si:instance-class-set (find-class 't) (find-class 'built-in-class))
(defun create-built-in-class (options)
(let* ((name (first options))
(direct-superclasses (mapcar #'find-class (or (rest options)
'(t)))))
(setf (find-class name)
(make-instance (find-class 'built-in-class)
:name name
:direct-superclasses direct-superclasses
:direct-slots nil))))
(defmethod make-instance ((class built-in-class) &rest initargs)
(declare (ignore initargs))
(error "The built-in class (~A) cannot be instantiated" class))
(mapcar #'create-built-in-class
'(;(t object)
(sequence)
(list sequence)
(cons list)
(array)
(vector array sequence)
(string vector)
(bit-vector vector)
(stream)
(file-stream stream)
(echo-stream stream)
(string-stream stream)
(two-way-stream stream)
(synonym-stream stream)
(broadcast-stream stream)
(concatenated-stream stream)
(character)
(number)
(real number)
(rational real)
(integer rational)
(ratio rational)
(float real)
(complex number)
(symbol)
(null symbol list)
(keyword symbol)
(method-combination)
(package)
(function)
(pathname)
(logical-pathname pathname)
(hash-table)
(random-state)
(readtable)))