diff --git a/src/Hermes-Extensions/HEDuplicationModeStrategy.class.st b/src/Hermes-Extensions/HEDuplicationModeStrategy.class.st index b2f97a1..06c347e 100644 --- a/src/Hermes-Extensions/HEDuplicationModeStrategy.class.st +++ b/src/Hermes-Extensions/HEDuplicationModeStrategy.class.st @@ -19,27 +19,27 @@ HEDuplicationModeStrategy class >> forOption: keyword [ { #category : #'validating existence' } HEDuplicationModeStrategy >> doExistingClass: aClass hermesClass: aHEClass installer: installer [ - self subclassResponsibility + self subclassResponsibility ] { #category : #'validating existence' } HEDuplicationModeStrategy >> doExistingTrait: aTrait hermesTrait: aHETrait installer: installer [ - self subclassResponsibility + self subclassResponsibility ] { #category : #'validating existence' } HEDuplicationModeStrategy >> doShouldBuildMethod: aHEMethod in: installer installer: aClass original: aMethod [ - self subclassResponsibility + self subclassResponsibility ] { #category : #'validating existence' } HEDuplicationModeStrategy >> existingClass: aHEClass on: installer [ ^ installer environment at: aHEClass className - ifPresent: [ :aClass | - self - doExistingClass: aClass - hermesClass: aHEClass + ifPresent: [ :aClass | + self + doExistingClass: aClass + hermesClass: aHEClass installer: installer ] ifAbsent: [ nil ] ] @@ -48,10 +48,10 @@ HEDuplicationModeStrategy >> existingClass: aHEClass on: installer [ HEDuplicationModeStrategy >> existingTrait: aHETrait on: installer [ ^ installer environment at: aHETrait traitName - ifPresent: [ :aTrait | - self - doExistingTrait: aTrait - hermesTrait: aHETrait + ifPresent: [ :aTrait | + self + doExistingTrait: aTrait + hermesTrait: aHETrait installer: installer ] ifAbsent: [ nil ] ] @@ -60,13 +60,13 @@ HEDuplicationModeStrategy >> existingTrait: aHETrait on: installer [ HEDuplicationModeStrategy >> shouldBuildMethod: aHEMethod in: aClass installer: installer [ ^ aClass compiledMethodAt: aHEMethod name - ifPresent: [ :m | + ifPresent: [ :m | (m isFromTrait and: [ aClass isTrait not ]) ifTrue: [ ^ true ]. - self - doShouldBuildMethod: aHEMethod - in: installer - installer: aClass + self + doShouldBuildMethod: aHEMethod + in: installer + installer: aClass original: m] ifAbsent: [ true ] ] diff --git a/src/Hermes-Extensions/HEExtendedInstaller.class.st b/src/Hermes-Extensions/HEExtendedInstaller.class.st index 84ad7d9..d86fece 100644 --- a/src/Hermes-Extensions/HEExtendedInstaller.class.st +++ b/src/Hermes-Extensions/HEExtendedInstaller.class.st @@ -26,12 +26,12 @@ HEExtendedInstaller >> duplicationMode: anObject [ { #category : #'validating existence' } HEExtendedInstaller >> existingClass: aHEClass [ - ^ duplicationMode existingClass: aHEClass on: self. + ^ duplicationMode existingClass: aHEClass on: self ] { #category : #'validating existence' } HEExtendedInstaller >> existingTrait: aHETrait [ - ^ duplicationMode existingTrait: aHETrait on: self. + ^ duplicationMode existingTrait: aHETrait on: self ] { #category : #accessing } @@ -43,14 +43,14 @@ HEExtendedInstaller >> failOnUndeclared: anObject [ HEExtendedInstaller >> forOptions: aCommandLine [ failOnUndeclared := (aCommandLine hasOption: 'no-fail-on-undeclared') not. - duplicationMode := HEDuplicationModeStrategy forOption: (aCommandLine optionAt: 'on-duplication' ifAbsent: [ 'fail' ]). + duplicationMode := HEDuplicationModeStrategy forOption: (aCommandLine optionAt: 'on-duplication' ifAbsent: [ 'fail' ]) ] { #category : #initialization } HEExtendedInstaller >> initialize [ super initialize. failOnUndeclared := true. - duplicationMode := HEFailOnDuplication new. + duplicationMode := HEFailOnDuplication new ] { #category : #'reporting undeclared' } @@ -65,5 +65,5 @@ HEExtendedInstaller >> reportNewUndeclareds: newUndeclareds [ { #category : #'validating existence' } HEExtendedInstaller >> shouldBuildMethod: aHEMethod in: aClass [ - ^ duplicationMode shouldBuildMethod: aHEMethod in: aClass installer: self. + ^ duplicationMode shouldBuildMethod: aHEMethod in: aClass installer: self ] diff --git a/src/Hermes/HEAdditionalMethodState.class.st b/src/Hermes/HEAdditionalMethodState.class.st index 28bbdc9..54562db 100644 --- a/src/Hermes/HEAdditionalMethodState.class.st +++ b/src/Hermes/HEAdditionalMethodState.class.st @@ -23,7 +23,7 @@ Class { { #category : 'accessing' } HEAdditionalMethodState class >> tag [ - ^ 1. + ^ 1 ] { #category : 'converting' } @@ -42,8 +42,7 @@ HEAdditionalMethodState >> asLiteralIn: env [ HEAdditionalMethodState >> doReadFrom: aReader [ method := HEExportedLiteral readFrom: aReader. selector := HEExportedLiteral readFrom: aReader. - value := HEExportedLiteral readFrom: aReader. - + value := HEExportedLiteral readFrom: aReader ] { #category : 'accessing' } diff --git a/src/Hermes/HEArray.class.st b/src/Hermes/HEArray.class.st index 1a24dab..7fa0abd 100644 --- a/src/Hermes/HEArray.class.st +++ b/src/Hermes/HEArray.class.st @@ -21,7 +21,7 @@ Class { { #category : 'accessing' } HEArray class >> tag [ - ^ 2. + ^ 2 ] { #category : 'converting' } @@ -32,12 +32,12 @@ HEArray >> asLiteralIn: env [ { #category : 'reading' } HEArray >> doReadFrom: aReader [ - | size | + | size | "The size of the array is stored as a 32bits integer. Before any of the elements" size := aReader readInt32. value := Array new:size. - - 1 to:size do:[:idx | value at:idx put: (HEExportedLiteral readFrom: aReader)]. + + 1 to:size do:[:idx | value at:idx put: (HEExportedLiteral readFrom: aReader)] ] { #category : 'accessing' } diff --git a/src/Hermes/HEAssociation.class.st b/src/Hermes/HEAssociation.class.st index 83c5a73..1cfa21d 100644 --- a/src/Hermes/HEAssociation.class.st +++ b/src/Hermes/HEAssociation.class.st @@ -28,12 +28,11 @@ HEAssociation >> asLiteralIn: env [ { #category : 'reading' } HEAssociation >> doReadFrom: aReader [ key := HEExportedLiteral readFrom: aReader. - value := HEExportedLiteral readFrom: aReader. - + value := HEExportedLiteral readFrom: aReader ] { #category : 'accessing' } HEAssociation >> value: anAssociation [ value := anAssociation value asExportedLiteral. - key := anAssociation key asExportedLiteral. + key := anAssociation key asExportedLiteral ] diff --git a/src/Hermes/HEBinaryReader.class.st b/src/Hermes/HEBinaryReader.class.st index 9417191..1b230c3 100644 --- a/src/Hermes/HEBinaryReader.class.st +++ b/src/Hermes/HEBinaryReader.class.st @@ -26,7 +26,7 @@ Class { { #category : 'initialization' } HEBinaryReader >> close [ - self stream close. + self stream close ] { #category : 'sizes' } @@ -42,7 +42,7 @@ HEBinaryReader >> readByte [ { #category : 'reading' } HEBinaryReader >> readByteArray [ | byteArray size | - size := self readInt32. + size := self readInt32. byteArray := stream next: size. ^ byteArray ] @@ -54,7 +54,7 @@ HEBinaryReader >> readByteString [ { #category : 'reading' } HEBinaryReader >> readByteSymbol [ - ^ self readByteString asSymbol + ^ self readByteString asSymbol ] { #category : 'reading' } diff --git a/src/Hermes/HEByteArray.class.st b/src/Hermes/HEByteArray.class.st index 7b683be..6d90a18 100644 --- a/src/Hermes/HEByteArray.class.st +++ b/src/Hermes/HEByteArray.class.st @@ -23,5 +23,5 @@ HEByteArray >> asLiteralIn: env [ { #category : 'reading' } HEByteArray >> doReadFrom: aReader [ - value := aReader readByteArray. + value := aReader readByteArray ] diff --git a/src/Hermes/HEByteString.class.st b/src/Hermes/HEByteString.class.st index df507fb..b8b9cbb 100644 --- a/src/Hermes/HEByteString.class.st +++ b/src/Hermes/HEByteString.class.st @@ -13,7 +13,7 @@ Class { { #category : 'accessing' } HEByteString class >> tag [ - ^ 4. + ^ 4 ] { #category : 'converting' } @@ -24,10 +24,10 @@ HEByteString >> asLiteralIn: env [ { #category : 'reading' } HEByteString >> doConvertValue: aValue [ "My subclasses are able to do something else to convert the readed value" - ^ aValue. + ^ aValue ] { #category : 'reading' } HEByteString >> doReadFrom: aReader [ - value := self doConvertValue:(aReader readByteString). + value := self doConvertValue:(aReader readByteString) ] diff --git a/src/Hermes/HECharacter.class.st b/src/Hermes/HECharacter.class.st index 086fb7a..0db7065 100644 --- a/src/Hermes/HECharacter.class.st +++ b/src/Hermes/HECharacter.class.st @@ -14,7 +14,7 @@ Class { { #category : 'accessing' } HECharacter class >> tag [ - ^ 5. + ^ 5 ] { #category : 'converting' } @@ -24,5 +24,5 @@ HECharacter >> asLiteralIn: env [ { #category : 'accessing' } HECharacter >> value: aValue [ - value := aValue asString. + value := aValue asString ] diff --git a/src/Hermes/HEClass.class.st b/src/Hermes/HEClass.class.st index 17279dd..53a1f14 100644 --- a/src/Hermes/HEClass.class.st +++ b/src/Hermes/HEClass.class.st @@ -99,7 +99,7 @@ HEClass >> layoutClass: anObject [ { #category : 'accessing' } HEClass >> name [ - + ^ self className ] diff --git a/src/Hermes/HEClassTrait.class.st b/src/Hermes/HEClassTrait.class.st index 3079596..fcd2852 100644 --- a/src/Hermes/HEClassTrait.class.st +++ b/src/Hermes/HEClassTrait.class.st @@ -25,5 +25,5 @@ HEClassTrait >> asLiteralIn: env [ { #category : 'accessing' } HEClassTrait >> value: aClassTrait [ - value := aClassTrait instanceSide name. + value := aClassTrait instanceSide name ] diff --git a/src/Hermes/HEClassVariable.class.st b/src/Hermes/HEClassVariable.class.st index 019d6b0..a306b73 100644 --- a/src/Hermes/HEClassVariable.class.st +++ b/src/Hermes/HEClassVariable.class.st @@ -15,16 +15,16 @@ Class { { #category : 'accessing' } HEClassVariable class >> tag [ - ^ 6. + ^ 6 ] { #category : 'converting' } HEClassVariable >> asLiteralIn: env [ "I ask the binding to the class that is currently being deserialized" - ^ env newClass bindingOf: value + ^ env newClass bindingOf: value ] { #category : 'accessing' } HEClassVariable >> value: aClassVariable [ - value := aClassVariable name. + value := aClassVariable name ] diff --git a/src/Hermes/HECompiledBlock.class.st b/src/Hermes/HECompiledBlock.class.st index beffb16..a0ab55d 100644 --- a/src/Hermes/HECompiledBlock.class.st +++ b/src/Hermes/HECompiledBlock.class.st @@ -24,12 +24,12 @@ HECompiledBlock class >> tag [ HECompiledBlock >> asLiteralIn: anEnvironment [ | containingBlockOrMethod newBlock literalSpace previousBlock| - + previousBlock := anEnvironment newBlock. containingBlockOrMethod := previousBlock ifNil: [ anEnvironment newMethod ]. - + newBlock := CompiledBlock newMethod: bytecode size header: (self headerFor: anEnvironment). - + anEnvironment newBlock: newBlock. literals @@ -68,7 +68,7 @@ HECompiledBlock >> headerFor: anEnvironment [ | encoderClass| "When a method is deserialized its header should be recalculated" encoderClass := anEnvironment classNamed: encoderClassName. - + ^ (CompiledMethod headerFlagForEncoder: encoderClass) + (numArgs bitShift: 24) + (numTemps bitShift: 18) + literals size + (hasPrimitive bitShift: 16) ] diff --git a/src/Hermes/HEConstantBlock.class.st b/src/Hermes/HEConstantBlock.class.st index 4c8a985..8ba77a0 100644 --- a/src/Hermes/HEConstantBlock.class.st +++ b/src/Hermes/HEConstantBlock.class.st @@ -32,7 +32,7 @@ HEConstantBlock >> doReadFrom: aReader [ numArgs := aReader readUInt32. literal := HEExportedLiteral readFrom: aReader. - compiledBlock := HEExportedLiteral readFrom: aReader. + compiledBlock := HEExportedLiteral readFrom: aReader ] { #category : 'comparing' } diff --git a/src/Hermes/HEExportedLiteral.class.st b/src/Hermes/HEExportedLiteral.class.st index 4a47e05..70c228e 100644 --- a/src/Hermes/HEExportedLiteral.class.st +++ b/src/Hermes/HEExportedLiteral.class.st @@ -60,7 +60,7 @@ HEExportedLiteral >> asLiteralIn: anEnvironment [ { #category : 'reading' } HEExportedLiteral >> doReadFrom: aReader [ "Main template method to read the instance from the reader stream" - self subclassResponsibility. + self subclassResponsibility ] { #category : 'accessing' } diff --git a/src/Hermes/HEExportedMetaclass.class.st b/src/Hermes/HEExportedMetaclass.class.st index 0978357..1d3306e 100644 --- a/src/Hermes/HEExportedMetaclass.class.st +++ b/src/Hermes/HEExportedMetaclass.class.st @@ -25,5 +25,5 @@ HEExportedMetaclass >> asLiteralIn: env [ { #category : 'accessing' } HEExportedMetaclass >> value: aMetaclass [ - value := aMetaclass instanceSide name. + value := aMetaclass instanceSide name ] diff --git a/src/Hermes/HEFloat.class.st b/src/Hermes/HEFloat.class.st index 7aee954..a41258b 100644 --- a/src/Hermes/HEFloat.class.st +++ b/src/Hermes/HEFloat.class.st @@ -16,12 +16,12 @@ Class { { #category : 'accessing' } HEFloat class >> tag [ - ^ 3. + ^ 3 ] { #category : 'converting' } HEFloat >> asLiteralIn: env [ - ^ value. + ^ value ] { #category : 'reading' } @@ -30,7 +30,7 @@ HEFloat >> doReadFrom: aReader [ originalValue := BoxedFloat64 new. originalValue at:1 put: (aReader readUInt32). originalValue at:2 put: (aReader readUInt32). - + "Force the conversion to SmallFloat64 or BoxedFloat64" - value := originalValue - 0.0. + value := originalValue - 0.0 ] diff --git a/src/Hermes/HEGlobalVariable.class.st b/src/Hermes/HEGlobalVariable.class.st index 9861b2a..9330313 100644 --- a/src/Hermes/HEGlobalVariable.class.st +++ b/src/Hermes/HEGlobalVariable.class.st @@ -16,20 +16,20 @@ Class { { #category : 'accessing' } HEGlobalVariable class >> tag [ - ^ 7. + ^ 7 ] { #category : 'converting' } HEGlobalVariable >> asLiteralIn: env [ | bind | bind := env newClass bindingOf: value. - + bind ifNotNil: [ ^ bind ]. - + ^UndeclaredVariable registeredWithName: value ] { #category : 'accessing' } HEGlobalVariable >> value: aClassVariable [ - value := aClassVariable name. + value := aClassVariable name ] diff --git a/src/Hermes/HEMethod.class.st b/src/Hermes/HEMethod.class.st index e1ae2de..c028462 100644 --- a/src/Hermes/HEMethod.class.st +++ b/src/Hermes/HEMethod.class.st @@ -62,7 +62,7 @@ HEMethod >> headerFor: anEnvironment [ | encoderClass| "When a method is deserialized its header should be recalculated" encoderClass := anEnvironment classNamed: encoderClassName. - + ^ (CompiledMethod headerFlagForEncoder: encoderClass) + (numArgs bitShift: 24) + (numTemps bitShift: 18) + literals size + (hasPrimitive bitShift: 16) ] @@ -111,7 +111,7 @@ HEMethod >> readFrom: aReader [ name := aReader readByteSymbol. className := aReader readByteSymbol. protocol := aReader readByteSymbol. - + encoderClassName := aReader readByteString. numArgs := aReader readUInt32. numTemps := aReader readUInt32. diff --git a/src/Hermes/HEMethodLiteral.class.st b/src/Hermes/HEMethodLiteral.class.st index a1c2ae3..fc3de2f 100644 --- a/src/Hermes/HEMethodLiteral.class.st +++ b/src/Hermes/HEMethodLiteral.class.st @@ -17,7 +17,7 @@ Class { { #category : 'accessing' } HEMethodLiteral class >> tag [ - ^ 10. + ^ 10 ] { #category : 'converting' } @@ -40,13 +40,11 @@ HEMethodLiteral >> className: anObject [ { #category : 'reading' } HEMethodLiteral >> doReadFrom: aReader [ className := aReader readByteSymbol. - selector := aReader readByteSymbol. - - + selector := aReader readByteSymbol ] { #category : 'accessing' } HEMethodLiteral >> value: aMethod [ className := aMethod methodClass name. - selector := aMethod selector. + selector := aMethod selector ] diff --git a/src/Hermes/HEPackage.class.st b/src/Hermes/HEPackage.class.st index 259d0ea..c40f3c4 100644 --- a/src/Hermes/HEPackage.class.st +++ b/src/Hermes/HEPackage.class.st @@ -38,7 +38,7 @@ HEPackage class >> formatVersion [ { #category : 'adding' } HEPackage >> addClass: anExportedClass [ - classes add: anExportedClass. + classes add: anExportedClass ] { #category : 'accessing' } @@ -67,7 +67,7 @@ HEPackage >> initialize [ classes := OrderedCollection new. traits := OrderedCollection new. - extensionMethods := OrderedCollection new. + extensionMethods := OrderedCollection new ] { #category : 'accessing' } @@ -90,17 +90,16 @@ HEPackage >> printOn: aStream [ { #category : 'reading' } HEPackage >> readClassFrom: aReader [ - classes add: (HEClass readFrom: aReader). - + classes add: (HEClass readFrom: aReader) ] { #category : 'reading' } HEPackage >> readFrom: aReader [ | numberOfTraits numberOfClasses numberOfExtensionMethods | version := aReader readInt32. - + version = self class formatVersion ifFalse:[self error:'Invalid Hermes file version, expecting: ' , self class formatVersion asString , ' but was: ' , version asString]. - + packageName := aReader readByteSymbol. numberOfTraits := aReader readInt32. @@ -110,7 +109,7 @@ HEPackage >> readFrom: aReader [ 1 to: numberOfClasses do: [ :idx | classes add: (HEClass readFrom: aReader)]. numberOfExtensionMethods := aReader readInt32. - 1 to: numberOfExtensionMethods do: [ :idx | extensionMethods add: (HEMethod readFrom: aReader) ] + 1 to: numberOfExtensionMethods do: [ :idx | extensionMethods add: (HEMethod readFrom: aReader) ] ] { #category : 'accessing' } diff --git a/src/Hermes/HEPragma.class.st b/src/Hermes/HEPragma.class.st index 44670a4..5579657 100644 --- a/src/Hermes/HEPragma.class.st +++ b/src/Hermes/HEPragma.class.st @@ -22,7 +22,7 @@ Class { { #category : 'accessing' } HEPragma class >> tag [ - ^ 11. + ^ 11 ] { #category : 'accessing' } @@ -39,7 +39,7 @@ HEPragma >> asLiteralIn: env [ HEPragma >> doReadFrom: aReader [ method := HEExportedLiteral readFrom: aReader. keyword := HEExportedLiteral readFrom: aReader. - arguments := HEExportedLiteral readFrom: aReader. + arguments := HEExportedLiteral readFrom: aReader ] { #category : 'accessing' } @@ -56,5 +56,5 @@ HEPragma >> method [ HEPragma >> value: aPragma [ method := aPragma method asExportedLiteral. keyword := aPragma selector asExportedLiteral. - arguments := aPragma arguments asExportedLiteral + arguments := aPragma arguments asExportedLiteral ] diff --git a/src/Hermes/HESymbol.class.st b/src/Hermes/HESymbol.class.st index 4a3069c..d63482d 100644 --- a/src/Hermes/HESymbol.class.st +++ b/src/Hermes/HESymbol.class.st @@ -13,10 +13,10 @@ Class { { #category : 'accessing' } HESymbol class >> tag [ - ^ 9. + ^ 9 ] { #category : 'reading' } HESymbol >> doConvertValue: aValue [ - ^ aValue asSymbol. + ^ aValue asSymbol ] diff --git a/src/Hermes/HETrait.class.st b/src/Hermes/HETrait.class.st index 8f3d5e4..5cbd957 100644 --- a/src/Hermes/HETrait.class.st +++ b/src/Hermes/HETrait.class.st @@ -16,7 +16,7 @@ Class { { #category : 'reading' } HETrait >> doReadHeaderFrom: aReader [ - traitName := aReader readByteSymbol. + traitName := aReader readByteSymbol ] { #category : 'accessing' } diff --git a/src/Hermes/HETraitLiteral.class.st b/src/Hermes/HETraitLiteral.class.st index 4459aaf..7b27a10 100644 --- a/src/Hermes/HETraitLiteral.class.st +++ b/src/Hermes/HETraitLiteral.class.st @@ -25,5 +25,5 @@ HETraitLiteral >> asLiteralIn: env [ { #category : 'accessing' } HETraitLiteral >> value: aTrait [ - value := aTrait name. + value := aTrait name ] diff --git a/src/Hermes/HEWideString.class.st b/src/Hermes/HEWideString.class.st index e2a5aaf..b529db0 100644 --- a/src/Hermes/HEWideString.class.st +++ b/src/Hermes/HEWideString.class.st @@ -18,5 +18,5 @@ HEWideString class >> tag [ { #category : 'reading' } HEWideString >> doReadFrom: aReader [ - value := aReader readByteArray utf8Decoded. + value := aReader readByteArray utf8Decoded ] diff --git a/src/Hermes/HermesCommandLineHandler.class.st b/src/Hermes/HermesCommandLineHandler.class.st index e4e55eb..e12d5eb 100644 --- a/src/Hermes/HermesCommandLineHandler.class.st +++ b/src/Hermes/HermesCommandLineHandler.class.st @@ -58,9 +58,9 @@ HermesCommandLineHandler class >> description [ HermesCommandLineHandler >> activate [ self activateHelp ifTrue: [ ^ self ]. self validateParameters. - + self processFiles. - + (self hasOption: 'save') ifTrue: [ Smalltalk snapshot: true andQuit: false ]. @@ -69,13 +69,13 @@ HermesCommandLineHandler >> activate [ { #category : 'processing files' } HermesCommandLineHandler >> createInstaller [ - "In the basic installation, the bootstraped version of Hermes, - there is only one Installer, the HEInstaller. + "In the basic installation, the bootstraped version of Hermes, + there is only one Installer, the HEInstaller. When the extensions are installed the new installer to use is the HEExtendedInstaller." ^ Smalltalk globals at: #HEExtendedInstaller - ifPresent: [ :instClass | + ifPresent: [ :instClass | instClass new forOptions: self commandLine; yourself ]