Skip to content
Snippets Groups Projects
Commit f8afa85c authored by wlott's avatar wlott
Browse files

This commit was generated by cvs2svn to compensate for changes in r1516,

which included commits to RCS files with non-trunk default branches.
parents 46f3ddcc 9f250b12
No related branches found
No related tags found
No related merge requests found
......@@ -50,3 +50,19 @@
'(ctype hairy-type named-type numeric-type array-type
member-type structure-type union-type args-type
values-type function-type))))
(defun values-type-p (thing)
(and (structurep thing)
(eq (%primitive structure-ref thing 0) 'values-type)))
;;; Define this so that we can copy type-class structures before the defstruct
;;; for type-class runs. ### It relies on structures being build out of
;;; simple-vectors in order to determine the length.
;;;
(defun copy-type-class (tc)
(let ((new (make-type-class)))
(dotimes (i (the index (length (the simple-vector tc))))
(declare (type index i))
(%primitive structure-index-set new i
(%primitive structure-index-ref tc i)))
new))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment