1 ;;;; ALIEN-related type system stuff, done later
2 ;;;; than other type system stuff because it depends on the definition
3 ;;;; of the ALIEN-VALUE target structure type
5 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
14 (in-package "SB!KERNEL")
19 (!begin-collecting-cold-init-forms)
21 (defstruct (alien-type-type
23 (class-info (type-class-or-lose 'alien)))
24 (:constructor %make-alien-type-type (alien-type)))
25 (alien-type nil :type alien-type))
27 (define-type-class alien)
29 (define-type-method (alien :unparse) (type)
30 `(alien ,(unparse-alien-type (alien-type-type-alien-type type))))
32 (define-type-method (alien :simple-subtypep) (type1 type2)
33 (values (alien-subtype-p (alien-type-type-alien-type type1)
34 (alien-type-type-alien-type type2))
37 ;;; KLUDGE: This DEFINE-SUPERCLASSES gets executed much later than the others
38 ;;; (toplevel form time instead of cold load init time) because ALIEN-VALUE
39 ;;; itself is a structure which isn't defined until fairly late.
41 ;;; FIXME: I'm somewhat tempted to just punt ALIEN from the type system.
42 ;;; It's sufficiently unlike the others that it's a bit of a pain, and
43 ;;; it doesn't seem to be put to any good use either in type inference or
44 ;;; in type declarations.
45 (define-superclasses alien ((alien-value)) progn)
47 (define-type-method (alien :simple-=) (type1 type2)
48 (let ((alien-type-1 (alien-type-type-alien-type type1))
49 (alien-type-2 (alien-type-type-alien-type type2)))
50 (values (or (eq alien-type-1 alien-type-2)
51 (alien-type-= alien-type-1 alien-type-2))
54 (def-type-translator alien (&optional (alien-type nil))
57 (make-alien-type-type))
59 (make-alien-type-type alien-type))
61 (make-alien-type-type (parse-alien-type alien-type (make-null-lexenv))))))
63 (defun make-alien-type-type (&optional alien-type)
65 (let ((lisp-rep-type (compute-lisp-rep-type alien-type)))
67 (specifier-type lisp-rep-type)
68 (%make-alien-type-type alien-type)))
71 (!defun-from-collected-cold-init-forms !alien-type-cold-init)