-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathValues.Pharo90.st
1647 lines (1195 loc) · 41.3 KB
/
Values.Pharo90.st
1
'From VisualWorks®, 9.2 of 7. Januar 2022 on 21. Juni 2022 at 08:39:42'!"This file contains the transformed source for Pharo 9.0 of: Package [Values](3.0.2.0,chaider)Created by Bundle {Smalltalk Transform Project}(2.0.2.0,chaider)Rules from Package [Pharo Fileout PDFtalk](1.3.1.1,chaider)"!"VisualWorks bridge classes"!DateAndTime subclass: #Timestamp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!Timestamp comment:'VisualWorks class'!Color subclass: #ColorValue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!ColorValue comment:'VisualWorks class'!"Definitions"!Object subclass: #AboutValues instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!AboutValues comment:'Values are simple immutable literal objects.Runtime support for Values.Defines the root class Value and provides- printing instances- equality- an example.Specifies the responsibilities of subclasses to define the #localSpecification'!Object subclass: #Emitter instanceVariableNames: 'printer stream level' classVariableNames: '' poolDictionaries: '' package: 'Values'!Emitter comment:'Emitter outputs a Printvalue as formatted source code to a stream.Subclasses write source or text.This implements the second pass of the source generation for Values.Instance Variables printer <ValuePrinter> the printer to resolve namespace names level <Integer> the indention level stream <WriteStream | TextStream> the output stream'!Emitter subclass: #SourceEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!SourceEmitter comment:'SourceEmitter outputs source code.'!Emitter subclass: #TextEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!TextEmitter comment:'TextEmitter outputs a descriptive text.'!TextEmitter subclass: #TextBlockEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!TextBlockEmitter comment:'TextBlockEmitter emits text as indented block'!Object subclass: #Value instanceVariableNames: '' classVariableNames: 'NamedValuesRegistry' poolDictionaries: '' package: 'Values'!Value comment:'Value is the abstract root object of values (literal objects).All Value classes which have subclasses are considered abstract. Only leaf classes can have instances!!Literal objects are created immutable with constructors.The instance variables are object constants.Subclasses must implement the following messages: class specification localSpecification'!Value subclass: #Printvalue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!Printvalue comment:'A Printvalue holds a representation of a Value to be printed.It consists of - classname <String> properly resolved against a target class (#name or #fullName) - arguments <SequenceableCollection of: Printargument> the list of arguments with constructor variable name and a PrintvaluePrintvalues are created when printing the source for a Value in the first pass. The second pass takes the Printvalue and produces a nicely indented soure string for the value.'!Printvalue subclass: #LiteralPrintvalue instanceVariableNames: 'string' classVariableNames: '' poolDictionaries: '' package: 'Values'!LiteralPrintvalue comment:'LiteralPrintvalue is a Printvalue for literals.Instance Variables: string <String> the representation as a string'!Dictionary variableSubclass: #Valuemap instanceVariableNames: 'order' classVariableNames: '' poolDictionaries: '' package: 'Values'!Valuemap comment:'A Valuemap is an ordered dictionary preserving the order in which entries are added.Instances are also used as ordered volatile dictionary, not just as value.In VisualWorks, Valuemap is subclassed from Dictionary to inherit the dictionary API.Instance Variables: order <SequenceableCollection of: Object> the ordered keysThe class used to be named OrderedDictionary, but was renamed for dialect compatibility with Pharo, which has a class named OrderedDictionary with different semantics.'!SourceEmitter subclass: #BlockEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!BlockEmitter comment:'Emits source as indented block'!Object subclass: #ValuePrinter instanceVariableNames: 'target' classVariableNames: '' poolDictionaries: '' package: 'Values'!ValuePrinter comment:'ValuePrinter creates the source for a Value.For each level, a new ValuePrinter is created.The target class is the compilation target of the created source, as if the source is compiled as method of that class.The scoping from the target defines how class names are printed (with or without namespaces).'!SourceEmitter subclass: #LineEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!LineEmitter comment:'Emits source as one line'!Printvalue subclass: #DictionaryPrintvalue instanceVariableNames: 'arguments isOrdered' classVariableNames: '' poolDictionaries: '' package: 'Values'!DictionaryPrintvalue comment:'DictionaryPrintvalue is used for printing DictionariesInstance Variables: arguments <SequenceableCollection of DictionaryPrintargument> the Printarguments for each entry'!TextEmitter subclass: #TextLineEmitter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!TextLineEmitter comment:'TextLineEmitter emits text as one line'!Value subclass: #Printargument instanceVariableNames: 'name value' classVariableNames: '' poolDictionaries: '' package: 'Values'!Printargument comment:'A Printargument holds the data to print one instance variable (constant) and its value. - name <String> the name of the argument - value <Printvalue> the print value of the valueWith Printvalue it represents the source for a Value'!Printvalue subclass: #ValuePrintvalue instanceVariableNames: 'classname arguments' classVariableNames: '' poolDictionaries: '' package: 'Values'!ValuePrintvalue comment:'ValuePrintvalue holds the data to print a Value.Instance Variables: arguments <SequenceableCollection of: (Printargument | EmptyArgument)> the arguments classname <String> the namespace aware name of the class'!Printargument subclass: #DictionaryPrintargument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' package: 'Values'!DictionaryPrintargument comment:'DictionaryPrintargument holds the Printvalues for key and value of an entry in a dictionary.Both key and value can be Values'!Printvalue subclass: #ArrayPrintvalue instanceVariableNames: 'arguments' classVariableNames: '' poolDictionaries: '' package: 'Values'!ArrayPrintvalue comment:'ArrayPrintvalue is a special Printvalue for sequentiable collections of Values'!"Methods"!!AboutValues class methodsFor: 'properties' stamp: 'chaider 21/6/22 04:25'!creationRules ^'Package [Pharo Fileout PDFtalk](1.3.1.1,chaider)'!creationTime ^'21.06.2022 08:39:42'!creator ^'Bundle {Smalltalk Transform Project}(2.0.2.0,chaider)'!notice ^'The MIT LicenseCopyright © 2009-2018 Christian HaiderPermission is hereby granted, free of charge, to any person obtaining a copyof this software and associated documentation files (the "Software"), to dealin the Software without restriction, including without limitation the rightsto use, copy, modify, merge, publish, distribute, sublicense, and/or sellcopies of the Software, and to permit persons to whom the Software isfurnished to do so, subject to the following conditions:The above copyright notice and this permission notice shall be included inall copies or substantial portions of the Software.THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS ORIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THEAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHERLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS INTHE SOFTWARE.'!parcelName ^'Values'!source ^'Package [Values](3.0.2.0,chaider)'!sourceSmalltalk ^'VisualWorks®, 9.2 of 7. Januar 2022'!sourceStore ^'psql_public_cst_2007'!sourceTime ^'21.06.2022 04:25:42'!targetSmalltalk ^'Pharo 9.0'! !!Emitter methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!emitterClassFor: printvalue "<Emitter class>" ^self subclassResponsibility!emitterFor: printvalue "<Emitter>" ^(self emitterClassFor: printvalue) for: self printer on: self stream at: self level!level "<Integer> the indent level" ^level ifNil: [0]!printer "<ValuePrinter>" ^printer!stream "<WriteStream | TextStream> the output stream" ^stream ifNil: [stream := self streamClass on: (String new: 100)]!streamClass "<WriteStream class | TextStream class>" ^self subclassResponsibility! !!Emitter methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializePrinter: aPrinter stream: aWriteStream level: anInteger printer := aPrinter. stream := aWriteStream. level := anInteger! !!Emitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emit: aString self stream nextPutAll: aString!emitArgument: aPrintargument self emit: aPrintargument name , ': '. aPrintargument value sourceFor: self!emitArraySourceFor: anArray self inBracketsDo: [ anArray size > 4 ifTrue: [self emitLongCollection: anArray] ifFalse: [ self emitSmallCollection: anArray]]!emitClass: aString self emit: aString!emitDictionarySourceFor: aDictionaryPrintvalue self inBracketsDo: [ aDictionaryPrintvalue arguments size > 4 ifTrue: [ self emitLongDictionary: aDictionaryPrintvalue] ifFalse: [ self emitSmallDictionary: aDictionaryPrintvalue]]!emitEmpty: aValuePrintvalue "write the constructor for an empty instance" self emitClass: aValuePrintvalue classname. self emit: ' new'!emitLongCollection: aSequenceableCollection self emit: '(', (OrderedCollection nameRelativeTo: self printer target) , ' new: ' , aSequenceableCollection size printString, ')'. aSequenceableCollection do: [:value | self emitSeparator. self emit: 'add: '. value sourceFor: self. self stream nextPut: $;]. self emitSeparator. self emit: 'yourself'!emitLongDictionary: aDictionaryPrintvalue self emit: '(', (aDictionaryPrintvalue targetClass nameRelativeTo: self printer target), ' new: ' , aDictionaryPrintvalue arguments size printString, ')'. aDictionaryPrintvalue arguments do: [:argument | self emitSeparator. self emit: 'add: '. argument name sourceFor: self. self emit: ' -> '. argument value sourceFor: self. self stream nextPut: $;]. self emitSeparator. self emit: 'yourself'!emitSeparator self subclassResponsibility!emitSmallCollection: aSequenceableCollection self emit: (Array nameRelativeTo: self printer target). aSequenceableCollection do: [:value | self emitSeparator. self emit: 'with: '. value sourceFor: self]!emitSmallDictionary: aDictionaryPrintvalue self emit: (aDictionaryPrintvalue targetClass nameRelativeTo: self printer target). aDictionaryPrintvalue arguments do: [:argument | self emitSeparator. self emit: 'with: '. argument name sourceFor: self. self emit: ' -> '. argument value sourceFor: self]!emitValue: aString self emit: aString!inBracketsDo: aZeroArgumentBlock self stream nextPut: $(. aZeroArgumentBlock ensure: [self stream nextPut: $)]! !!Emitter class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!for: aPrinter | inst | inst := self new. inst initializePrinter: aPrinter stream: nil level: -1. ^inst!for: aPrinter on: aWriteStream at: anInteger | inst | inst := self new. inst initializePrinter: aPrinter stream: aWriteStream level: anInteger. ^inst! !!SourceEmitter methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!emitterClassFor: printvalue ^printvalue isLine ifTrue: [LineEmitter] ifFalse: [BlockEmitter]!streamClass ^WriteStream! !!TextEmitter methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!emitterClassFor: printvalue ^printvalue isLine ifTrue: [TextLineEmitter] ifFalse: [TextBlockEmitter]!streamClass ^TextStream! !!TextEmitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emitArraySourceFor: anArray self emitSmallCollection: anArray!emitBold: aString self stream nextPutAllText: aString asText allBold!emitClass: aString self emitBold: aString!emitDictionarySourceFor: aDictionaryPrintvalue self emitSmallDictionary: aDictionaryPrintvalue!emitSmallCollection: aSequenceableCollection aSequenceableCollection do: [:value | self emitSeparator. value sourceFor: self]!emitSmallDictionary: aDictionaryPrintvalue aDictionaryPrintvalue arguments do: [:argument | self emitSeparator. argument name sourceFor: self. self emit: ': '. argument value sourceFor: self]!emitValue: aString self emitBold: aString! !!TextBlockEmitter methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializePrinter: aPrinter stream: aWriteStream level: anInteger printer := aPrinter. stream := aWriteStream. level := anInteger + 1! !!TextBlockEmitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emitSeparator self stream cr. self level + 1 timesRepeat: [self stream tab]!inBracketsDo: aZeroArgumentBlock aZeroArgumentBlock value! !!Value methodsFor: 'comparing' stamp: 'chaider 21/6/22 04:25'!= anObject "all instvars must be equal" ^self isEqualValue: anObject!hash ^(1 to: self class instSize) inject: 0 into: [:hash :i | hash bitXor: (self instVarAt: i) hash]!isEqualValue: anObject self == anObject ifTrue: [ ^true]. self class = anObject class ifFalse: [ ^false]. 1 to: self class instSize do: [:i | ((self instVarAt: i) isEqualValue: (anObject instVarAt: i)) ifFalse: [ ^false]]. ^true! !!Value methodsFor: 'copying' stamp: 'chaider 21/6/22 04:25'!postCopy super postCopy. self beImmutable! !!Value methodsFor: 'marshaling' stamp: 'chaider 21/6/22 04:25'!passMode "for OpenTalk StSt (Smalltalk to Smalltalk)" ^#value! !!Value methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printOn: stream stream nextPutAll: self asSource!printvalueWith: printer ^printer printvalue: self arguments: #()! !!Value methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isEmpty ^self = self class new!notEmpty ^self isEmpty not! !!Value class methodsFor: 'class initialization' stamp: 'chaider 21/6/22 04:25'!obsolete self allInstancesDo: #beMutable. super obsolete! !!Value class methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!primeRuntime "reset and load all class variables to fill the caches to avoid lazy initialization at runtime. This should be executed when deploying after all application fonts and extensions are loaded" "self primeRuntime" self resetNamedValuesRegistry. Object namesByValues!resetNamedValuesRegistry "self resetNamedValuesRegistry" NamedValuesRegistry := nil! !!Value class methodsFor: 'named values' stamp: 'chaider 21/6/22 04:25'!namedValuesAt: aClass "<Dictionary key: Value value: Symbol> the named instances of aClass" ^self namedValuesRegistry at: aClass ifAbsent: [Dictionary new]!namedValuesAt: aClass ifAbsentPut: aBlock "<Dictionary key: Value value: Symbol> the named instances of aClass" ^self namedValuesRegistry at: aClass ifAbsentPut: aBlock!namedValuesRegistry "<Dictionary key: Class value: (Dictionary key: Value value: Symbol)> the named instances of classes. This is a light weight implementation to hold all named instances of all classes, instead of storing them with the class" ^NamedValuesRegistry ifNil: [NamedValuesRegistry := Valuemap new]! !!Value class methodsFor: 'pragmas' stamp: 'chaider 21/6/22 04:25'!specificationPragmas <pragmas: #class> ^#( #constant:class: #constant:class:comment: #optional:class:default: #optional:class:default:comment: #sequence: #sequence:comment: "#sequence:elements:comment:" #map: #map:comment: "#map:keys:values:comment:" )! !!Value class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification "specification of the constants with pragmas. Only for the instvars defined in this class - access the full specification with #specification" ^self subclassResponsibility! !!Printvalue methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!description "<Text>" | emitter | emitter := self textemitterClass new. self sourceWith: emitter. ^emitter stream contents!emitterClass "<SourceEmitter class>" ^self isLine ifTrue: [LineEmitter] ifFalse: [BlockEmitter]!sourceFor: outerEmitter "<String>" ^self sourceWith: (outerEmitter emitterFor: self)!sourceWith: emitter "write yourself with the emitter" ^self subclassResponsibility!sourceWithPrinter: aPrinter "<String>" | emitter | emitter := self emitterClass for: aPrinter. self sourceWith: emitter. ^emitter stream contents!textemitterClass "<SourceEmitter class>" ^self isLine ifTrue: [TextLineEmitter] ifFalse: [TextBlockEmitter]! !!Printvalue methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isLine ^false!isSimple "does it have to be printed in brackets? only literals are simple" ^false! !!LiteralPrintvalue methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!sourceWith: emitter emitter emitValue: self string!string "<String>" ^string! !!LiteralPrintvalue methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeString: stringString string := stringString. self beImmutable! !!LiteralPrintvalue methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | args := OrderedCollection new. args add: (printer constant: 'string' value: self string). ^printer printvalue: self arguments: args! !!LiteralPrintvalue methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isLine ^true!isSimple ^(self string first = $() not! !!LiteralPrintvalue class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!string: stringString | inst | inst := self new. inst initializeString: stringString. ^inst! !!LiteralPrintvalue class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <constant: #string class: #String>! !!Valuemap methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!atIndex: index "<Association>" ^self associationAt: (self order at: index)!first "<Association>" ^self associationAt: self keys first!indexOf: aKey "<Integer>" ^self order indexOf: aKey!keys "<SequenceableCollection of: Object>" ^self order copy!last "<Association>" ^self associationAt: self keys last!order "<SequenceableCollection of: Object> the order of the keys" ^order ifNil: [order := OrderedCollection new]! !!Valuemap methodsFor: 'comparing' stamp: 'chaider 21/6/22 04:25'!= otherOrderedDictionary ^self class == otherOrderedDictionary class and: [ self size = otherOrderedDictionary size and: [ (1 to: self size) allSatisfy: [:i | (self atIndex: i) = (otherOrderedDictionary atIndex: i)]]]!hash ^(1 to: self size) inject: self class hash into: [:hash :index | | assoc | assoc := self atIndex: index. hash bitXor: (assoc key hash bitXor: assoc value hash)]! !!Valuemap methodsFor: 'copying' stamp: 'chaider 21/6/22 04:25'!copyWith: anAssociation "Answer a copy of the receiver with anAssociation added" | copy | copy := self copy. copy add: anAssociation. ^copy!copyWithAll: aDictionary "Answer a copy of the receiver with all associations from aDictionary added" | copy | copy := self copy. copy addAll: aDictionary. ^copy!postCopy super postCopy. order := self order copy! !!Valuemap methodsFor: 'dictionary enumerating' stamp: 'chaider 21/6/22 04:25'!associationsDo: aBlock "Note: do not use the keys to access anything. This method is used by #changeCapacityTo: and #rehash where key access is not working" | assocs | assocs := Array new: self order size. super associationsDo: [:assoc | assocs at: (self order indexOf: assoc key) put: assoc]. assocs do: aBlock! !!Valuemap methodsFor: 'dictionary removing' stamp: 'chaider 21/6/22 04:25'!removeKey: key ifAbsent: aBlock | index assoc | index := self findElementOrNil: key. assoc := array at: index. assoc isNil ifTrue: [ ^aBlock value]. self order remove: assoc key. array at: index put: nil. tally := tally - 1. self fixCollisionsFrom: index. ^assoc value! !!Valuemap methodsFor: 'enumerating' stamp: 'chaider 21/6/22 04:25'!collect: oneArgumentBlock | newCollection | newCollection := self species new: self size. self keysAndValuesDo: [:eachKey :eachValue | newCollection at: eachKey put: (oneArgumentBlock value: eachValue)]. ^newCollection!keysAndValuesDo: oneArgumentBlock self order do: [:key | oneArgumentBlock value: key value: (self at: key)]!valuesDo: oneArgumentBlock self order do: [:key | oneArgumentBlock value: (self at: key)]! !!Valuemap methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!keysForPrinting ^self keys!printvalueWith: printer ^DictionaryPrintvalue arguments: (self printargumentsWith: printer) isOrdered: true! !!Valuemap methodsFor: 'private' stamp: 'chaider 21/6/22 04:25'!atNewIndex: index put: anObject array at: index put: anObject. tally := tally + 1. self order addLast: anObject key. self fullCheck!noCheckAdd: anAssociation super noCheckAdd: anAssociation. self order addLast: anAssociation key! !!Valuemap methodsFor: 'initialization' stamp: 'chaider 21/6/22 04:25'!initialize: n super initialize: n. order := nil!grow "Grow the elements array and reinsert the old elements" | oldElements oldOrder | oldElements := array. array := Array new: (HashTableSizes atLeast: oldElements size * 2). tally := 0. oldOrder := order. order := nil. oldElements do: [:each | each ifNotNil: [self noCheckAdd: each]]. order := oldOrder! !!BlockEmitter methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializePrinter: aPrinter stream: aWriteStream level: anInteger printer := aPrinter. stream := aWriteStream. level := anInteger + 1! !!BlockEmitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emitSeparator self stream cr. self level + 1 timesRepeat: [self stream tab]! !!ValuePrinter methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!array: selectorname value: object "<Printargument | nil>" object isEmpty ifTrue: [ ^nil]. ^Printargument name: selectorname value: (object printvalueWith: self)!classnameOf: value ^value class nameRelativeTo: self target!constant: selectorname value: object "<Printargument>" ^Printargument name: selectorname value: (object printvalueWith: self)!dictionary: selectorname value: object "<Printargument | nil>" object isEmpty ifTrue: [ ^nil]. ^Printargument name: selectorname value: (object printvalueWith: self)!optional: selectorname value: object "<Printargument | nil>" ^object ifNotNil: [ Printargument name: selectorname value: (object printvalueWith: self)]!printvalue: aValue arguments: arguments aValue class new = aValue ifTrue: [ ^ValuePrintvalue classname: (self classnameOf: aValue)]. ^ValuePrintvalue classname: (self classnameOf: aValue) arguments: (arguments select: [:arg | arg notNil])!target "<Value class> the class for which the object is printed as if the generated source is included into a method of the class. Takes the visibility of classes into account for class name generation (with or without namespaces)" ^target! !!ValuePrinter methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeTarget: targetClass target := targetClass! !!ValuePrinter class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!newFor: targetClass | inst | inst := self new. inst initializeTarget: targetClass. ^inst! !!LineEmitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emitSeparator self stream space! !!DictionaryPrintvalue methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!arguments "<Array>" ^arguments ifNil: [#()]!isOrdered "<Boolean>" ^isOrdered ifNil: [false]!sourceWith: emitter self isEmpty ifTrue: [ ^emitter emit: self targetClassname , ' new']. emitter emitDictionarySourceFor: self!targetClass ^self isOrdered ifTrue: [Valuemap] ifFalse: [Dictionary]!targetClassname ^self targetClass name asString! !!DictionaryPrintvalue methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeArguments: argumentsArray isOrdered: isOrderedBoolean (argumentsArray notNil and: [ argumentsArray notEmpty]) ifTrue: [ arguments := (Array withAll: argumentsArray) beImmutable]. (isOrderedBoolean notNil and: [ self isOrdered ~= isOrderedBoolean]) ifTrue: [ isOrdered := isOrderedBoolean]. self beImmutable! !!DictionaryPrintvalue methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | args := OrderedCollection new. args add: (printer array: 'arguments' value: self arguments). args add: (printer optional: 'isOrdered' value: isOrdered). ^printer printvalue: self arguments: args! !!DictionaryPrintvalue methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isEmpty ^self arguments isEmpty!isLine ^self isEmpty! !!DictionaryPrintvalue class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!arguments: argumentsArray isOrdered: isOrderedBoolean | inst | inst := self new. inst initializeArguments: argumentsArray isOrdered: isOrderedBoolean. ^inst! !!DictionaryPrintvalue class methodsFor: 'instance creation optional' stamp: 'chaider 21/6/22 04:25'!arguments: argumentsArray ^self arguments: argumentsArray isOrdered: nil!isOrdered: isOrderedBoolean ^self arguments: nil isOrdered: isOrderedBoolean! !!DictionaryPrintvalue class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <sequence: #arguments> <optional: #isOrdered class: #Boolean default: 'false'>! !!TextLineEmitter methodsFor: 'writing' stamp: 'chaider 21/6/22 04:25'!emitSeparator self stream space! !!Printargument methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!name "<String>" ^name!sourceWith: emitter emitter emitArgument: self!value "<Printvalue>" ^value! !!Printargument methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeName: nameString value: valuePrintvalue name := nameString. value := valuePrintvalue. self beImmutable! !!Printargument methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | args := OrderedCollection new. args add: (printer constant: 'name' value: self name). args add: (printer constant: 'value' value: self value). ^printer printvalue: self arguments: args! !!Printargument methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isSimple ^self value isSimple! !!Printargument class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!name: nameString value: valuePrintvalue | inst | inst := self new. inst initializeName: nameString value: valuePrintvalue. ^inst! !!Printargument class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <constant: #name class: #String> <constant: #value class: #Printvalue>! !!ValuePrintvalue methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!arguments "<Array>" ^arguments ifNil: [#()]!classname "<String>" ^classname!sourceWith: emitter self arguments isEmpty ifTrue: [ ^emitter emitEmpty: self]. emitter inBracketsDo: [ emitter emitClass: self classname. self arguments do: [:arg | emitter emitSeparator. emitter emitArgument: arg]]! !!ValuePrintvalue methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeClassname: classnameString arguments: argumentsArray classname := classnameString. (argumentsArray notNil and: [ argumentsArray notEmpty]) ifTrue: [ arguments := (Array withAll: argumentsArray) beImmutable]. self beImmutable! !!ValuePrintvalue methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | args := OrderedCollection new. args add: (printer constant: 'classname' value: self classname). args add: (printer array: 'arguments' value: self arguments). ^printer printvalue: self arguments: args! !!ValuePrintvalue methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isLine self arguments size = 1 ifTrue: [ ^self arguments first value isLine]. ^self arguments size < 5 and: [ self arguments allSatisfy: [:arg | arg isSimple]]! !!ValuePrintvalue class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!classname: classnameString arguments: argumentsArray | inst | inst := self new. inst initializeClassname: classnameString arguments: argumentsArray. ^inst! !!ValuePrintvalue class methodsFor: 'instance creation optional' stamp: 'chaider 21/6/22 04:25'!classname: classnameString ^self classname: classnameString arguments: nil! !!ValuePrintvalue class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <constant: #classname class: #String> <sequence: #arguments>! !!DictionaryPrintargument class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <constant: #name class: #Printvalue> <constant: #value class: #Printvalue>! !!ArrayPrintvalue methodsFor: 'accessing' stamp: 'chaider 21/6/22 04:25'!arguments "<Array>" ^arguments ifNil: [#()]!sourceWith: emitter emitter emitArraySourceFor: self arguments! !!ArrayPrintvalue methodsFor: 'initialize-release' stamp: 'chaider 21/6/22 04:25'!initializeArguments: argumentsArray (argumentsArray notNil and: [ argumentsArray notEmpty]) ifTrue: [ arguments := (Array withAll: argumentsArray) beImmutable]. self beImmutable! !!ArrayPrintvalue methodsFor: 'printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | args := OrderedCollection new. args add: (printer array: 'arguments' value: self arguments). ^printer printvalue: self arguments: args! !!ArrayPrintvalue methodsFor: 'testing' stamp: 'chaider 21/6/22 04:25'!isLine ^self arguments size = 1 or: [ self arguments size < 5 and: [ self arguments allSatisfy: [:arg | arg isSimple]]]! !!ArrayPrintvalue class methodsFor: 'instance creation' stamp: 'chaider 21/6/22 04:25'!arguments: argumentsArray | inst | inst := self new. inst initializeArguments: argumentsArray. ^inst! !!ArrayPrintvalue class methodsFor: 'specification' stamp: 'chaider 21/6/22 04:25'!localSpecification <sequence: #arguments>! !!SequenceableCollection methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer self isLiteral ifTrue: [ ^LiteralPrintvalue string: self printString]. ^ArrayPrintvalue arguments: (self collect: [:item | item printvalueWith: printer])! !!Date methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | wst | wst := WriteStream on: (String new: 25). wst nextPut: $(; nextPutAll: (printer classnameOf: self); nextPutAll: ' d: '; nextPutAll: self dayOfMonth printString; nextPutAll: ' m: '; nextPutAll: self monthIndex printString; nextPutAll: ' y: '; nextPutAll: self year printString; nextPut: $). ^LiteralPrintvalue string: wst contents! !!Date class methodsFor: '*Values-instance creation' stamp: 'chaider 21/6/22 04:25'!d: dayInteger m: monthInteger y: yearInteger ^self year: yearInteger month: monthInteger day: dayInteger! !!Object methodsFor: '*Values-comparing' stamp: 'chaider 21/6/22 04:25'!isEqualValue: anObject ^self = anObject! !!Object methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!asDescription "<Text> produces a text equivalent to the soure with bold leaf values" ^self asDescriptionFor: self class!asDescriptionFor: targetClass "<Text> produces a text equivalent to the source" | printer printvalue | printer := ValuePrinter newFor: targetClass. printvalue := self printvalueWith: printer. ^printvalue description!asSource "<String> produces a string which can be evaluated in the context of the receiver class to an object equivalent to the receiver" ^self asSourceFor: self class!asSourceFor: targetClass "<String> produces a string which can be evaluated in the context of targetClass to an object equivalent to the receiver" | printer printvalue | printer := ValuePrinter newFor: targetClass. printvalue := self printvalueWith: printer. ^printvalue sourceWithPrinter: printer!printvalueWith: printer ^LiteralPrintvalue string: self storeString! !!Object methodsFor: '*Values-actions' stamp: 'chaider 21/6/22 04:25'!beImmutable self beReadOnlyObject. ^self!beMutable self beWritableObject. ^self! !!Object class methodsFor: '*Values-named values' stamp: 'chaider 21/6/22 04:25'!namedValueNames "<Array of: Symbol> names to print for special known values" ^#()!nameOrNilFor: aValue "<Symbol | nil>" ^self namesByValues at: aValue ifAbsent: [nil]!namesByValues "<Dictionary key: Value value: Symbol>" ^Value namedValuesAt: self ifAbsentPut: [self newNamesByValues]!newNamesByValues "<Dictionary key: Value value: Symbol>" | dict | dict := Valuemap new: self namedValueNames size. self namedValueNames do: [:symbol | dict at: (self perform: symbol) put: symbol]. ^dict! !!Timestamp methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | wst | wst := WriteStream on: (String new: 50). wst nextPut: $(; nextPutAll: (printer classnameOf: self); nextPutAll: ' d: '; nextPutAll: self dayOfMonth printString; nextPutAll: ' m: '; nextPutAll: self month printString; nextPutAll: ' y: '; nextPutAll: self year printString. (self hour isZero and: [ self minute isZero and: [ self second isZero]]) ifTrue: [ wst nextPut: $). ^LiteralPrintvalue string: wst contents]. wst nextPutAll: ' h: '; nextPutAll: self hour printString. (self minute isZero and: [ self second isZero]) ifTrue: [ wst nextPut: $). ^LiteralPrintvalue string: wst contents]. wst nextPutAll: ' m: '; nextPutAll: self minute printString. self second isZero ifTrue: [ wst nextPut: $). ^LiteralPrintvalue string: wst contents]. wst nextPutAll: ' s: '; nextPutAll: self second printString; nextPut: $). ^LiteralPrintvalue string: wst contents! !!Timestamp class methodsFor: '*Values-instance creation' stamp: 'chaider 21/6/22 04:25'!d: dayInteger m: monthInteger y: yearInteger ^self d: dayInteger m: monthInteger y: yearInteger h: 0 m: 0 s: 0!d: dayInteger m: monthInteger y: yearInteger h: hoursInteger ^self d: dayInteger m: monthInteger y: yearInteger h: hoursInteger m: 0 s: 0!d: dayInteger m: monthInteger y: yearInteger h: hoursInteger m: minutesInteger ^self d: dayInteger m: monthInteger y: yearInteger h: hoursInteger m: minutesInteger s: 0!d: dayInteger m: monthInteger y: yearInteger h: hoursInteger m: minutesInteger s: secondsInteger ^self year: yearInteger month: monthInteger day: dayInteger hour: hoursInteger minute: minutesInteger second: secondsInteger!fromDate: aDate andTime: aTime ^self date: aDate time: aTime! !!Time methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | wst | wst := WriteStream on: (String new: 25). (self hours isZero and: [ self minutes isZero and: [ self seconds isZero]]) ifTrue: [ wst nextPutAll: (printer classnameOf: self); nextPutAll: ' zero'. ^LiteralPrintvalue string: wst contents]. wst nextPut: $(; nextPutAll: (printer classnameOf: self); nextPutAll: ' h: '; nextPutAll: self hours printString. (self minutes isZero and: [ self seconds isZero]) ifTrue: [ wst nextPut: $). ^LiteralPrintvalue string: wst contents]. wst nextPutAll: ' m: '; nextPutAll: self minutes printString. self seconds isZero ifTrue: [ wst nextPut: $). ^LiteralPrintvalue string: wst contents]. wst nextPutAll: ' s: '; nextPutAll: self seconds printString; nextPut: $). ^LiteralPrintvalue string: wst contents! !!Time class methodsFor: '*Values-instance creation' stamp: 'chaider 21/6/22 04:25'!h: hoursInteger ^self h: hoursInteger m: 0 s: 0!h: hoursInteger m: minutesInteger ^self h: hoursInteger m: minutesInteger s: 0!h: hoursInteger m: minutesInteger s: secondsInteger ^self hour: hoursInteger minute: minutesInteger second: secondsInteger!zero ^self h: 0! !!Dictionary methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!keysForPrinting ^[self keys asSortedCollection] on: Error do: [:ex | ex return: self keys]!printargumentsWith: aPrinter ^self keysForPrinting collect: [:key | DictionaryPrintargument name: (key printvalueWith: aPrinter) value: ((self at: key) printvalueWith: aPrinter)]!printvalueWith: printer ^DictionaryPrintvalue arguments: (self printargumentsWith: printer)! !!Duration methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | wst | wst := WriteStream on: (String new: 25). wst nextPut: $(; nextPutAll: (printer classnameOf: self); nextPutAll: ' nanoseconds: '; nextPutAll: self asNanoseconds printString; nextPut: $). ^LiteralPrintvalue string: wst contents! !!Duration methodsFor: '*Values-converting' stamp: 'chaider 21/6/22 04:25'!asNanoseconds ^self asNanoSeconds! !!Duration class methodsFor: '*Values-instance creation' stamp: 'chaider 21/6/22 04:25'!nanoseconds: aNumber ^self nanoSeconds: aNumber!nanoseconds: aNumber ^self nanoSeconds: aNumber! !!Point methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | string | string := (self x asSourceFor: printer target) , ' @ ' , (self y asSourceFor: printer target). ^LiteralPrintvalue string: string! !!Class methodsFor: '*Values-accessing' stamp: 'chaider 21/6/22 04:25'!nameRelativeTo: targetClass "<String>" "self nameRelativeTo: Object" "there are no namespaces in Pharo" ^self name asString! !!Class methodsFor: '*Values-testing' stamp: 'chaider 21/6/22 04:25'!isInScope: aClass "<Boolean> true if aClass is visible by the receiver - aClass can be used in the source without namespace qualifier. false when aClass cannot be seen by the receiver - use the fullName" "All classes are globally visible in Pharo" ^true! !!Rectangle methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | wst | wst := WriteStream on: (String new: 25). wst nextPut: $(; nextPutAll: (self origin asSourceFor: printer target); nextPutAll: ' corner: '; nextPutAll: (self corner asSourceFor: printer target); nextPut: $). ^LiteralPrintvalue string: wst contents! !!ColorValue methodsFor: '*Values-converting' stamp: 'chaider 21/6/22 04:25'!asByteArray ^ByteArray with: (self red * 255) truncated with: (self green * 255) truncated with: (self blue * 255) truncated!asGrayValue "<Number> between 0.0 (Black) and 1.0 (White) suitable for PDF DeviceGray" ^self brightness!rgbIndex "<Integer> Three 8 bit RGB numbers interpreted as number for ordering" ^self asByteArray inject: 0 into: [:num :byte | (num bitShift: 8) + byte]!asColorValue ^self!asByteArray ^ByteArray with: (self red * 255) truncated with: (self green * 255) truncated with: (self blue * 255) truncated! !!ColorValue methodsFor: '*Values-printing' stamp: 'chaider 21/6/22 04:25'!printvalueWith: printer | args | (self class nameOrNilFor: self) ifNotNil: [:symbol | ^LiteralPrintvalue string: (printer classnameOf: self) , ' ' , symbol asString]. args := OrderedCollection new. args add: (printer constant: 'fromBytesRed' value: (self red * 255) rounded). args add: (printer constant: 'green' value: (self green * 255) rounded). args add: (printer constant: 'blue' value: (self blue * 255) rounded). ^printer printvalue: self arguments: args! !!ColorValue methodsFor: '*Values-testing' stamp: 'chaider 21/6/22 04:25'!isEmpty ^self privateRGB isNil!isEmpty ^self privateRGB isNil! !!ColorValue methodsFor: '*Values-accessing' stamp: 'chaider 21/6/22 04:25'!cyan "<Number[0..1]> the cyan part of the receiver" ^1.0 - self red!magenta "<Number[0..1]> the magenta part of the receiver" ^1.0 - self green!yellow "<Number[0..1]> the yellow part of the receiver" ^1.0 - self blue! !!ColorValue class methodsFor: '*Values-instance creation' stamp: 'chaider 21/6/22 04:25'!fromByte: anInteger ^self fromBytes: (ByteArray new: 3 withAll: anInteger)!fromBytes: threeBytes ^self fromBytesRed: threeBytes first green: (threeBytes at: 2) blue: threeBytes last!fromBytesRed: redByte green: greenByte blue: blueByte ^self red: redByte / 255 green: greenByte / 255 blue: blueByte / 255!red: r green: g blue: b ^self r: r g: g b: b! !!ColorValue class methodsFor: '*Values-named values' stamp: 'chaider 21/6/22 04:25'!namedValueNames "The selection is the common set of color names with identical colors in VW and Squeak/Pharo The colors are all variations of min and max of the 3 components" "self namesByValues" ^#(#black #white #red #green #blue #cyan #magenta #yellow)!new ^self basicNew!black ^super black asColorValue!white ^super white asColorValue!red ^super red asColorValue!green ^super green asColorValue!blue ^super blue asColorValue!cyan ^super cyan asColorValue!magenta ^super magenta asColorValue!yellow ^super yellow asColorValue! !!Color methodsFor: '*Values-converting' stamp: 'chaider 21/6/22 04:25'!asColorValue ^ColorValue red: self red green: self green blue: self blue! !!TextStream methodsFor: '*Values-accessing' stamp: 'chaider 21/6/22 04:25'!nextPutAllText: aText ^self nextPutAll: aText! !"Initializations"!