VM Maker: Cog-eem.354.mcz

 
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.354.mcz

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

Name: Cog-eem.354
Author: eem
Time: 16 March 2019, 1:44:07.412059 pm
UUID: 46932143-1042-4836-b362-84b799def68d
Ancestors: Cog-eem.353

Provide an edit script to map cCode: 'func(...)''s to the new _: style.

=============== Diff against Cog-eem.353 ===============

Item was added:
+ ----- Method: CogScripts class>>eliminateCCodeInSmalltalkFrom: (in category 'plugin scripts') -----
+ eliminateCCodeInSmalltalkFrom: aPluginClass
+ "Edit any self cCode: 'something that looks like a C call' [ inSmalltalk: [ ...] ]
+ into the function: arg1 _: arg2 style, ensuring that if the class has (a) simulator
+ subclass(es), that a stub implementation exists in the subclass. Write any failures
+ to the transcript."
+
+ "(Smalltalk organization classesInCategory: #'3DICC-Plugins') do:
+ [:aPluginClass|
+ CogScripts eliminateCCodeInSmalltalkFrom: aPluginClass]"
+
+ | transformations |
+ transformations := Dictionary new.
+ aPluginClass selectorsAndMethodsDo:
+ [:selector :method|
+ (self mapCCodeToSmalltalkIn: method)
+ ifNotNil: [:edit| transformations at: selector put: edit]
+ ifNil: [((method sendsSelector: #cCode:) or: [method sendsSelector: #cCode:inSmalltalk:]) ifTrue:
+ [Transcript cr; show: 'mapCCodeToSmalltalkIn: failed to edit cCode:... in ', aPluginClass name, '>>', selector]]].
+ transformations keys sort do:
+ [:selector|
+ [:code :messages|
+ (aPluginClass compile: code notifying: nil)
+ ifNil: [Transcript cr; show: 'Failed to compile mapCCodeToSmalltalkIn: transformation for ', aPluginClass name, '>>', selector]
+ ifNotNil:
+ [(aPluginClass allSubclasses select: [:sc| sc name endsWith: 'Simulator']) do:
+ [:sc|
+ messages do:
+ [:msg|
+ (sc includesSelector: msg selector) ifFalse:
+ [sc compile: msg createStubMethod classified: 'simulation']]]]]
+ valueWithArguments: (transformations at: selector)]!

Item was added:
+ ----- Method: CogScripts class>>mapCCodeToSmalltalkIn: (in category 'plugin scripts') -----
+ mapCCodeToSmalltalkIn: aMethod
+ "Answer new source code for aMethod where cCode: strings have been mapped to the new foo: arg1 _: arg2
+ format and any inSmalltalk: code is included in a trailing comment."
+ | methodNode edits text |
+ methodNode := aMethod methodNode.
+ edits := Dictionary new.
+ methodNode block nodesDo:
+ [:n| | cCode |
+ (n isMessage
+ and: [(#(cCode: cCode:inSmalltalk:) includes: n selector key)
+ and: [(cCode := n arguments first value key) isString
+ and: [cCode notEmpty]]]) ifTrue:
+ [| argVec |
+ argVec := self processedCCodeCallFor: cCode.
+ edits at: (methodNode encoder sourceRangeFor: n)
+ put: (String streamContents:
+ [:s| | first |
+ argVec size > 2 ifTrue:
+ [s nextPutAll: 'cCoerce: (self '].
+ s nextPutAll: argVec first.
+ argVec size > 1 ifTrue:
+ [first := true.
+ argVec second do:
+ [:thing| | param |
+ thing ~~ #, ifTrue:
+ [s nextPutAll: (first
+ ifTrue: [': ']
+ ifFalse: [' _: ']).
+ first := false.
+ param := thing isArray
+ ifTrue: [s nextPutAll: '(self cCoerce: '. thing first]
+ ifFalse: [thing].
+ (methodNode encoder lookupVariable: param ifAbsent: [])
+ ifNotNil: [s nextPutAll: param]
+ ifNil: [s store: param]].
+ thing isArray ifTrue:
+ [(self printTypeFor: thing last on: s) ifFalse:
+ [^nil].
+ s nextPut: $)]]].
+ argVec size > 2 ifTrue:
+ [s nextPut: $).
+ (self printTypeFor: argVec last on: s) ifFalse:
+ [^nil]].
+ #cCode:inSmalltalk: == n selector key ifTrue:
+ [| r |
+ r := methodNode encoder sourceRangeFor: n arguments last.
+ s space; nextPutAll: ' "inSmalltalk: '; nextPutAll: (methodNode sourceText copyFrom: r first to: r last); nextPut: $"]])]].
+ edits ifEmpty: [^nil].
+ text := methodNode sourceText asString.
+ (edits keys asSortedCollection: [:a :b| a first > b first]) do:
+ [:range|
+ text := text copyReplaceFrom: range first to: range last with: (edits at: range)].
+ ^{ text.
+ (edits collect:
+ [:string| | selectorString index |
+ selectorString := (string beginsWith: 'cCoerce:') ifTrue: [string allButFirst: 10] ifFalse: [string].
+ (index := selectorString indexOfSubCollection: '"inSmalltalk') > 0 ifTrue:
+ [selectorString := selectorString first: index - 1].
+ (selectorString occurrencesOf: $)) > (selectorString occurrencesOf: $() ifTrue:
+ [selectorString := selectorString first: (selectorString lastIndexOf: $)) - 1].
+ (selectorString beginsWith: 'self') ifTrue:
+ [selectorString := selectorString allButFirst: 4].
+ selectorString := selectorString extractSelector.
+ Message
+ selector: selectorString asSymbol
+ arguments: (1 to: selectorString numArgs) asArray]) }!

Item was added:
+ ----- Method: CogScripts class>>printTypeFor:on: (in category 'plugin scripts') -----
+ printTypeFor: anArray on: aWriteStream
+ | type |
+ type := String streamContents:
+ [:s|
+ anArray
+ do: [:ea| [s nextPutAll: ea] on: Error do: [:ex| ^false]]
+ separatedBy: [s space]].
+ aWriteStream nextPutAll: ' to: '; store: type asSymbol.
+ ^true!

Item was added:
+ ----- Method: CogScripts class>>processedCCodeCallFor: (in category 'plugin scripts') -----
+ processedCCodeCallFor: aCCodeString
+ "Take a cCode: string containing a C call and answer a literal array encoding the parameter
+ list with any casts moved to the back, for ease of generating self cCoerce: thing to: type.
+
+ 'func(a,b)' => #(func #(a b))
+ '(type)func()' => #(func #() #(type))
+ 'func((type)a)') => #(func #(#(a #(type)))))
+ "
+ | argVec parameterList |
+ argVec := Compiler evaluate: '#(', aCCodeString, ')'.
+ [argVec size > 2 and: [argVec last == #';']] whileTrue: [argVec := argVec allButLast].
+ argVec last notEmpty ifTrue:
+ [parameterList := (argVec last splitBy: #(#,)) collect: [:p| p size > 1 ifTrue: [{p last. p first}] ifFalse: [p first]].
+ argVec at: argVec size put: parameterList].
+ ^argVec first isArray
+ ifTrue: [argVec allButFirst, {argVec first}]
+ ifFalse: [argVec]!

Item was added:
+ ----- Method: String>>extractSelector (in category '*Cog-script support') -----
+ extractSelector
+ "Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse,
+ in most cases it does what we want, and where it doesn't, we're none the worse for it.
+ Unlike findSelector this doesn't require that the poutative selector has been interned."
+ | sel possibleParens |
+ sel := self withBlanksTrimmed.
+ (sel includes: $:) ifTrue:
+ [sel := sel copyReplaceAll: ':' with: ': '. "for the style (aa max:bb) with no space"
+ sel := sel copyReplaceAll: '[:' with: '[ :'.    "for the style ([:a) with no space"  
+ possibleParens := sel findTokens: Character separators.
+ sel := self class streamContents:
+ [:s | | level |
+ level := 0.
+ possibleParens do:
+ [:token |
+ (level = 0 and: [token endsWith: ':'])
+ ifTrue: [s nextPutAll: token]
+ ifFalse: [level := level
+ + (token occurrencesOf: $() - (token occurrencesOf: $))
+ + (token occurrencesOf: $[) - (token occurrencesOf: $])
+ + (token occurrencesOf: ${) - (token occurrencesOf: $})]]]].
+ sel isEmpty ifTrue: [^ nil].
+ ^sel!