--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCScannerCodeGenerator.st Fri Jul 24 15:06:54 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' ].
+! !
+