From eb9fe831cd15ec86e7035bdb5aff26e9dffb48f8 Mon Sep 17 00:00:00 2001
From: Stefan Marr <git@stefan-marr.de>
Date: Sun, 5 Feb 2017 17:29:07 +0100
Subject: [PATCH] Change Mirror API to explore SOMns object model and metaclass
 system

Signed-off-by: Stefan Marr <git@stefan-marr.de>
---
 core-lib/Mirrors.ns                |  5 ++-
 core-lib/ObjectModel.som           | 60 ++++++++++++++++++++++++++++++
 src/som/primitives/ClassPrims.java |  1 +
 3 files changed, 64 insertions(+), 2 deletions(-)
 create mode 100644 core-lib/ObjectModel.som

diff --git a/core-lib/Mirrors.ns b/core-lib/Mirrors.ns
index 96be7fad4..f19965974 100644
--- a/core-lib/Mirrors.ns
+++ b/core-lib/Mirrors.ns
@@ -28,10 +28,11 @@ class Mirrors usingVmMirror: vmMirror = Value (
     (*:TODO: Not happy with the naming of the mirror methods yet,
              they are not unambiguous, about whether they apply to the object,
              or to the object class *)
-    public name       = ( ^ vmMirror mirrorAClassesName: obj  )
+    public name       = ( ^ vmMirror mirrorClassName: obj  )
     public classObject= ( ^ vmMirror objClass: obj         )
     public classMirror= ( ^ ClassMirror reflecting: classObject )
-    public superclass = ( ^ vmMirror mirrorSuperclass: obj )
+    public superclass = ( ^ vmMirror mirrorSuperclass: classObject )
+    public superclassName = ( ^ vmMirror mirrorAClassesName: (vmMirror mirrorSuperclass: classObject) )
     public slots      = ( ^ vmMirror mirrorSlots: obj      )
 
     public classDefinition = (
diff --git a/core-lib/ObjectModel.som b/core-lib/ObjectModel.som
new file mode 100644
index 000000000..12f876951
--- /dev/null
+++ b/core-lib/ObjectModel.som
@@ -0,0 +1,60 @@
+class ObjectModel usingPlatform: platform = Value (
+| private ObjectMirror = platform mirrors ObjectMirror.
+  private ClassMirror  = platform mirrors ClassMirror.
+  private Thing        = platform kernel Thing. |
+)(
+  public class Snake = ()()
+
+  private printInstanceAndSuperclassOf: classMirror = (
+    classMirror name print. ' is instance of ' print.
+    classMirror classMirror name println.
+    classMirror name print. ' is subclass of ' print.
+    classMirror superclassName println.
+  )
+
+  public main: args = (
+    | snake snakeMirror obj objMirror thing thingMirror |
+    snake := Snake new.
+    snakeMirror := (ObjectMirror reflecting: snake).
+    'snake is instance of ' print.
+    snakeMirror className println.
+
+    printInstanceAndSuperclassOf: snakeMirror classMirror.
+    printInstanceAndSuperclassOf: snakeMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: snakeMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: snakeMirror classMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: snakeMirror classMirror classMirror classMirror classMirror classMirror.
+
+    '' println. '' println.
+    'Superclass hierarchy:' println.
+    '' println.
+
+    obj := Object new.
+    objMirror := (ObjectMirror reflecting: obj).
+    'obj is instance of ' print.
+    objMirror className println.
+
+    printInstanceAndSuperclassOf: objMirror classMirror.
+    printInstanceAndSuperclassOf: objMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: objMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: objMirror classMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: objMirror classMirror classMirror classMirror classMirror classMirror.
+
+    '' println. '' println.
+    'In SOMns there is still Thing:' println.
+    '' println.
+
+    thing := Thing new.
+    thingMirror := (ObjectMirror reflecting: thing).
+    'thing is instance of ' print.
+    thingMirror className println.
+
+    printInstanceAndSuperclassOf: thingMirror classMirror.
+    printInstanceAndSuperclassOf: thingMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: thingMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: thingMirror classMirror classMirror classMirror classMirror.
+    printInstanceAndSuperclassOf: thingMirror classMirror classMirror classMirror classMirror classMirror.
+
+    ^ 0
+  )
+)
diff --git a/src/som/primitives/ClassPrims.java b/src/som/primitives/ClassPrims.java
index 2ba30803b..c01c0214c 100644
--- a/src/som/primitives/ClassPrims.java
+++ b/src/som/primitives/ClassPrims.java
@@ -34,6 +34,7 @@ public final SAbstractObject doSClass(final Object receiver) {
   }
 
   @GenerateNodeFactory
+  @Primitive(primitive = "mirrorSuperclass:")
   public abstract static class SuperClassPrim extends UnaryExpressionNode {
     @Specialization
     public final SAbstractObject doSClass(final SClass receiver) {