--- a/compiler/PPCCompiler.st Wed Nov 19 10:52:37 2014 +0000
+++ b/compiler/PPCCompiler.st Mon Nov 24 00:09:23 2014 +0000
@@ -2,7 +2,7 @@
Object subclass:#PPCCompiler
instanceVariableNames:'compilerStack compiledParser cache inlining debug profile
- currentMethod lastMethod guards ids updateContextMethod tokenMode'
+ currentMethod guards ids tokenMode rootNode'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Core'
@@ -31,10 +31,6 @@
inlining := value
!
-lastMethod
- ^ lastMethod
-!
-
parameters: associations
| key value |
associations do: [ :ass |
@@ -55,12 +51,8 @@
profile := aBoolean
!
-startInline: id
- self push.
-
- currentMethod := PPCInlinedMethod new.
- currentMethod id: id.
- currentMethod profile: self profile.
+rootNode
+ ^ rootNode
! !
!PPCCompiler methodsFor:'cleaning'!
@@ -106,6 +98,10 @@
currentMethod add: string.
!
+addComment: string
+ currentMethod add: '"', string, '"'.
+!
+
addConstant: value as: name
compiledParser addConstant: value as: name.
!
@@ -138,15 +134,6 @@
currentMethod addOnLine: anotherMethod call.
!
-checkCache: id
- | method value |
- "Check if method is already compiled/hand written"
- method := compiledParser compiledMethodAt: id ifAbsent: [ nil ].
- method ifNotNil: [ ^ lastMethod := PPCCompiledMethod new id: id; yourself ].
-
- ^ (value := self cachedValue: id) ifNotNil: [ lastMethod := value ].
-!
-
dedent
currentMethod dedent
!
@@ -159,19 +146,6 @@
currentMethod nl
!
-pop
- | array |
- array := compilerStack pop.
- currentMethod := array first
-!
-
-push
- | array |
- array := { currentMethod }.
- compilerStack push: array.
- (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
-!
-
smartRemember: parser
^ self smartRemember: parser to: #memento
!
@@ -194,41 +168,10 @@
^ 'context restore: ', mementoName, '.'.
!
-startMethod: id
- | sender |
- (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
- self push.
-
-
- currentMethod := PPCMethod new.
- currentMethod id: id.
- currentMethod profile: self profile.
- self cache: id as: currentMethod.
-
- sender := thisContext sender receiver.
- self add: '"Method generated from ', sender asString, '"'.
-!
-
startTokenMode
tokenMode := true
!
-stopInline
- | sender |
- sender := thisContext sender receiver.
- self add: '"Inlined by ', sender asString, '"'.
- lastMethod := currentMethod.
- currentMethod := nil.
- self pop.
-!
-
-stopMethod
- self cache: currentMethod methodName as: currentMethod.
- lastMethod := currentMethod.
- currentMethod := nil.
- self pop.
-!
-
stopTokenMode
tokenMode := false
! !
@@ -244,10 +187,24 @@
!
idFor: object prefixed: prefix suffixed: suffix effect: effect
- | body |
+ | body id |
+
+ "Halt if: [ (object isKindOf: PPCNode) and: [object name = #smalltalk_ws ] ]."
+
+" ((object isKindOf: PPCNode) and: [object name = #smalltalk_ws ]) ifTrue: [ Transcript crShow: 'st_ws' ].
+"
^ ids at: object ifAbsentPut: [
((object isKindOf: PPCNode) and: [object name isNotNil]) ifTrue: [
- (object name, suffix) asSymbol
+ "Halt if: [ object name = #smalltalk_ws ]."
+" (object name = #smalltalk_ws) ifTrue: [Transcript crShow: 'NEW st_ws'].
+"
+ id := (object name, suffix) asSymbol.
+ "Make sure, that the generated ID is uniqe!!"
+ ((ids values select: [ :e | e = id ]) isEmpty) ifTrue: [ id ]
+ ifFalse: [
+ body := ids size asString.
+ (id, '_', body) asSymbol
+ ]
] ifFalse: [
body := ids size asString.
(prefix asString, '_', body, suffix) asSymbol
@@ -255,6 +212,81 @@
]
! !
+!PPCCompiler methodsFor:'code generation - support'!
+
+checkCache: id
+ | method |
+ "Check if method is hand written"
+ method := compiledParser compiledMethodAt: id ifAbsent: [ nil ].
+ method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
+
+ ^ self cachedValue: id
+!
+
+pop
+ | retval |
+ retval := compilerStack pop.
+ compilerStack isEmpty ifFalse: [ currentMethod := compilerStack top ].
+ ^ retval
+
+ "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+push
+ compilerStack push: currentMethod.
+ (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
+
+ "Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startInline: id
+ | sender |
+
+ currentMethod := PPCInlinedMethod new.
+ currentMethod id: id.
+ currentMethod profile: self profile.
+ self push.
+
+
+ sender := thisContext sender receiver.
+ self addComment: 'START inlining by ', sender asString.
+!
+
+startMethod: id
+ | sender |
+ (cache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].
+
+ currentMethod := PPCMethod new.
+ currentMethod id: id.
+ currentMethod profile: self profile.
+ self push.
+
+ self cache: id as: currentMethod.
+
+ sender := thisContext sender receiver.
+ self addComment: 'START of method generated by ', sender asString.
+!
+
+stopInline
+ | sender |
+ sender := thisContext sender receiver.
+ self addComment: 'STOP inlining by ', sender asString.
+ ^ self pop.
+!
+
+stopMethod
+ | sender |
+ sender := thisContext sender receiver.
+ self addComment: 'END of method generated by ', sender asString.
+
+ self cache: currentMethod methodName as: currentMethod.
+ ^ self pop.
+!
+
+top
+ ^ compilerStack top
+! !
+
!PPCCompiler methodsFor:'compiling'!
compile: aPPParser as: name
@@ -272,18 +304,18 @@
!
compileTree: compilerTree as: name parser: parser params: params
- | |
- params do: [ :p |
- (p key = #guards) ifTrue: [ self guards: p value ].
- ].
+ | |
+ params do: [ :p |
+ (p key = #guards) ifTrue: [ self guards: p value ].
+ ].
- ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- | rPackageOrganizer |
- 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: [
@@ -295,32 +327,34 @@
compiledParser := Smalltalk at: name.
] ifNotNil: [
self clean: compiledParser
- ].
- ] 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.
-
+ ].
+ ] 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.
+
+ rootNode := compilerTree.
+ self precomputeFirstSets: rootNode.
+ self precomputeFollowSets: rootNode.
+ self precomputeFollowSetsWithTokens: rootNode.
+
+ 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 installVariablesAndMethods.
-
- compiledParser referringParser: parser.
- ^ compiledParser
-
- "Modified: / 05-11-2014 / 23:17:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ compiledParser referringParser: parser.
+ ^ compiledParser
!
copy: parser
@@ -334,11 +368,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: '' poolDictionaries: '' category: 'PetitCompiler-Generated'.
!
installVariablesAndMethods
@@ -356,8 +388,6 @@
compiledParser := Smalltalk at: compiledParserClassName.
self installMethods: compiledParser.
-
- "Created: / 30-10-2014 / 23:15:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
optimize: parser params: params
@@ -367,6 +397,36 @@
^ retval
!
+precomputeFirstSets: root
+ | firstSets |
+ firstSets := root firstSets.
+
+ root allNodesDo: [ :node |
+ node firstSet: (firstSets at: node).
+ ]
+
+!
+
+precomputeFollowSets: root
+ | followSets |
+ followSets := root followSets.
+
+ root allNodesDo: [ :node |
+ node followSet: (followSets at: node).
+ ]
+
+!
+
+precomputeFollowSetsWithTokens: root
+ | followSets |
+ followSets := root followSetsSuchThat: [:e | e isTerminal or: [ e isKindOf: PPCTrimmingTokenNode ]].
+
+ root allNodesDo: [ :node |
+ node followSetWithTokens: (followSets at: node).
+ ]
+
+!
+
toCompilerTree: parser
^ parser asCompilerTree
! !
@@ -429,7 +489,7 @@
super initialize.
compilerStack := Stack new.
cache := IdentityDictionary new.
- ids := IdentityDictionary new.
+ ids := Dictionary new.
tokenMode := false.
inlining := true.
@@ -437,20 +497,6 @@
guards := true.
! !
-!PPCCompiler methodsFor:'ppcmethod protocol'!
-
-bridge
- ^ PPCBridge on: lastMethod methodName.
-!
-
-call
- ^ lastMethod call
-!
-
-canInline
- ^ lastMethod canInline
-! !
-
!PPCCompiler class methodsFor:'documentation'!
version_HG