"

COPYRIGHT (c) 2020 LabWare

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Smalltalk }"

Object subclass:#AutomagicSourcePorter

	instanceVariableNames:'source klass klassMap'

	classVariableNames:''

	poolDictionaries:''

	category:'Kernel-Classes-Support-Autoporting'

!

AutomagicSourcePorter class instanceVariableNames:'defaultKlassMap'

"

 No other class instance variables are inherited by this class.

"

!

!AutomagicSourcePorter class methodsFor:'documentation'!

copyright

"

COPYRIGHT (c) 2020 LabWare

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This is an abstract base superclass for automagic code porting

    from Smalltalk/X to other dialects. These can be / are used when

    exporting code to be consumed by others.

    [author:]

        Jan Vrany <jan.vrany@labware.com>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!AutomagicSourcePorter class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!AutomagicSourcePorter class methodsFor:'accessing'!

defaultKlassMap

    defaultKlassMap isNil ifTrue:[ 

        defaultKlassMap := Dictionary withKeysAndValues: self defaultKlassMapEntries.

    ].

    ^ defaultKlassMap

    "Created: / 01-07-2020 / 12:31:35 / Jan Vrany <jan.vrany@labware.com>"

!

defaultKlassMapEntries

    ^ #()

    "Created: / 01-07-2020 / 12:32:22 / Jan Vrany <jan.vrany@labware.com>"

! !

!AutomagicSourcePorter methodsFor:'initialization'!

initialize

    "Invoked when a new instance is created."

    super initialize.

    "/ please change as required (and remove this comment)

    "/ source := nil.

    "/ klass := nil.

    klassMap := self class defaultKlassMap copy

    "Modified: / 29-10-2018 / 15:54:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-07-2020 / 12:30:46 / Jan Vrany <jan.vrany@labware.com>"

! !

!AutomagicSourcePorter methodsFor:'porting'!

portClass: aClass source: aString

    "Perform all automatic source code transformation on a method's source

     and return new source with all the necessary modifications."

    source := aString.

    klass := aClass.

    self rewriteClassDefinition.

    ^ source

    "Created: / 24-10-2018 / 11:06:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

portMethod: aMethod source: aString

    "Perform all automatic source code transformation on a method's source

     and return new source with all the necessary modifications."

    source := aString.

    klass := aMethod mclass.

    self rewrite.

    ^ source

    "Created: / 24-10-2018 / 11:05:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AutomagicSourcePorter methodsFor:'private'!

collectClassRewritesFrom: aCollection into: aDictionary

    "Collect all renames for class names in `aCollection` and

     add an entru for each class that has to be renamed in

     (output) `aDictionary`.

     The renames are collected as folllows:

       (i) If there's a explicit rename rule in `klassMap` use that one.

      (ii) If not, strip namespace prefix (for Bee does not like Smalltalk/X style 

           namespace prefixes)

    "

    aCollection do:[:name |

        |idx nsName clsName|

        (klassMap includesKey:name) ifTrue:[

            "/ (i) an explicit rename...

            aDictionary at:name put:(klassMap at:name).

        ] ifFalse:[

            (name includes:$:) ifTrue:[

                "/ (ii) a class with namespace prefix...

                idx := name indexOfSubCollection:'::'.   

                nsName := name copyTo:idx-1.

                clsName := name copyFrom:idx+2.

                aDictionary at:name put:clsName.

            ]

        ].

    ].

    "Created: / 24-10-2018 / 11:34:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AutomagicSourcePorter methodsFor:'rewriting'!

rewrite

    self assert: source isString.

    self assert: klass isBehavior.

    self

        rewriteEOLComments; checkSource;

        rewriteClassReferences; checkSource;

        rewriteSimpleExpressions; checkSource

    "Created: / 16-10-2018 / 20:29:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-11-2018 / 14:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-07-2020 / 12:48:38 / Jan Vrany <jan.vrany@labware.com>"

!

rewriteClassDefinition

    |parser globalsToRename symbolsToRename replacer tree|

    parser := Parser for: source.

    parser foldConstants:false.

    parser parseExpressionWithSelf: nil

            notifying:nil

            ignoreErrors:false

            ignoreWarnings:false

            inNameSpace: Smalltalk.

    globalsToRename := Dictionary new.

    symbolsToRename := Dictionary new.

    self collectClassRewritesFrom: parser usedGlobals into: globalsToRename.

    self collectClassRewritesFrom: parser usedSymbols into: symbolsToRename.

    (globalsToRename isEmpty and:[symbolsToRename isEmpty]) ifTrue:[^ self ].

    replacer := ParseTreeSourceRewriter new.

    replacer alwaysPerformAllSearches:true.

    globalsToRename keysAndValuesDo:[:oldName :newName |

        replacer replaceVariable: oldName with: newName.

    ].

    symbolsToRename keysAndValuesDo:[:oldName :newName |

        replacer replaceLiteral: oldName with: newName.

    ].

    tree := RBParser parseExpression:source.

    replacer executeTree: tree.

    source := replacer executeReplacementsInSource:source.

    "Created: / 24-10-2018 / 11:15:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AutomagicSourcePorter methodsFor:'rewriting-individual'!

rewriteClassReferences

    |parser globalsToRename symbolsToRename replacer tree|

    "/ all references to namespace variables

    parser := Parser new.

    parser foldConstants:false.

    parser

        parseMethod:source 

        in:klass

        ignoreErrors:false

        ignoreWarnings:false.

    globalsToRename := Dictionary new.

    symbolsToRename := Dictionary new.

    self collectClassRewritesFrom: parser usedGlobals into: globalsToRename.

    "/ NO, following is bad as it rewrites every symbol, not only class names!!

    "/ DONT DO THAT!!

    "/ self collectClassRewritesFrom: parser usedGlobals into: symbolsToRename.   

    (globalsToRename isEmpty and:[symbolsToRename isEmpty]) ifTrue:[^ self ].

    replacer := ParseTreeSourceRewriter new.

    replacer alwaysPerformAllSearches:true.

    globalsToRename keysAndValuesDo:[:oldName :newName |

        replacer replaceVariable: oldName with: newName.

    ].

    symbolsToRename keysAndValuesDo:[:oldName :newName |

        replacer replaceLiteral: oldName with: newName.

    ].

    tree := RBParser parseMethod:source.

    replacer executeTree: tree.

    source := replacer executeReplacementsInSource:source.

    self checkSource

    "Created: / 24-10-2018 / 10:17:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-11-2018 / 19:31:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rewriteEOLComments

    |parser eolComments xlatedComment newSource|

    "/ Short-circuit if there's no EOL-comment in the code...

    (source includesSubString: '"/') ifFalse: [ ^ self ].

    parser := Parser new.

    parser foldConstants:false.

    parser saveComments:true.

    parser parseMethod:source in:klass ignoreErrors:true ignoreWarnings:true.

    eolComments := parser comments select:[:each | each isEndOfLineComment].

    eolComments notEmpty ifTrue:[

        "/ start with the last (so I don't have to update the positions)

        eolComments sort:[:a :b | a startPosition < b startPosition].

        eolComments reverseDo:[:each |

            xlatedComment := source copyFrom:(each startPosition+2) to:each endPosition.

            (xlatedComment includes:$") ifTrue:[

                "/ self halt.

                xlatedComment := xlatedComment copyReplaceAll:$" with:$'.

            ].

            newSource := source copyTo:(each startPosition-1).

            newSource := newSource,'" ',xlatedComment,'"'.

            newSource := newSource,(source copyFrom:(each endPosition + 1)).

            source := newSource.

        ].

    ].

    "Created: / 16-10-2018 / 20:38:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-11-2018 / 21:00:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rewriteSimpleExpressions

    "To be overridden by subclasses, empty by default"

    "Modified: / 01-07-2020 / 12:50:12 / Jan Vrany <jan.vrany@labware.com>"

! !

!AutomagicSourcePorter methodsFor:'utilities'!

checkSource

    "Check the source is syntactically correct, if not,

     raise an error."

    RBParser 

        parseMethod:source

        onError:[:aString :pos | self error: 'Invalid source: ', aString , ' at ', pos printString].

    "Created: / 17-10-2018 / 10:43:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rewrite: matchPattern with: rewritePattern

    self rewrite: matchPattern with: rewritePattern when: [ :node | true ]

    "Created: / 29-10-2018 / 15:16:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rewrite: matchPattern with: rewritePattern when: condition

    | replacer tree |

    replacer := ParseTreeSourceRewriter new.

    replacer alwaysPerformAllSearches:true.

    replacer replace: matchPattern with: rewritePattern when: condition.

    tree := RBParser parseMethod:source.

    replacer executeTree: tree.

    source := replacer executeReplacementsInSource:source.

    self checkSource

    "Created: / 29-10-2018 / 15:15:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !