VM Maker: VMMakerCompatibilityForPharo6-GuillermoPolito.10.mcz

 
Guillermo Polito uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-GuillermoPolito.10.mcz

==================== Summary ====================

Name: VMMakerCompatibilityForPharo6-GuillermoPolito.10
Author: GuillermoPolito
Time: 7 May 2019, 11:03:08.229705 am
UUID: 4f49f938-aa44-0d00-8739-04000059f8ce
Ancestors: VMMakerCompatibilityForPharo6-eem.9

Fixes in AST translation to make it work as in Squeak
- to:do: => to:by:do: with extra arguments
- ifNil:ifNotNil: => ifTrue:ifFalse:
- fix arguments in TMethods
- fix comments in TMethods
- add name at the level of TParseNode (#name is not defined in Object anymore in Pharo)

Other
- Added FileDirectory compatibility layer using FileSystem behind the scenes (see FileDirectory and VMMakerFile classes).
- Added PackageOrganizer compatibility layer using RPackage behind the scenes.
- Extending Scanner and SystemNavigation with compatibility methods
- Extending Time with compatibility method


=============== Diff against VMMakerCompatibilityForPharo6-eem.9 ===============

Item was changed:
  SystemOrganization addCategory: #VMMakerCompatibilityForPharo6!
+ SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'!
  SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-Kernel-Methods'!
+ SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-PackageOrganizer'!
  SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-SUnit-Extensions'!
  SystemOrganization addCategory: 'VMMakerCompatibilityForPharo6-System'!

Item was added:
+ Object subclass: #FileDirectory
+ instanceVariableNames: 'fileReference'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'!

Item was added:
+ ----- Method: FileDirectory class>>default (in category 'instance creation') -----
+ default
+
+ ^ self!

Item was added:
+ ----- Method: FileDirectory class>>directoryExists: (in category 'testing') -----
+ directoryExists: aString
+
+ | ref |
+ ref := aString asFileReference.
+ ^ ref exists and: [ ref isDirectory ]!

Item was added:
+ ----- Method: FileDirectory class>>directoryNamed: (in category 'instance-creation') -----
+ directoryNamed: aString
+
+ ^ self on: aString!

Item was added:
+ ----- Method: FileDirectory class>>fileExists: (in category 'testing') -----
+ fileExists: aString
+
+ | ref |
+ ref := aString asFileReference.
+ ^ ref exists and: [ ref isFile ]!

Item was added:
+ ----- Method: FileDirectory class>>oldFileNamed: (in category 'file-opening') -----
+ oldFileNamed: aString
+
+ ^ VMMakerFile on: aString!

Item was added:
+ ----- Method: FileDirectory class>>on: (in category 'instance-creation') -----
+ on: aString
+
+ ^ self new
+ fileReference: aString asFileReference;
+ yourself!

Item was added:
+ ----- Method: FileDirectory>>assureExistence (in category 'checking') -----
+ assureExistence
+
+ fileReference ensureCreateDirectory!

Item was added:
+ ----- Method: FileDirectory>>deleteFileNamed: (in category 'file-system') -----
+ deleteFileNamed: aString
+
+ (self fileNamed: aString) delete!

Item was added:
+ ----- Method: FileDirectory>>directoryNamed: (in category 'accessing') -----
+ directoryNamed: aString
+
+ ^ self class on: fileReference / aString!

Item was added:
+ ----- Method: FileDirectory>>entryAt:ifAbsent: (in category 'accessing') -----
+ entryAt: aString ifAbsent: aBlockClosure
+
+ | ref |
+ ref := fileReference / aString.
+ ref exists ifFalse: [ ^ aBlockClosure value ].
+ ^ ref!

Item was added:
+ ----- Method: FileDirectory>>fileExists: (in category 'testing') -----
+ fileExists: aString
+
+ ^ (VMMakerFile on: (fileReference / aString)) exists!

Item was added:
+ ----- Method: FileDirectory>>fileNamed: (in category 'accessing') -----
+ fileNamed: aString
+
+ ^ fileReference / aString!

Item was added:
+ ----- Method: FileDirectory>>fileNamesMatching: (in category 'accessing') -----
+ fileNamesMatching: aString
+
+ ^ fileReference children
+ select: [ :e | e basename match: aString ]
+ thenCollect: [ :e | e halt ]!

Item was added:
+ ----- Method: FileDirectory>>fileReference: (in category 'accessing') -----
+ fileReference: aFileReference
+
+ fileReference := aFileReference!

Item was added:
+ ----- Method: FileDirectory>>fullNameFor: (in category 'accessing') -----
+ fullNameFor: aString
+
+ ^ (self fileNamed: aString) fullName!

Item was added:
+ ----- Method: FileDirectory>>oldFileNamed: (in category 'file-opening') -----
+ oldFileNamed: aString
+
+ ^ (self fileNamed: aString) readStream!

Item was removed:
- ----- Method: GtTranscript>>ensureCr (in category '*VMMakerCompatibilityForPharo6') -----
- ensureCr
- "do nothing"
- (self text isEmpty or: [ self text last == Character cr]) ifFalse:
- [ self cr ]!

Item was removed:
- ----- Method: GtTranscript>>flush (in category '*VMMakerCompatibilityForPharo6') -----
- flush
- "do nothing"!

Item was removed:
- ----- Method: GtTranscript>>next:put: (in category '*VMMakerCompatibilityForPharo6') -----
- next: anInteger put: aCharacter
- "Make anObject be the next anInteger number of objects accessible by the
- receiver. Answer anObject."
-
- 1 to: anInteger do: [:i| self nextPut: aCharacter ].
- ^ aCharacter!

Item was added:
+ Object subclass: #PackageOrganizer
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-PackageOrganizer'!

Item was added:
+ ----- Method: PackageOrganizer class>>default (in category 'accessing') -----
+ default
+
+ ^ self new!

Item was added:
+ ----- Method: PackageOrganizer>>packageOfClass: (in category 'accessing') -----
+ packageOfClass: aClass
+
+ ^ aClass package!

Item was changed:
  ----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
  asTranslatorNodeIn: aTMethod
  "Answer a TParseNode subclass equivalent of me"
  "selector is sometimes a Symbol, sometimes a SelectorNode!!
  On top of this, numArgs is needed due to the (truly grody) use of
  arguments as a place to store the extra expressions needed to generate
  code for in-line to:by:do:, etc.  see below, where it is used.
 
  Expand super nodes in place. Elide sends of halt so that halts can be
  sprinkled through the simulator but will be eliminated from the generated C."
+ | usedSelector rcvrOrNil args |
+ usedSelector := selector.
- | rcvrOrNil args ifNotNilBlock |
  rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
  (rcvrOrNil notNil
  and: [rcvrOrNil isVariable
  and: [rcvrOrNil name = 'super']]) ifTrue:
+ [^aTMethod superExpansionNodeFor: usedSelector args: arguments].
+ usedSelector == #halt ifTrue: [^rcvrOrNil].
+ (usedSelector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
+  or: [usedSelector == #cCode:]) ifTrue:
- [^aTMethod superExpansionNodeFor: selector args: arguments].
- selector == #halt ifTrue: [^rcvrOrNil].
- (selector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
-  or: [selector == #cCode:]) ifTrue:
  [arguments first isBlockNode ifTrue:
  [| block |
  ^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
  ifTrue: [block statements first]
  ifFalse: [block]].
  (arguments first isLiteralNode
  and: [arguments first value isString
  and: [arguments first value isEmpty]]) ifTrue:
  [^arguments first asTranslatorNodeIn: aTMethod]].
  args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod].
+
+ (usedSelector == #to:do:) ifTrue: [ | block |
+ usedSelector := #to:by:do:.
+ block := args second.
+ args := OrderedCollection
+ with: args first
+ with: (TConstantNode new setValue: 1)
+ with: args second
+ with: (TAssignmentNode new
+ setVariable: (arguments first asTranslatorNodeIn: aTMethod)
+ expression: (TConstantNode new setValue: 1);
+ yourself)
+ with: (TSendNode new
+ setSelector: #<=
+ receiver: (TVariableNode new setName: block args first)
+ arguments: { receiver asTranslatorNodeIn: aTMethod })
+ with: (TAssignmentNode new
+ setVariable: (TVariableNode new setName: block args first)
+ expression: (TSendNode new
+ setSelector: #+
+ receiver: (TVariableNode new setName: block args first)
+ arguments: { TConstantNode new setValue: 1 });
+ yourself)
+ ].
+
+ (usedSelector == #ifNil:ifNotNil:) ifTrue: [
+ usedSelector := #ifTrue:ifFalse:.
+ rcvrOrNil := TSendNode new
+ setSelector: #==
+ receiver: rcvrOrNil
+ arguments: { TVariableNode new setName: 'nil' } ].
+
+ (usedSelector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue:
+ [usedSelector := #ifFalse:. args := {args last}].
+ (usedSelector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue:
+ [usedSelector := #ifTrue:. args := {args first}].
+ (usedSelector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue:
+ [usedSelector := #ifTrue:. args := {args last}].
+ (usedSelector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue:
+ [usedSelector := #ifTrue:. args := {args first}].
+
+ ((usedSelector == #ifFalse: or: [usedSelector == #or:])
+ and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
+ ["Restore argument block that got moved by transformOr: or transformIfFalse:"
+ args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}].
+ (args size > usedSelector numArgs and: [usedSelector ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg"
+ ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:"
+ self assert: args size - usedSelector numArgs = 1.
+ self assert: (args last isStmtList
+  and: [args last statements size = 1
+  and: [(args last statements first isVariable
+ or: [args last statements first isConstant])
+  and: [#('nil' true false) includes: args last statements first nameOrValue]]]).
+ args := args first: usedSelector numArgs].
+
+ ((CCodeGenerator isVarargsSelector: usedSelector)
- (selector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue:
- [selector := #ifFalse:. args := {args last}].
- (selector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue:
- [selector := #ifTrue:. args := {args first}].
- (selector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue:
- [selector := #ifTrue:. args := {args last}].
- (selector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue:
- [selector := #ifTrue:. args := {args first}].
- ((CCodeGenerator isVarargsSelector: selector)
  and: [args last isCollection
  and: [args last isSequenceable]]) ifTrue:
  [args := args allButLast, args last].
  ^TSendNode new
+ setSelector: usedSelector
- setSelector: selector
  receiver: rcvrOrNil
  arguments: args!

Item was changed:
  ----- Method: RBMethodNode>>asTranslationMethodOfClass: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
  asTranslationMethodOfClass: aTMethodClass
    "Answer a TMethod (or subclass) derived from the receiver."
  | additionalMethodState |
  additionalMethodState := AdditionalMethodState forMethod: nil selector: selector.
  pragmas ifNotNil:
  [pragmas do:
  [:pragmaNode|
  additionalMethodState := additionalMethodState copyWith: pragmaNode asPragma]].
+
  ^aTMethodClass new
  setSelector: selector
  definingClass: compilationContext getClass
  args: arguments
+ locals: ((self allDefinedVariables copyWithoutAll: (arguments collect: #name)) collect: [:string| string -> string])
- locals: ((self allDefinedVariables copyWithoutAll: arguments) collect: [:string| string -> string])
  block: (body lastIsReturn
  ifTrue: [body]
  ifFalse: [body shallowCopy
  addSelfReturn;
  yourself])
  primitive: ((pragmas ifNotNil:
  [pragmas detect: [:pragmaNode| pragmaNode selector beginsWith: #primitve:] ifNone: []])
  ifNil: [0]
  ifNotNil: [:pragmaNode| pragmaNode arguments first value])
  properties: additionalMethodState
  comment: self commentOrNil!

Item was changed:
  ----- Method: RBProgramNode>>commentOrNil (in category '*VMMakerCompatibilityForPharo6-C translation') -----
  commentOrNil
+
+ | comments |
+ comments := self propertyAt: #comments ifAbsent: [ ^ nil ].
+ ^ comments collect: #contents!
- ^self propertyAt: #comments ifAbsent: []!

Item was added:
+ ----- Method: Scanner>>typedScanTokens: (in category '*VMMakerCompatibilityForPharo6') -----
+ typedScanTokens: textOrString
+ "Answer an Array that has been tokenized with literals mapped to literals,
+ special characters mapped to symbols and variable names and keywords
+ to strings. This methiod accepts _ (underscore) as an assignment token
+ irrespective of whether the system prefers := as the assignment token."
+ | s |
+ self initScannerForTokenization.
+ self scan: (ReadStream on: textOrString asString).
+ s := WriteStream on: (Array new: 16).
+ [tokenType == #doIt] whileFalse:
+ [(token == #-
+  and: [(self typeTableAt: hereChar) == #xDigit]) ifTrue:
+ [self scanToken.
+ token := token negated].
+ s nextPut: token.
+ self scanToken].
+ ^s contents
+
+ "Scanner new typedScanTokens: (Scanner sourceCodeAt: #typedScanTokens:)"!

Item was added:
+ ----- Method: SystemNavigation>>allCallsOn:localTo: (in category '*VMMakerCompatibilityForPharo6') -----
+ allCallsOn: aSymbol localTo: aClass
+
+ ^ self allCallsOn: aSymbol from: aClass!

Item was added:
+ ----- Method: TParseNode>>name (in category '*VMMakerCompatibilityForPharo6') -----
+ name
+
+ ^ self printString!

Item was added:
+ ----- Method: Time class>>dateAndTimeNow (in category '*VMMakerCompatibilityForPharo6') -----
+ dateAndTimeNow
+
+ | now |
+ now := DateAndTime now.
+ ^ { now asDate . now asTime }!

Item was added:
+ Object subclass: #VMMakerFile
+ instanceVariableNames: 'fileReference'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-FileDirectoryToFileSystem'!

Item was added:
+ ----- Method: VMMakerFile class>>on: (in category 'instance-creation') -----
+ on: aString
+
+ ^ self new
+ fileReference: aString asFileReference;
+ yourself!

Item was added:
+ ----- Method: VMMakerFile>>contentsOfEntireFile (in category 'accessing') -----
+ contentsOfEntireFile
+
+ ^ fileReference contents!

Item was added:
+ ----- Method: VMMakerFile>>exists (in category 'testing') -----
+ exists
+
+ ^ fileReference exists and: [ fileReference isFile ]!

Item was added:
+ ----- Method: VMMakerFile>>fileReference: (in category 'accessing') -----
+ fileReference: aFileReference
+ fileReference := aFileReference!