From a2e184a079e37f51c606c072cd1f3cf4856ac743 Mon Sep 17 00:00:00 2001 From: Dardo Marasca Date: Mon, 23 Mar 2020 20:57:07 -0300 Subject: [PATCH] Add MO In Object handlers --- .../Immutability/HandlesEnvInObj/Handle.som | 47 +++++++++++++++++++ .../HandlesEnvInObj/HandleForArray.som | 6 +++ .../HandlesEnvInObj/HandleForClass.som | 6 +++ .../HandleSupportingPrimitives.som | 14 ++++++ .../ImmutableMessageForArrayHandlesMO.som | 26 ++++++++++ .../ImmutableMessageForClassHandlesMO.som | 29 ++++++++++++ .../ImmutableMessageForHandlesMO.som | 17 +++++++ .../ImmutableMessageForPrimitivesMO.som | 8 ++++ .../ImmutableSemanticsForHandlesMO.som | 4 ++ Smalltalk/Object.som | 2 +- 10 files changed, 158 insertions(+), 1 deletion(-) create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/Handle.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForArray.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForClass.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleSupportingPrimitives.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForArrayHandlesMO.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForClassHandlesMO.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForHandlesMO.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForPrimitivesMO.som create mode 100644 Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableSemanticsForHandlesMO.som diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/Handle.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/Handle.som new file mode 100644 index 00000000..b3388e51 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/Handle.som @@ -0,0 +1,47 @@ +Handle = ( + | target | + "Accessing" + targetSPECIAL: anObject = ( target := anObject ) + targetSPECIAL = ( ^target ) + = other = (^self equalsSPECIAL: other) + equalsSPECIAL: other = (^target = other) + == other = (^self equalsequalsSPECIAL: other) + equalsequalsSPECIAL: other = ( + | compareTo | + compareTo := (other class = self class) + ifTrue: [other targetSPECIAL] + ifFalse: [other]. + ^target == compareTo + ) + + ---------------------------- + + | semantics | + + "Accessing" + semantics = ( ^semantics ) + semantics: anObject = ( semantics := anObject ) + + initialize = ( + HandleForArray initialize. + HandleForClass initialize. + ImmutableMessageForHandlesMO initialize. + ImmutableMessageForArrayHandlesMO initialize. + ImmutableMessageForClassHandlesMO initialize. + + self semantics: + (EnvironmentMO + operationalSemantics: ImmutableSemanticsForHandlesMO new + message: ImmutableMessageForHandlesMO new + layout: nil + ). + ) + + targetSPECIAL: anObject = ( + | object | + (anObject class = self) ifTrue: [^anObject]. + object := self basicNew: self semantics. + object targetSPECIAL: anObject. + ^object + ) + ) \ No newline at end of file diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForArray.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForArray.som new file mode 100644 index 00000000..001c025a --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForArray.som @@ -0,0 +1,6 @@ +HandleForArray = HandleSupportingPrimitives ( + + ---------------------------- + + messageMO = ( ^ImmutableMessageForArrayHandlesMO new) + ) \ No newline at end of file diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForClass.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForClass.som new file mode 100644 index 00000000..ba08cb4f --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleForClass.som @@ -0,0 +1,6 @@ +HandleForClass = HandleSupportingPrimitives ( + + ---------------------------- + + messageMO = ( ^ImmutableMessageForClassHandlesMO new) + ) \ No newline at end of file diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleSupportingPrimitives.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleSupportingPrimitives.som new file mode 100644 index 00000000..485053fe --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/HandleSupportingPrimitives.som @@ -0,0 +1,14 @@ +HandleSupportingPrimitives = Handle ( + + -------------- + + initialize = ( + | shape | + self semantics: + (EnvironmentMO + operationalSemantics: ImmutableSemanticsForHandlesMO new + message: self messageMO + layout: nil + ). + ) + ) \ No newline at end of file diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForArrayHandlesMO.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForArrayHandlesMO.som new file mode 100644 index 00000000..f02c4e63 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForArrayHandlesMO.som @@ -0,0 +1,26 @@ +ImmutableMessageForArrayHandlesMO = ImmutableMessageForPrimitivesMO ( + find: aSymbol since: aClass = ( + (ImmutableMessageForArrayHandlesMO writablePrimitives contains: aSymbol) + ifTrue: ['ERROR: Unexpected write to a readonly object!' println. self halt. ^nil] + ^(ImmutableMessageForArrayHandlesMO returningPrimitives containsKey: aSymbol) + ifTrue: [super find: (ImmutableMessageForArrayHandlesMO returningPrimitives at: aSymbol) since: aClass] + ifFalse: [super find: aSymbol since: aClass] + ) + + activate: aSignature withArguments: arguments = ( + (ImmutableMessageForArrayHandlesMO primitives contains: aSignature) ifTrue:[ + arguments at:3 put: (arguments at: 3) targetSPECIAL. + ] + ^arguments + ) + ---------------------------- + initialize = ( + Primitives := #(#length). + WritablePrimitives := #(#at:put:). + + "We must wrap returning primitives so that the returned value is wrapped with a readonly reference" + ReturningPrimitives := Dictionary new. + ReturningPrimitives at: #at: put: #atHandlesSPECIAL: + ) + +) diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForClassHandlesMO.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForClassHandlesMO.som new file mode 100644 index 00000000..508ee426 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForClassHandlesMO.som @@ -0,0 +1,29 @@ +ImmutableMessageForClassHandlesMO = ImmutableMessageForPrimitivesMO ( + find: aSymbol since: aClass = ( + (ImmutableMessageForClassHandlesMO writablePrimitives contains: aSymbol) + ifTrue: ['ERROR: Unexpected write to a readonly object!' println. self halt. ^nil] + ^(ImmutableMessageForClassHandlesMO returningPrimitives containsKey: aSymbol) + ifTrue: [super find: (ImmutableMessageForClassHandlesMO returningPrimitives at: aSymbol) since: aClass] + ifFalse: [super find: aSymbol since: aClass] + ) + + activate: aSignature withArguments: arguments = ( + (ImmutableMessageForClassHandlesMO primitives contains: aSignature) ifTrue:[ + arguments at:3 put: (arguments at: 3) targetSPECIAL. + ] + ^arguments + ) + ---------------------------- + + initialize = ( + Primitives := #(). + WritablePrimitives := #(#basicNew). + + "We must wrap returning primitives so that the returned value is wrapped with a readonly reference" + ReturningPrimitives := Dictionary new. + ReturningPrimitives at: #superclass put: #superclassSPECIAL. + ReturningPrimitives at: #fields put: #fieldsSPECIAL. + ReturningPrimitives at: #methods put: #methodsSPECIAL. + ReturningPrimitives at: #name put: #nameSPECIAL. + ) +) diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForHandlesMO.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForHandlesMO.som new file mode 100644 index 00000000..be186456 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForHandlesMO.som @@ -0,0 +1,17 @@ +ImmutableMessageForHandlesMO = MessageLookupMO ( + find: aSymbol since: aClass = ( + | lookupStart | + lookupStart := (ImmutableMessageForHandlesMO reimplementedPrimitives contains: aSymbol) + ifTrue: [self class] + ifFalse: [self targetSPECIAL class]. + ^super find: aSymbol since: lookupStart + ) + + ---------------------------- + | ReimplementedPrimitives | + + initialize = ( + ReimplementedPrimitives := #(#= #== #equalsequalsSPECIAL: #equalsSPECIAL:) + ) + reimplementedPrimitives = (^ReimplementedPrimitives) +) diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForPrimitivesMO.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForPrimitivesMO.som new file mode 100644 index 00000000..c9e87712 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableMessageForPrimitivesMO.som @@ -0,0 +1,8 @@ +ImmutableMessageForPrimitivesMO = ImmutableMessageForHandlesMO ( + ---------------------------- + | WritablePrimitives ReturningPrimitives Primitives | + + writablePrimitives = (^WritablePrimitives) + returningPrimitives = (^ReturningPrimitives) + primitives = (^Primitives) +) diff --git a/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableSemanticsForHandlesMO.som b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableSemanticsForHandlesMO.som new file mode 100644 index 00000000..656d1456 --- /dev/null +++ b/Examples/Benchmarks/Mate/Immutability/HandlesEnvInObj/ImmutableSemanticsForHandlesMO.som @@ -0,0 +1,4 @@ +ImmutableSemanticsForHandlesMO = OperationalSemanticsMO ( + read: anIndex = (^(self targetSPECIAL instVarAt: anIndex) readOnly) + write: anIndex value: aValue = (^aValue) +) diff --git a/Smalltalk/Object.som b/Smalltalk/Object.som index f8340b66..1eb6bb90 100644 --- a/Smalltalk/Object.som +++ b/Smalltalk/Object.som @@ -84,7 +84,7 @@ Object = nil ( "Debugging" inspect = primitive halt = primitive - hasMetaObjectEnvironment = primitive + hasEnvironment = primitive inMeta = primitive "Error handling"