compiler/PPCCompiler.st
changeset 414 0eaf09920532
parent 400 49dc52d760c8
child 415 f30eb7ea54cd
--- 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 <jan.vrany@fit.cvut.cz>"
+	((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 <jan.vrany@fit.cvut.cz>"
+	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 <jan.vrany@fit.cvut.cz>"
+	| string |
+	string := class constants keys inject: '' into: [:r :e | r, ' ', e  ].
+	PPCompiledParser subclass: class name instanceVariableNames: string classVariableNames: '' category: 'PetitCompiler-Generated'.
 !
 
 installVariablesAndMethods