diff -r 5389e6fbb3bc -r 0eaf09920532 compiler/PPCCompiler.st --- a/compiler/PPCCompiler.st Wed Nov 05 21:40:01 2014 +0000 +++ b/compiler/PPCCompiler.st Wed Nov 05 23:05:19 2014 +0000 @@ -80,13 +80,16 @@ ! cleanGeneratedMethods: class - class methodsDo: [ :mthd | - mthd category = #generated ifTrue:[ - class removeSelector: mthd selector. - ] - ] - - "Modified: / 26-10-2014 / 22:07:26 / Jan Vrany " + ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ + class methodsDo: [ :mthd | + mthd category = #generated ifTrue:[ + class removeSelector: mthd selector. + ] + ] + ] ifFalse: [ + (class allSelectorsInProtocol: #generated) do: [ :selector | + class removeSelectorSilently: selector ]. + ] ! cleanInstVars: class @@ -237,16 +240,7 @@ ! idFor: object prefixed: prefix effect: effect - | body suffix | - ^ ids at: object ifAbsentPut: [ - suffix := self fastMode ifTrue: [ '_fast' ] ifFalse: [ '' ]. - ((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [ - (object name, suffix) asSymbol - ] ifFalse: [ - body := ids size asString. - (prefix asString, '_', body, suffix) asSymbol - ] - ] + ^ self idFor: object prefixed: prefix suffixed: '' effect: effect. ! idFor: object prefixed: prefix suffixed: suffix effect: effect @@ -278,47 +272,53 @@ ! compileTree: compilerTree as: name parser: parser params: params - | rPackageOrganizer | + | | + params do: [ :p | + (p key = #guards) ifTrue: [ self guards: p value ]. + ]. - params do: [ :p | - (p key = #guards) ifTrue: [ self guards: p value ]. - ]. - " - To create a new Package so that a new classes are not in PetitCompiler package. - TODO JK: This is HACK, needs some more interoperable approach - " - rPackageOrganizer := Smalltalk at: #RPackageOrganizer. - rPackageOrganizer notNil ifTrue:[ - rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. - ]. + ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ + | rPackageOrganizer | + rPackageOrganizer := Smalltalk at: #RPackageOrganizer. + rPackageOrganizer notNil ifTrue:[ + rPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. + ]. - compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). - compiledParser ifNil: [ + compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). + compiledParser ifNil: [ PPCompiledParser subclass: name instanceVariableNames:'' classVariableNames:'' poolDictionaries:'' category:'PetitCompiler-Generated'. compiledParser := Smalltalk at: name. - ] ifNotNil: [ + ] ifNotNil: [ self clean: compiledParser - ]. - compiledParser constants removeAll. - + ]. + ] ifFalse: [ + RPackageOrganizer default registerPackageNamed: 'PetitCompiler-Generated'. + compiledParser := (Smalltalk at: name ifAbsent: [ nil ]). + compiledParser ifNil: [ + PPCompiledParser subclass: name. + compiledParser := Smalltalk at: name. + compiledParser category: 'PetitCompiler-Generated' + ] ifNotNil: [ + self clean: compiledParser + ]. + ]. + compiledParser constants removeAll. + - - self startMethod: #start. - self add: '^ '. - self callOnLine: (compilerTree compileWith: self). - self stopMethod. + self startMethod: #start. + self add: '^ '. + self callOnLine: (compilerTree compileWith: self). + self stopMethod. - self installVariablesAndMethods. + self installMethodsAndVariables: compiledParser. - compiledParser referringParser: parser. - ^ compiledParser - - "Modified: / 30-10-2014 / 23:10:57 / Jan Vrany " + compiledParser referringParser: parser. + ^ compiledParser ! copy: parser @@ -332,11 +332,9 @@ ! installVariables: class - | string | - string := class constants keys inject: '' into: [:r :e | r, ' ', e ]. - PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' poolDictionaries:'' category: 'PetitCompiler-Generated'. - - "Modified: / 26-10-2014 / 22:01:45 / Jan Vrany " + | string | + string := class constants keys inject: '' into: [:r :e | r, ' ', e ]. + PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' category: 'PetitCompiler-Generated'. ! installVariablesAndMethods