diff --git a/core-lib/Mirrors.som b/core-lib/Mirrors.som index 3d6ca5eb5..4cc4b8d95 100644 --- a/core-lib/Mirrors.som +++ b/core-lib/Mirrors.som @@ -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 f9e0bed7d..4bf93339a 100644 --- a/src/som/primitives/ClassPrims.java +++ b/src/som/primitives/ClassPrims.java @@ -38,6 +38,7 @@ public final SAbstractObject doSClass(final Object receiver) { } @GenerateNodeFactory + @Primitive(primitive = "mirrorSuperclass:") public abstract static class SuperClassPrim extends UnaryExpressionNode { public SuperClassPrim(final boolean eagWrap, final SourceSection source) { super(eagWrap, source); }