Change Mirror API to explore SOMns object model and metaclass system

Signed-off-by: Stefan Marr <[email protected]>

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 = (

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
+  )
+)

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) {