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")
16 (/show0
"code/alien-type.lisp 16")
18 (sb!xc
:defstruct
(alien-value (:copier nil
) (:constructor %sap-alien
(sap type
)))
19 (sap nil
:type sb
!sys
:system-area-pointer
)
20 (type nil
:type sb
!alien
::alien-type
))
21 (sb!xc
:proclaim
'(freeze-type alien-value
))
23 (!begin-collecting-cold-init-forms
)
25 (!define-type-class alien
:enumerable nil
:might-contain-other-types nil
)
27 (!define-type-method
(alien :negate
) (type) (make-negation-type type
))
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
38 ;;; others (toplevel form time instead of cold load init time) because
39 ;;; ALIEN-VALUE itself is a structure which isn't defined until fairly
41 (!define-superclasses alien
((alien-value)) progn
)
43 (!define-type-method
(alien :simple-
=) (type1 type2
)
44 (let ((alien-type-1 (alien-type-type-alien-type type1
))
45 (alien-type-2 (alien-type-type-alien-type type2
)))
46 (values (or (eq alien-type-1 alien-type-2
)
47 (alien-type-= alien-type-1 alien-type-2
))
50 (!def-type-translator alien
(&optional
(alien-type nil
))
53 (make-alien-type-type))
55 (make-alien-type-type alien-type
))
57 (make-alien-type-type (parse-alien-type alien-type
(make-null-lexenv))))))
59 (defun make-alien-type-type (&optional alien-type
)
61 (let ((lisp-rep-type (compute-lisp-rep-type alien-type
)))
63 (single-value-specifier-type lisp-rep-type
)
64 (%make-alien-type-type alien-type
)))
67 (!defun-from-collected-cold-init-forms
!alien-type-cold-init
)
69 (/show0
"code/alien-type.lisp end of file")