--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCScannerCodeGenerator.st	Fri Jul 24 15:37:23 2015 +0100
@@ -0,0 +1,306 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#PPCScannerCodeGenerator
+	instanceVariableNames:'codeGen fsa backlinkStates backlinkTransitions arguments openSet
+		joinPoints incommingTransitions methodCache id'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Scanner'
+!
+
+!PPCScannerCodeGenerator methodsFor:'accessing'!
+
+arguments
+    ^ arguments 
+!
+
+arguments: anObject
+    arguments := anObject
+! !
+
+!PPCScannerCodeGenerator methodsFor:'analysis'!
+
+analyzeBacklinks
+    backlinkTransitions := fsa backTransitions.
+    backlinkStates := IdentityDictionary new.
+    
+    backlinkTransitions do: [ :t |
+        (self backlinksTo: (t destination)) add: t.
+    ].
+!
+
+analyzeJoinPoints
+    | joinTransitions |
+    joinTransitions := fsa joinTransitions.
+    joinTransitions := joinTransitions reject: [ :t | self isBacklinkDestination: t destination ].
+    joinPoints := IdentityDictionary new.
+    
+    joinTransitions do: [ :t |
+        (joinPoints at: t destination ifAbsentPut: [ IdentitySet new ]) add: t.
+    ]
+    
+!
+
+analyzeTransitions
+    | transitions |
+    transitions := fsa allTransitions.
+    incommingTransitions := IdentityDictionary new.
+    (self incommingTransitionsFor: fsa startState) add: #transitionStub.
+    
+    transitions do: [ :t |
+        (self incommingTransitionsFor: t destination) add: t.
+    ].
+!
+
+backlinksTo: state
+    ^ backlinkStates at: state ifAbsentPut: [ OrderedCollection new ] 
+!
+
+closedJoinPoints
+    | closed |
+    closed := IdentitySet new.
+    
+    joinPoints keysAndValuesDo: [ :key :value | 
+        value isEmpty ifTrue: [ closed add: key ].
+    ].
+
+    ^ closed
+!
+
+containsBacklink: state
+    state transitions do: [ :t |
+        (self isBacklink:  t) ifTrue: [ ^ true ]
+    ].
+
+    ^ false
+!
+
+hasMultipleIncommings: state
+    ^ (incommingTransitions at: state ifAbsent: [ self error: 'should not happen']) size > 1
+!
+
+incommingTransitionsFor: state
+    ^ incommingTransitions  at: state ifAbsentPut: [ IdentitySet new ]
+!
+
+isBacklink: transition
+    ^ backlinkTransitions includes: transition
+!
+
+isBacklinkDestination: state
+    ^ (self backlinksTo: state)  isEmpty not
+!
+
+isJoinPoint: state
+    "Please note that joinPoints are removed as the compilaction proceeds"
+    ^ joinPoints keys includes: state
+!
+
+joinTransitionsTo: joinPoint "state"
+    ^ joinPoints at: joinPoint ifAbsent: [ #() ]
+! !
+
+!PPCScannerCodeGenerator methodsFor:'code generation'!
+
+generate
+    self assert: fsa isDeterministic.
+    self assert: fsa isWithoutEpsilons.
+    self assert: fsa checkConsistency.
+
+
+    self analyzeBacklinks.
+    self analyzeJoinPoints.
+    self analyzeTransitions.
+    
+    openSet := IdentitySet new.
+    
+    codeGen startMethod: (codeGen idFor: fsa).
+    codeGen codeComment: (Character codePoint: 13) asString, fsa asString.
+
+    self generateFor: fsa startState.
+
+    codeGen stopMethod.	
+        
+    ^ self compileScannerClass new
+
+
+!
+
+generate: aPEGFsa
+    fsa := aPEGFsa.
+
+    fsa compact.
+    fsa checkSanity.
+    
+    ^ self generate
+!
+
+generateFinalFor: state
+    state isFinal ifFalse: [  ^ self ].
+
+    codeGen codeRecordMatch: state retval priority: state priority.
+!
+
+generateFor: state
+"	(self isJoinPoint: state) ifTrue: [ 
+        ^ codeGen codeComment: 'join point generation postponed...'
+    ].
+"
+    codeGen cachedValue: (codeGen idFor: state) ifPresent: [ :method | 
+        "if state is already cached, it has multiple incomming links.
+     	 In such a case, it is compiled as a method, thus return immediatelly"
+        ^ codeGen codeAbsoluteReturn:  method call
+    ].
+
+    self generateStartMethod: state.
+"	(self isBacklinkDestination: state) ifTrue: [ 
+        codeGen codeStartBlock.
+    ].
+"
+    self generateFinalFor: state.
+    self generateNextFor: state.
+    self generateTransitionsFor: state.
+
+"	(self isBacklinkDestination: state) ifTrue: [ 
+        codeGen codeEndBlockWhileTrue.
+    ].
+"
+    self generateStopMethod: state.
+!
+
+generateForSingleTransition: t from: state
+    
+    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t ].
+    
+    codeGen codeAssertPeek: (t characterSet) orReturn: state priority.
+"	(self isBacklink: t) ifTrue: [ 
+        codeGen add: 'true'
+    ] ifFalse: [ 
+        self generateFor: t destination.
+    ]
+"
+    self generateFor: t destination
+!
+
+generateForTransition: t from: state	
+    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t   ].
+    
+"	(self isBacklink: t) ifTrue: [ 
+        codeGen codeAssertPeek: (t characterSet) ifTrue: [ 
+            codeGen add: 'true'
+        ]
+    ] ifFalse: [ 
+        codeGen codeAssertPeek: (t characterSet) ifTrue: [
+            self generateFor: t destination.
+        ].
+    ].
+"
+    codeGen codeAssertPeek: (t characterSet) ifTrue: [
+        self generateFor: t destination.
+    ].
+    codeGen codeIfFalse.
+!
+
+generateNextFor: state
+    state transitions isEmpty ifTrue: [  ^ self ].
+    codeGen codeNextChar.
+!
+
+generateReturnFor: state
+    codeGen codeNlReturnResult: state priority.
+!
+
+generateStartMethod: state
+    id := codeGen idFor: state.
+
+    codeGen codeComment: 'START - Generated from state: ', state asString.
+
+    (self hasMultipleIncommings: state) ifTrue: [ 
+        codeGen startMethod: id.
+    ] ifFalse: [ 
+        codeGen  startInline: id.
+    ]
+!
+
+generateStopMethod: state
+    |  |
+    (self hasMultipleIncommings: state) ifTrue: [ 
+        codeGen codeAbsoluteReturn: codeGen stopMethod call.
+    ] ifFalse: [ 
+        codeGen code: codeGen stopInline call.
+    ].
+    codeGen codeComment: 'STOP - Generated from state: ', state asString.
+!
+
+generateTransitionsFor: state
+    (state transitions size = 0) ifTrue: [  
+        self generateReturnFor: state.
+        ^ self	
+    ].
+
+    (state transitions size = 1) ifTrue: [  
+        self generateForSingleTransition: state transitions anyOne from: state.
+        ^ self
+    ].
+
+
+    codeGen codeNl.
+    state transitions do: [ :t |
+        self generateForTransition: t from: state
+    ].
+
+    codeGen indent.
+    self generateReturnFor: state.
+    codeGen dedent.
+    codeGen codeNl.
+    state transitions size timesRepeat: [ codeGen addOnLine: ']' ].
+    codeGen addOnLine: '.'.
+    
+
+"	self closedJoinPoints isEmpty ifFalse: [ 
+        | jp |
+        self assert: self closedJoinPoints size == 1.
+
+        jp := self closedJoinPoints anyOne.
+        self removeJoinPoint: jp.
+        self generateFor: jp.
+    ]
+"
+! !
+
+!PPCScannerCodeGenerator methodsFor:'compiling'!
+
+compileScannerClass
+    | builder |
+    builder := PPCClassBuilder new.
+    
+    builder compiledClassName: arguments scannerName.
+    builder compiledSuperclass: PPCScanner.
+    builder methodDictionary: codeGen methodDictionary.
+    builder constants: codeGen constants.
+
+    ^ builder compileClass.	
+! !
+
+!PPCScannerCodeGenerator methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    
+    codeGen := PPCFSACodeGen new.
+    arguments := PPCArguments default.
+! !
+
+!PPCScannerCodeGenerator methodsFor:'support'!
+
+removeJoinPoint: state
+    self assert: (joinPoints at: state) size = 0.
+    joinPoints removeKey: state
+!
+
+removeJoinTransition: t
+    (self joinTransitionsTo: t destination) remove: t ifAbsent: [ self error: 'this should not happen' ].
+! !
+