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!