compiler/PPCFSACodeGen.st
changeset 515 b5316ef15274
parent 502 1e45d3c96ec5
child 524 f6f68d32de73
--- a/compiler/PPCFSACodeGen.st	Fri Jul 24 15:06:54 2015 +0100
+++ b/compiler/PPCFSACodeGen.st	Mon Aug 17 12:13:16 2015 +0100
@@ -3,7 +3,7 @@
 "{ NameSpace: Smalltalk }"
 
 PPCCodeGen subclass:#PPCFSACodeGen
-	instanceVariableNames:'fsa backlinkStates'
+	instanceVariableNames:'fsa backlinkStates compiler'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'PetitCompiler-Scanner'
@@ -15,88 +15,86 @@
     ^ 'generated - scanning'
 ! !
 
-!PPCFSACodeGen methodsFor:'analysis'!
-
-beginOfRange: characterSet
-    characterSet withIndexDo: [ :e :index | 
-        e ifTrue: [ ^ index ]
-    ].
-    self error: 'should not happend'
-!
-
-endOfRange: characterSet
-    | change |
-    change := false.
-    characterSet withIndexDo: [ :e :index | 
-        e ifTrue: [ change := true ].
-        (e not and: [ change ]) ifTrue: [ ^ index - 1]
-    ].
-    ^ characterSet size
-!
-
-isLetter: characterSet
-    | changes previous |
-    changes := 0.
-    previous := false.
-    characterSet withIndexDo: [ :e :index |
-        (e == (Character codePoint: index) isLetter) ifFalse: [ ^ false ].
-    ].
-    ^ true
-!
-
-isSingleCharacter: characterSet
-    ^ (characterSet select: [ :e | e ]) size = 1
-!
-
-isSingleRange: characterSet
-    | changes previous |
-    changes := 0.
-    previous := false.
-    characterSet do: [ :e | 
-        (e == previous) ifFalse: [ changes := changes + 1 ].
-        previous := e.
-    ].
-    ^ changes < 3
-! !
-
 !PPCFSACodeGen methodsFor:'coding'!
 
 codeAbsoluteReturn: code
     self add: '^ ', code
 !
 
-codeAssertPeek: characterSet
-    | character id extendedCharacterSet |
+codeAssertPeek: t
+    |   id  |
+    self assert: (t isKindOf: PEGFsaTransition).
+
+    (t isPredicateTransition and: [t isEOF]) ifTrue: [ 
+        self addOnLine: 'currentChar isNil'.
+        ^ self
+    ].
+
     
-    (self isSingleCharacter: characterSet) ifTrue: [ 
-        character := self character: characterSet.
-        self addOnLine: 'self peek == ', character storeString.
+    (t isPredicateTransition) ifTrue: [ 
+        self addOnLine: t predicate asString, ' value: currentChar codePoint'.
+        ^ self
+    ].
+
+    (t isAny) ifTrue: [ 
+        self addOnLine: 'true'.
         ^ self
     ].
 
-    (self isLetter: characterSet) ifTrue: [ 
-        self addOnLine: 'self peek isLetter'.
+    
+    (t isSingleCharacter) ifTrue: [ 
+        self addOnLine: 'currentChar == ', t character storeString.
+        ^ self
+    ].
+
+    (t isNotSingleCharacter) ifTrue: [ 
+        self addOnLine: 'currentChar ~~ ', t notCharacter storeString.
         ^ self
     ].
 
-    (self isSingleRange: characterSet) ifTrue: [ 
+    (t isLetter) ifTrue: [ 
+        self addOnLine: 'currentChar isLetter'.
+        ^ self
+    ].
+
+    (t isWord) ifTrue: [ 
+        self addOnLine: 'currentChar isAlphaNumeric'.
+        ^ self
+    ].
+
+    (t isDigit) ifTrue: [ 
+        self addOnLine: 'currentChar isDigit'.
+        ^ self
+    ].
+
+    (t isSingleRange) ifTrue: [ 
         | begin end |
-        begin := self beginOfRange: characterSet.
-        end := self endOfRange: characterSet.
+        begin := t beginOfRange.
+        end := t endOfRange.
         self addOnLine: 'self peekBetween: ', begin asString, ' and: ', end asString.
         ^ self
     ].
 
-    extendedCharacterSet := (characterSet asOrderedCollection addLast: false; yourself) asArray.
-    id := self idFor: characterSet prefixed: 'characterSet'.
     
-    self addConstant: extendedCharacterSet as: id.
-    self addOnLine: id, ' at: self peek asInteger'.
+    id := idGen cachedSuchThat: [ :e | e = t characterSet ] 
+                    ifNone: [ self idFor: t characterSet defaultName: 'characterSet' ].
+    
+    self addConstant: t characterSet as: id.
+    self addOnLine: '(currentChar isNotNil) and: [',  id, ' at: currentChar codePoint ]'.
 !
 
-codeAssertPeek: characterSet ifTrue: block
+codeAssertPeek: transition ifFalse: falseBlock
+    self add: '('.
+    self codeAssertPeek: transition.
+    self addOnLine: ') ifFalse: [ '.
+    falseBlock value.
+    self addOnLine: ']'.
+    self codeDot.
+!
+
+codeAssertPeek: t ifTrue: block
     self addOnLine: '('.
-    self codeAssertPeek: characterSet.
+    self codeAssertPeek: t.
     self addOnLine: ') ifTrue: ['.
     self indent.
     self code: block.
@@ -104,18 +102,19 @@
     self add: ']'.
 !
 
-codeAssertPeek: characterSet orReturn: priority
+codeAssertPeek: transition orReturn: priority
+    self error: 'deprecated'.
     self add: '('.
-    self codeAssertPeek: characterSet.
+    self codeAssertPeek: transition.
     self addOnLine: ') ifFalse: [ '.
     self codeReturnResult: priority.
     self addOnLine: ']'.
     self codeDot.
 !
 
-codeAssertPeek: characterSet whileTrue: block
+codeAssertPeek: transition whileTrue: block
     self add: '['.
-    self codeAssertPeek: characterSet.
+    self codeAssertPeek: transition.
     self addOnLine: '] whileTrue: ['.
     self indent.
     self code: block.
@@ -162,8 +161,8 @@
     self add: '^ self returnPriority: ', priority asString, '.'
 !
 
-codeRecordMatch: state
-    self add: 'self recordMatch: ', state storeString, '.'
+codeRecordDistinctMatch: retval offset: value
+    self add: 'self recordDistinctMatch: ', retval storeString, ' offset: ', value storeString, '.'
 !
 
 codeRecordMatch: state priority: priority
@@ -191,21 +190,39 @@
     self indent.
 ! !
 
-!PPCFSACodeGen methodsFor:'helpers'!
+!PPCFSACodeGen methodsFor:'coding - results'!
+
+codeRecordDistinctMatch: retval
+    self add: 'self recordDistinctMatch: ', retval storeString, '.'
+!
+
+codeRecordFailure: index
+    self assert: index isInteger.
+    self add: 'self recordFailure: ', index asString, '.'
+!
 
-character: characterSet
-    self assert: (self isSingleCharacter: characterSet).
-    characterSet withIndexDo: [ :e :index | e ifTrue: [ ^ Character codePoint: index ] ].
-    
-    self error: 'should not happen'
+codeRecordMatch: retval
+    self add: 'self recordMatch: ', retval storeString, '.'
+!
+
+codeRecordMatch: retval offset: offset
+    self add: 'self recordMatch: ', retval storeString, ' offset: ', offset storeString, '.'
+!
+
+codeReturn
+    self addOnLine: '^ self'
+!
+
+codeReturnDistinct
+    self addOnLine: '^ self returnDistinct.'
 ! !
 
 !PPCFSACodeGen methodsFor:'intitialization'!
 
 initialize
     super initialize.
+    
+    compiler := PPCCodeGen new.
     backlinkStates := IdentityDictionary new.
-
-    "Modified: / 24-07-2015 / 15:03:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !