[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv9640

Modified Files:
	typep.lisp 
Log Message:
Added a rather stupid coerce function.

Date: Wed Jun  9 13:13:16 2004
Author: ffjeld

Index: movitz/losp/muerte/typep.lisp
diff -u movitz/losp/muerte/typep.lisp:1.14 movitz/losp/muerte/typep.lisp:1.15
--- movitz/losp/muerte/typep.lisp:1.14	Wed Jun  9 10:21:47 2004
+++ movitz/losp/muerte/typep.lisp	Wed Jun  9 13:13:16 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  8 11:07:53 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: typep.lisp,v 1.14 2004/06/09 17:21:47 ffjeld Exp $
+;;;; $Id: typep.lisp,v 1.15 2004/06/09 20:13:16 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -564,28 +564,11 @@
 
 (defun type-of (x)
   (class-name (class-of x)))
-;;;  (typecase x
-;;;    (null 'null)
-;;;    (cons 'cons)
-;;;    (symbol 'symbol)
-;;;    (integer 'integer)
-;;;    (structure-object
-;;;     (structure-object-name x))
-;;;    (t t)))
 
+(defun coerce (object result-type)
+  "=> result"
+  (cond
+   ((typep object result-type)
+    object)
+   (t (error "Don't know how to coerce ~S to ~S." object result-type))))
 
-
-;;;(defun subtypep (type-1 type-2)
-;;;  (cond
-;;;   ((eq type-1 type-2)
-;;;    t)
-;;;   ((or (atom type-1) (atom type-2))
-;;;    nil)
-;;;   ((equal type-1 type-2)
-;;;    t)
-;;;   (t (case (car type-2)
-;;;	(integer
-;;;	 (let ((low2 (second type-2))
-;;;	       (hi2 (third type-2)))
-;;;	   (case (car type-1)
-