--- 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