From 4518a8e05c027895e2e2f341273326b520259636 Mon Sep 17 00:00:00 2001
From: NalaGinrut <NalaGinrut@gmail.com>
Date: Tue, 27 Dec 2011 14:19:39 +0800
Subject: [PATCH 2/2] ADD type-of to goops.scm

---
 module/oop/goops.scm |   13 ++++++++++++-
 1 files changed, 12 insertions(+), 1 deletions(-)

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index e4424f3..d9eb583 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -72,7 +72,7 @@
 	   method-specializers method-formals
 	   primitive-generic-generic enable-primitive-generic!
 	   method-procedure accessor-method-slot-definition
-	   slot-exists? make find-method get-keyword)
+	   slot-exists? make find-method get-keyword type-of)
   :no-backtrace)
 
 (define *goops-module* (current-module))
@@ -1654,6 +1654,17 @@
   (list2set (mapappend class-direct-methods
 		       (cons c (class-subclasses c)))))
 
+(define (type-of x)
+  (cond 
+   ((is-a? x <unknown>) '<undefined>)
+   ((null? x) '<object>)
+   ((is-a? x <boolean>) '<boolean>)
+   ((is-a? x <integer>) '<integer>)
+   ((is-a? x <string>) '<string>)
+   ((is-a? x <procedure>) '<function>)
+   ((is-a? x <object>) '<object>)
+   (else '<scm>)))
+
 ;;;
 ;;; {Final initialization}
 ;;;
-- 
1.7.0.4