diff --git a/code/type-init.lisp b/code/type-init.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..65d50754a30f5502b5adb92e38da88005e22934f
--- /dev/null
+++ b/code/type-init.lisp
@@ -0,0 +1,51 @@
+;;; -*- Package: KERNEL; Log: C.Log -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type-init.lisp,v 1.1 1993/02/04 12:11:42 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;;    This file's top-level forms are run, it precomputes the translations for
+;;; commonly used type specifiers.  This stuff is split off from the other type
+;;; stuff to get around problems with everything needing to be loaded before
+;;; everything else.  This is the first file which really exercises the type
+;;; stuff.  This stuff is also somewhat implementation-dependent in that
+;;; implementations may want to precompute other types which are important to
+;;; them.
+;;;
+;;; Written by Rob MacLachlan
+;;;
+(in-package "KERNEL")
+
+(export '*null-type*)
+
+;;; Built-in classes...
+
+(dolist (x built-in-classes)
+  (destructuring-bind (name &key (translation nil trans-p) &allow-other-keys)
+		      x
+    (when trans-p
+      (let ((class (info type class name))
+	    (type (specifier-type translation)))
+	(setf (built-in-class-translation class) type)
+	(setf (info type builtin name) type)))))
+
+;;; Numeric types...
+
+(precompute-types '((mod 2) (mod 4) (mod 16) (mod #x100) (mod #x10000)
+		    (mod #x100000000)
+		    (unsigned-byte 1) (unsigned-byte 2) (unsigned-byte 4)
+		    (unsigned-byte 8) (unsigned-byte 16) (unsigned-byte 32)
+		    (signed-byte 8) (signed-byte 16) (signed-byte 32)))
+
+;;; Builtin symbol type specifiers:
+
+(precompute-types type-specifier-symbols)
+
+(defparameter *null-type* (specifier-type 'null))
diff --git a/code/typedefs.lisp b/code/typedefs.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..61b2ca2c884b464a1a0b62ea5533bbbba9862e80
--- /dev/null
+++ b/code/typedefs.lisp
@@ -0,0 +1,409 @@
+;;; -*- Package: KERNEL; Log: C.Log -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/typedefs.lisp,v 1.1 1993/02/04 12:13:24 ram Exp $")
+;;;
+;;; **********************************************************************
+;;;
+;;;    This file contains the definition of the CTYPE (Compiler TYPE) structure
+;;; and related macros used for manipulating it.  This is sort of a mini object
+;;; system with rather odd dispatching rules.  Other compile-time definitions
+;;; needed by multiple files are also here.
+;;;
+;;; Written by Rob MacLachlan
+;;;
+(in-package "KERNEL")
+
+;;; These are the Common Lisp defined type specifier symbols.  These are the
+;;; things which can be used as declarations without requiring the use of TYPE.
+(defconstant type-specifier-symbols
+  '(array atom bignum bit bit-vector character common compiled-function
+    complex cons double-float extended-char fixnum float function
+    hash-table integer keyword list long-float nil null number package
+    pathname random-state ratio rational real readtable sequence
+    short-float simple-array simple-bit-vector simple-string simple-vector
+    single-float standard-char stream string base-char symbol t vector))
+
+
+;;; Def-Type-Translator  --  Interface
+;;;
+;;;    Define the translation from a type-specifier to a type structure for
+;;; some particular type.  Syntax is identical to DEFTYPE.
+;;;
+(defmacro def-type-translator (name arglist &body body)
+  (check-type name symbol)
+  (let ((whole (gensym)))
+    (multiple-value-bind
+	(body local-decs)
+	(lisp::parse-defmacro arglist whole body name 'def-type-translator
+			      :default-default ''*)
+      `(progn
+	 (cold-load-init
+	   (setf (info type translator ',name)
+		 #'(lambda (,whole) ,@local-decs (block ,name ,body))))
+	 ',name))))
+
+
+;;; Defvars for these come later, after we have enough stuff defined.
+(proclaim '(special *wild-type* *universal-type* *empty-type*))
+
+
+;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that
+;;; compiler warnings can be emitted as appropriate.
+;;;
+(eval-when (compile load eval)
+  (define-condition parse-unknown-type (condition)
+    (specifier)))
+
+
+;;;; Cold load hack magic.
+
+(eval-when (compile load eval)
+
+(defparameter cold-type-init-forms nil
+  "Forms that must happen before top level forms are run.")
+
+(defmacro with-cold-load-init-forms ()
+  '(eval-when (compile eval)
+     (setq cold-type-init-forms nil)))
+
+(defmacro cold-load-init (&rest forms)
+  (if (and (consp forms) (consp (car forms)) (eq (caar forms) 'eval-when))
+      (let ((when (cadar forms))
+	    (eval-when-forms (cddar forms)))
+	(unless (= (length forms) 1)
+	  (warn "Can't cold-load-init other forms along with an eval-when."))
+	(when (member 'load when)
+	  (setf cold-type-init-forms
+		(nconc cold-type-init-forms (copy-list eval-when-forms))))
+	`(eval-when ,(remove 'load when)
+	   ,@eval-when-forms))
+      (progn
+	(setf cold-type-init-forms
+	      (nconc cold-type-init-forms (copy-list forms)))
+	nil)))
+
+(defmacro emit-cold-load-defuns (prefix)
+  (let ((index 0))
+    (collect ((defuns)
+	      (calls))
+      (loop
+	(unless cold-type-init-forms (return))
+	(let ((num-forms (min 10 (length cold-type-init-forms)))
+	      (name (intern (format nil "~A-INIT-~D" prefix (incf index)))))
+	  (defuns `(defun ,name ()
+		     ,@(subseq cold-type-init-forms 0 num-forms)))
+	  (setf cold-type-init-forms (nthcdr num-forms cold-type-init-forms))
+	  (calls (list name))))
+      `(progn
+	 ,@(defuns)
+	 (defun ,(intern (format nil "~A-INIT" prefix)) ()
+	   ,@(calls)
+	   nil)))))
+
+); eval-when
+
+;; Use this definition if you are trying to use this interactivly.
+#+nil
+(defmacro cold-load-init (&rest forms)
+  `(progn ,@forms))
+
+
+;;;; Type classes:
+;;;
+;;;    The TYPE-CLASS structure represents the "kind" of a type.  It mainly
+;;; contains functions which are methods on that kind of type, but is also use
+;;; in EQ comparisons to determined if two types have the "same kind".
+
+(defvar *type-classes*)
+(cold-load-init
+  (unless (boundp '*type-classes*)
+    (setq *type-classes* (make-hash-table :test #'eq))))
+
+;;; TYPE-CLASS-OR-LOSE  --  Interface
+;;;
+(defun type-class-or-lose (name)
+  (or (gethash name *type-classes*)
+      (error "~S is not a defined type class." name)))
+
+;;; MUST-SUPPLY-THIS  --  Interface
+;;;
+(defun must-supply-this (&rest foo)
+  (error "Missing type method for ~S" foo))
+
+
+(defstruct (type-class
+	    (:print-function
+	     (lambda (s stream d)
+	       (declare (ignore d))
+	       (format stream "#<TYPE-CLASS ~S>" (type-class-name s)))))
+			     
+  ;;
+  ;; Name of this type class, used to resolve references at load time.
+  (name nil :type symbol)
+  ;;
+  ;; Dyadic type methods.  If the classes of the two types are EQ, then we call
+  ;; the SIMPLE-xxx method.  If the classes are not EQ, and either type's class
+  ;; has a COMPLEX-xxx method, then we call it.
+  ;;
+  ;; Although it is undefined which method will get precedence when both types
+  ;; have a complex method, the complex method can assume that the second arg
+  ;; always is in its class, and the first always is not.  The arguments to
+  ;; commutative operations will be swapped if the first argument has a complex
+  ;; method.
+  ;;
+  ;; Since SUBTYPEP is not commutative, we have two complex methods.  the ARG1
+  ;; method is only called when the first argument is in its class, and the
+  ;; ARG2 method is only called when called when the second type is.  If either
+  ;; is specified, both must be.
+  (simple-subtypep #'must-supply-this :type function)
+  (complex-subtypep-arg1 nil :type (or function null))
+  (complex-subtypep-arg2 nil :type (or function null))
+  ;;
+  ;; SIMPLE-UNION combines two types of the same class into a single type of
+  ;; that class.  If the result is a two-type union, then return NIL.
+  ;; VANILLA-UNION returns whichever argument is a supertype of the other, or
+  ;; NIL.
+  (simple-union #'vanilla-union :type function)
+  (complex-union nil :type (or function null))
+  ;;
+  ;; The default intersection methods assume that if one type is a subtype of
+  ;; the other, then that type is the intersection.
+  (simple-intersection #'vanilla-intersection :type function)
+  (complex-intersection nil :type (or function null))
+  ;;
+  (simple-= #'must-supply-this :type function)
+  (complex-= nil :type (or function null))
+  ;;
+  ;; Function which returns a Common Lisp type specifier representing this
+  ;; type.
+  (unparse #'must-supply-this :type function)
+  
+  #|
+  Not used, and not really right.  Probably we want a TYPE= alist for the
+  unary operations, since there are lots of interesting unary predicates that
+  aren't equivalent to an entire class
+  ;;
+  ;; Names of functions used for testing the type of objects in this type
+  ;; class.  UNARY-PREDICATE takes just the object, whereas PREDICATE gets
+  ;; passed both the object and the CTYPE.  Normally one or the other will be
+  ;; supplied for any type that can be passed to TYPEP; there is no point in
+  ;; supplying both.
+  (unary-typep nil :type (or symbol null))
+  (typep nil :type (or symbol null))
+  ;;
+  ;; Like TYPEP, UNARY-TYPEP except these functions coerce objects to this
+  ;; type.
+  (unary-coerce nil :type (or symbol null))
+  (coerce :type (or symbol null))
+  |#
+  )
+
+
+(eval-when (compile load eval)
+
+(defconstant type-class-function-slots
+  '((:simple-subtypep . type-class-simple-subtypep)
+    (:complex-subtypep-arg1 . type-class-complex-subtypep-arg1)
+    (:complex-subtypep-arg2 . type-class-complex-subtypep-arg2)
+    (:simple-union . type-class-simple-union)
+    (:complex-union . type-class-complex-union)
+    (:simple-intersection . type-class-simple-intersection)
+    (:complex-intersection . type-class-complex-intersection)
+    (:simple-= . type-class-simple-=)
+    (:complex-= . type-class-complex-=)
+    (:unparse . type-class-unparse)))
+
+(defconstant type-class-symbol-slots
+  '((:unary-typep . type-class-unary-typep)
+    (:typep . type-class-typep)
+    (:unary-coerce . type-class-unary-coerce)
+    (:coerce . type-class-coerce)))
+  
+
+;;; CLASS-FUNCTION-SLOT-OR-LOSE  --  Interface
+;;;
+(defun class-function-slot-or-lose (name)
+  (or (cdr (assoc name type-class-function-slots))
+      (error "~S is not a defined type class method." name)))
+
+); Eval-When (Compile Load Eval)
+
+
+;;; DEFINE-TYPE-METHOD  --  Interface
+;;;
+(defmacro define-type-method ((class method &rest more-methods)
+			      lambda-list &body body)
+  "DEFINE-TYPE-METHOD (Class-Name Method-Name+) Lambda-List Form*"
+  (let ((name (symbolicate CLASS "-" method "-TYPE-METHOD")))
+    `(progn
+       (defun ,name ,lambda-list ,@body)
+       (cold-load-init
+	 ,@(mapcar #'(lambda (method)
+		       `(setf (,(class-function-slot-or-lose method)
+			       (type-class-or-lose ',class))
+			      #',name))
+		   (cons method more-methods)))
+       (undefined-value))))
+
+
+;;; DEFINE-TYPE-CLASS  --  Interface
+;;;
+(defmacro define-type-class (name &optional inherits)
+  "DEFINE-TYPE-CLASS Name [Inherits]"
+  `(cold-load-init
+     ,(once-only ((n-class (if inherits
+			       `(copy-structure (type-class-or-lose ',inherits))
+			       '(make-type-class))))
+	`(progn
+	   (setf (type-class-name ,n-class) ',name)
+	   (setf (gethash ',name *type-classes*) ,n-class)
+	   (undefined-value)))))
+
+
+;;; INVOKE-TYPE-METHOD  --  Interface
+;;;
+;;;    Invoke a type method on TYPE1 and TYPE2.  If the two types have the same
+;;; class, invoke the simple method.  Otherwise, invoke any complex method.  If
+;;; there isn't a distinct complex-arg1 method, then swap the arguments when
+;;; calling type1's method.  If no applicable method, return DEFAULT.
+;;;
+(defmacro invoke-type-method (simple complex-arg2 type1 type2 &key
+				     (default '(values nil t))
+				     complex-arg1)
+  (let ((simple (class-function-slot-or-lose simple))
+	(cslot1 (class-function-slot-or-lose (or complex-arg1 complex-arg2)))
+	(cslot2 (class-function-slot-or-lose complex-arg2)))
+    (once-only ((n-type1 type1)
+		(n-type2 type2))
+      (once-only ((class1 `(type-class-info ,n-type1))
+		  (class2 `(type-class-info ,n-type2)))
+	`(if (eq ,class1 ,class2)
+	     (funcall (,simple ,class1) ,n-type1 ,n-type2)
+	     ,(once-only ((complex1 `(,cslot1 ,class1))
+			  (complex2 `(,cslot2 ,class2)))
+		`(cond (,complex2 (funcall ,complex2 ,n-type1 ,n-type2))
+		       (,complex1
+			,(if complex-arg1
+			     `(funcall ,complex1 ,n-type1 ,n-type2)
+			     `(funcall ,complex1 ,n-type2 ,n-type1)))
+		       (t ,default))))))))
+
+
+;;; The XXX-Type structures include the CTYPE structure for some slots that
+;;; apply to all types.
+;;;
+(defstruct (ctype (:conc-name type-)
+		  (:constructor make-type))
+  ;;
+  ;; The class of this type.
+  (class-info (required-argument) :type type-class)
+  ;;
+  ;; True if this type has a fixed number of members, and as such could
+  ;; possibly be completely specified in a MEMBER type.  This is used by the
+  ;; MEMBER type methods.
+  (enumerable nil :type (member t nil) :read-only t))
+
+;;; %Print-Type  --  Internal
+;;;
+;;;    The print-function for all type structures.
+;;;
+(defun %print-type (s stream d)
+  (declare (ignore d))
+  (format stream "#<~A ~S>" (type-of s) (type-specifier s)))
+
+
+;;;; Utilities:
+
+;;; ANY-TYPE-OP, EVERY-TYPE-OP  --  Interface
+;;;
+;;;    Like ANY and EVERY, except that we handle two-arg uncertain predicates.
+;;; If the result is uncertain, then we return Default from the block PUNT.
+;;; If LIST-FIRST is true, then the list element is the first arg, otherwise
+;;; the second.
+;;;
+(defmacro any-type-op (op thing list &key (default '(values nil nil))
+			  list-first)
+  (let ((n-this (gensym))
+	(n-thing (gensym))
+	(n-val (gensym))
+	(n-win (gensym))
+	(n-uncertain (gensym)))
+    `(let ((,n-thing ,thing)
+	   (,n-uncertain nil))
+       (dolist (,n-this ,list
+			(if ,n-uncertain
+			    (return-from PUNT ,default)
+			    nil))
+	 (multiple-value-bind (,n-val ,n-win)
+			      ,(if list-first
+				   `(,op ,n-this ,n-thing)
+				   `(,op ,n-thing ,n-this))
+	   (unless ,n-win (setq ,n-uncertain t))
+	   (when ,n-val (return t)))))))
+;;;
+(defmacro every-type-op (op thing list &key (default '(values nil nil))
+			    list-first)
+  (let ((n-this (gensym))
+	(n-thing (gensym))
+	(n-val (gensym))
+	(n-win (gensym)))
+    `(let ((,n-thing ,thing))
+       (dolist (,n-this ,list t)
+	 (multiple-value-bind (,n-val ,n-win)
+			      ,(if list-first
+				   `(,op ,n-this ,n-thing)
+				   `(,op ,n-thing ,n-this))
+	   (unless ,n-win (return-from PUNT ,default))
+	   (unless ,n-val (return nil)))))))
+
+
+  
+;;; VANILLA-INTERSECTION  --  Interface
+;;;
+;;;    Compute the intersection for types that intersect only when one is a
+;;; hierarchical subtype of the other.
+;;;
+(defun vanilla-intersection (type1 type2)
+  (multiple-value-bind (stp1 win1)
+		       (csubtypep type1 type2)
+    (multiple-value-bind (stp2 win2)
+			 (csubtypep type2 type1)
+      (cond (stp1 (values type1 t))
+	    (stp2 (values type2 t))
+	    ((and win1 win2) (values *empty-type* t))
+	    (t
+	     (values type1 nil))))))
+
+
+;;; VANILLA-UNION  --  Interface
+;;;
+(defun vanilla-union (type1 type2)
+  (cond ((csubtypep type1 type2) type2)
+	((csubtypep type2 type1) type1)
+	(t nil)))
+
+
+;;; TYPE-CACHE-HASH  --  Interface
+;;;
+;;;    EQ hash two things (types) down to 8 bits.
+;;;
+(defmacro type-cache-hash (type1 type2)
+  `(the fixnum
+	(logand (the fixnum
+		     (logxor (the fixnum
+				  (ash (cache-hash-eq ,type1) -3))
+			     (the fixnum (cache-hash-eq ,type2))))
+		#xFF)))
+
+
+;;;; Cold loading initializations.
+
+(emit-cold-load-defuns "TYPEDEF")
+