compiler/PEGFsaGenerator.st
changeset 515 b5316ef15274
parent 502 1e45d3c96ec5
child 518 a6d8b93441b0
child 524 f6f68d32de73
equal deleted inserted replaced
502:1e45d3c96ec5 515:b5316ef15274
     7 	classVariableNames:''
     7 	classVariableNames:''
     8 	poolDictionaries:''
     8 	poolDictionaries:''
     9 	category:'PetitCompiler-FSA'
     9 	category:'PetitCompiler-FSA'
    10 !
    10 !
    11 
    11 
    12 !PEGFsaGenerator methodsFor:'as yet unclassified'!
    12 !PEGFsaGenerator methodsFor:'hooks'!
       
    13 
       
    14 afterAccept: node retval: retval
       
    15     retval checkSanity.
       
    16     ^ super afterAccept: node retval: retval
       
    17 !
       
    18 
       
    19 cache: node value: retval
       
    20     (self assert: (retval isKindOf: PEGFsa)).
       
    21 
       
    22     (cache includesKey: node) ifTrue: [
       
    23         self assert: (retval isIsomorphicTo: (cache at: node)).
       
    24     ].
       
    25 
       
    26     "I put copy of the FSA because FSA can be modified (e.g. concatenated to other FSA)"
       
    27     cache at: node put: retval copy.
       
    28 !
       
    29 
       
    30 openDetected: node
       
    31     "
       
    32         This should be called when there is a recursive definition of a token.
       
    33         The forward node caches the fsa stub with startState in order to reference it
       
    34     "
       
    35     ^ (self cachedValue: node)
       
    36 ! !
       
    37 
       
    38 !PEGFsaGenerator methodsFor:'support'!
       
    39 
       
    40 connect: fsa with: anotherFsa
       
    41     | finals |
       
    42     finals := fsa finalStates reject: [:s | s isFsaFailure ].
       
    43 
       
    44     self assert: (finals allSatisfy: [ :s | s priority = 0 ]).
       
    45     self assert: (finals allSatisfy: [:f | fsa states includes: f]).
       
    46     
       
    47     finals do: [ :final |
       
    48         | toAdopt |
       
    49         toAdopt := anotherFsa.
       
    50         toAdopt decreasePriority.
       
    51         final final: false.	
       
    52 
       
    53         fsa adopt: toAdopt.
       
    54         fsa addTransitionFrom: final to: toAdopt startState.
       
    55     ].
       
    56 !
       
    57 
       
    58 connectOverlapping: fsa with: anotherFsa
       
    59     | finals |
       
    60     finals := fsa finalStates reject: [:s | s isFsaFailure ].
       
    61 
       
    62     self assert: (finals allSatisfy: [ :s | s priority = 0 ]).
       
    63     self assert: (finals allSatisfy: [:f | fsa states includes: f]).
       
    64     
       
    65     finals do: [ :final |
       
    66         | toAdopt |
       
    67         toAdopt := anotherFsa copy.
       
    68         toAdopt decreasePriority.
       
    69         final final: false.	
       
    70 
       
    71         fsa adopt: toAdopt.
       
    72         fsa addTransitionFrom: final to: toAdopt startState.
       
    73     ].
       
    74 !
       
    75 
       
    76 sequenceOf: fsa and: anotherFsa
       
    77     | newFsa start   |
       
    78 
       
    79     newFsa := PEGFsa new.
       
    80     start := PEGFsaState new name: 'start'; yourself.
       
    81     newFsa addState: start.
       
    82     newFsa startState: start.
       
    83     newFsa adopt: fsa.
       
    84     newFsa addTransitionFrom: start to: fsa startState.
       
    85 
       
    86     (newFsa finalStates size == 1) ifTrue: [  
       
    87         self connect: newFsa with: anotherFsa.
       
    88     ] ifFalse: [ 
       
    89     (newFsa finalStates allSatisfy: [ :s | s transitions isEmpty ]) ifTrue: [  
       
    90         self connect: newFsa with: anotherFsa.
       
    91     ] ifFalse: [ 
       
    92         self connectOverlapping: newFsa with: anotherFsa.
       
    93     ]].
       
    94     
       
    95     newFsa determinize.
       
    96     ^ newFsa
       
    97 ! !
       
    98 
       
    99 !PEGFsaGenerator methodsFor:'visiting'!
       
   100 
       
   101 visitAnyNode: node
       
   102     | stop start fsa classification |
       
   103     start := PEGFsaState new.
       
   104     stop := PEGFsaState new.
       
   105     
       
   106     classification := Array new: 255 withAll: true.
       
   107     
       
   108     fsa := PEGFsa new
       
   109         addState: start;
       
   110         addState: stop;
       
   111         
       
   112         startState: start;
       
   113         finalState: stop;
       
   114         yourself.
       
   115     
       
   116     fsa addTransitionFrom: start to: stop onCharacterSet: (classification).
       
   117     
       
   118     ^ fsa
       
   119 !
    13 
   120 
    14 visitCharSetPredicateNode: node
   121 visitCharSetPredicateNode: node
    15     | stop start fsa |
   122     | stop start fsa |
    16     start := PEGFsaState new.
   123     start := PEGFsaState new.
    17     stop := PEGFsaState new.
   124     stop := PEGFsaState new.
    46         yourself
   153         yourself
    47 !
   154 !
    48 
   155 
    49 visitChoiceNode: node
   156 visitChoiceNode: node
    50     | priority childrenFsa fsa start |
   157     | priority childrenFsa fsa start |
    51     
       
    52     childrenFsa := node children collect: [ :child | child accept: self ].
   158     childrenFsa := node children collect: [ :child | child accept: self ].
       
   159     self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic  ]).
       
   160 
    53     fsa := PEGFsa new.
   161     fsa := PEGFsa new.
    54     start := PEGFsaState new.
   162     start := PEGFsaState new.
    55     
   163     
    56     fsa addState: start.
   164     fsa addState: start.
    57     fsa startState: start.
   165     fsa startState: start.
    58 
   166 
    59     priority := 0.
   167     priority := 0.
    60     childrenFsa do: [ :childFsa |
   168     childrenFsa do: [ :childFsa |
       
   169         childFsa decreasePriorityBy: priority.
    61         fsa adopt: childFsa.
   170         fsa adopt: childFsa.
    62         fsa addTransitionFrom: start to: childFsa startState priority: priority.
   171         fsa addTransitionFrom: start to: childFsa startState.
    63         priority := priority + childFsa minPriority.
   172         priority := priority + 1.
    64     ].
   173         
    65 
   174         fsa determinizeChoice.
       
   175     ].
       
   176 
       
   177     ^ fsa
       
   178 !
       
   179 
       
   180 visitEndOfFileNode: node
       
   181     | stop start fsa transition |
       
   182     start := PEGFsaState new.
       
   183     stop := PEGFsaState new.
       
   184     stop name: 'EOF'.
       
   185     
       
   186     fsa := PEGFsa new
       
   187         addState: start;
       
   188         addState: stop;
       
   189         
       
   190         startState: start;
       
   191         finalState: stop;
       
   192 
       
   193         yourself.
       
   194         
       
   195     transition := PEGFsaEOFTransition new
       
   196         predicate: [ :cp | cp == 0 ];
       
   197         destination: stop;
       
   198         yourself.
       
   199         
       
   200     start addTransition: transition.
       
   201     ^ fsa
       
   202 !
       
   203 
       
   204 visitForwardNode: node
       
   205     | fsa childFsa startState startStubState |
       
   206 
       
   207     fsa	 := PEGFsa new.
       
   208     startStubState := PEGFsaUncopiableState new.
       
   209     startState := PEGFsaState new.
       
   210 
       
   211     fsa addState: startStubState.
       
   212     fsa startState: startStubState.
       
   213 
       
   214 
       
   215     "  cache the incomplete fsa in order to allow for
       
   216         recursive back references... 
       
   217     "	
       
   218     self cache: node value: fsa.
       
   219 
       
   220     childFsa := self visit: node child.
       
   221     
       
   222     cache removeKey: node.
       
   223     
       
   224     fsa adopt: childFsa.
       
   225     fsa replace: startStubState with: startState.
       
   226 
       
   227 
       
   228     fsa addTransitionFrom: startState to: childFsa startState.
       
   229     fsa startState: startState.
       
   230 
       
   231     fsa name: self name.
    66     ^ fsa
   232     ^ fsa
    67 !
   233 !
    68 
   234 
    69 visitLiteralNode: node
   235 visitLiteralNode: node
    70     | states fsa |
   236     | states fsa |
    90 
   256 
    91     fsa name: node literal.
   257     fsa name: node literal.
    92     ^ fsa
   258     ^ fsa
    93 !
   259 !
    94 
   260 
       
   261 visitMessagePredicateNode: node
       
   262     ^ self visitPredicateNode: node
       
   263 !
       
   264 
    95 visitNode: node
   265 visitNode: node
    96     self error: 'node not supported'
   266     self error: 'node not supported'
       
   267 !
       
   268 
       
   269 visitNotCharacterNode: node
       
   270     self assert: (node child isKindOf: PPCCharacterNode).
       
   271     
       
   272     ^ self visitNotNode: node
    97 !
   273 !
    98 
   274 
    99 visitNotNode: node
   275 visitNotNode: node
   100     | fsa finalState |
   276     | fsa finalState |
   101     fsa := node child accept: self.
   277     fsa := node child accept: self.
   102     finalState := PEGFsaState new
   278     finalState := PEGFsaState new
   103         name: '!!', fsa name asString;
   279         name: '!!', fsa name asString;
   104         yourself.
   280         yourself.
   105     
   281     
   106     fsa finalStates do: [ :fs |
   282     fsa finalStates do: [ :fs |
   107         fs retval: PEGFsaFailure new.
   283         fs failure: true.
   108     ].
   284     ].
   109     
   285     
   110     fsa addState: finalState.
   286     fsa finalState: fsa startState.
   111     fsa finalState: finalState.
   287     
   112 
       
   113     fsa addTransitionFrom: fsa startState to: finalState priority: -1.
       
   114     ^ fsa
   288     ^ fsa
   115 !
   289 !
   116 
   290 
   117 visitOptionalNode: node
   291 visitOptionalNode: node
   118     | fsa startState finalState |
   292     | fsa   |
   119 
   293 
   120     fsa := node child accept: self.
   294     fsa := node child accept: self.
   121     startState := PEGFsaState new
   295     fsa finalState: fsa startState.
   122         yourself.
       
   123 
       
   124     finalState := PEGFsaState new
       
   125         final: true;
       
   126         yourself.
       
   127 
       
   128     fsa addState: startState.
       
   129     fsa addState: finalState.
       
   130     
       
   131     fsa addTransitionFrom: startState to: fsa startState priority: 0.
       
   132     fsa addTransitionFrom: startState to: finalState priority: fsa minPriority.
       
   133 
       
   134     fsa startState: startState.
       
   135 
   296 
   136     ^ fsa
   297     ^ fsa
   137 !
   298 !
   138 
   299 
   139 visitPlusNode: node
   300 visitPlusNode: node
   140     | fsa finalState |
   301     | fsa |
   141 
   302 
   142     finalState := PEGFsaState new.
   303 "	finalState := PEGFsaState new."
   143     fsa := node child accept: self.
   304     fsa := node child accept: self.
   144     fsa addState: finalState.
   305 "	fsa addState: finalState."
   145     
   306     
   146     fsa finalStates do: [ :state |
   307     fsa finalStates do: [ :state |
   147         fsa addTransitionFrom: state to: (fsa startState).
   308         fsa addTransitionFrom: state to: (fsa startState).
   148         fsa addTransitionFrom: state to: finalState priority: -1.
   309 "		fsa addTransitionFrom: state to: finalState priority: fsa minPriority."
   149         self assert: (state hasPriority not).
   310 "		state hasPriority ifFalse: [ state priority: 0 ].
   150         state priority: 0.
       
   151         state final: false.
   311         state final: false.
   152     ].
   312 "	].
   153 
   313 
   154     fsa finalState: finalState.	
   314 "	fsa finalState: finalState.	"
   155     
   315     
   156     ^ fsa
   316     ^ fsa
   157 !
   317 !
   158 
   318 
   159 visitPredicateNode: node
   319 visitPredicateNode: node
   160     | stop start fsa  |
   320     | stop start fsa classification |
   161     start := PEGFsaState new.
   321     start := PEGFsaState new.
   162     stop := PEGFsaState new.
   322     stop := PEGFsaState new.
       
   323     
       
   324     classification := (1 to: 255) collect: [:codePoint | node predicate value: (Character codePoint: codePoint) ].
   163     
   325     
   164     fsa := PEGFsa new
   326     fsa := PEGFsa new
   165         addState: start;
   327         addState: start;
   166         addState: stop;
   328         addState: stop;
   167         
   329         
   168         startState: start;
   330         startState: start;
   169         finalState: stop;
   331         finalState: stop;
   170         yourself.
   332         yourself.
   171     
   333     
   172     fsa addTransitionFrom: start to: stop onCharacterSet: (node predicate classification).
   334     fsa addTransitionFrom: start to: stop onCharacterSet: (classification).
   173         
   335     
   174     ^ fsa
   336     ^ fsa
   175 !
   337 !
   176 
   338 
   177 visitSequenceNode: node
   339 visitSequenceNode: node
   178     | childrenFsa fsa start previousFinalStates  |
   340     | fsa childrenFsa previousFsa  |
   179 
   341     childrenFsa := node children collect: [ :child | self visit: child ].
   180     childrenFsa := node children collect: [ :child | child accept: self ].
   342     self assert: (childrenFsa allSatisfy: [ :child | child isDeterministic  ]).
   181 
   343 
   182     fsa := PEGFsa new.
   344     previousFsa := childrenFsa first.
   183     start := PEGFsaState new name: 'start'; yourself.
   345     childrenFsa allButFirst do: [ :nextFsa | 
   184     fsa addState: start.
   346         fsa := self sequenceOf: previousFsa and: nextFsa.
   185     fsa startState: start.
   347         previousFsa := fsa.
   186 
   348     ].
   187     fsa adopt: childrenFsa first.	
   349     
   188     fsa addTransitionFrom: start to: childrenFsa first startState.
       
   189 
       
   190     previousFinalStates := childrenFsa first finalStates.
       
   191     childrenFsa allButFirst do: [ :childFsa | 
       
   192         | newFinalStates |
       
   193         newFinalStates := IdentitySet new.
       
   194         previousFinalStates do: [ :state |
       
   195             | copy |
       
   196             copy := childFsa copy.
       
   197             fsa adopt: copy.
       
   198             
       
   199             state isFailure ifFalse: [ 
       
   200                 state final: false.
       
   201                 fsa addTransitionFrom: state to: copy startState.
       
   202             ].
       
   203             newFinalStates addAll: copy finalStates.
       
   204         ].
       
   205         previousFinalStates := newFinalStates.
       
   206     ].
       
   207     ^ fsa
   350     ^ fsa
   208 !
   351 !
   209 
   352 
   210 visitStarNode: node
   353 visitStarNode: node
   211     | fsa finalState |
   354     | fsa  |
   212 
   355 
   213     finalState := PEGFsaState new.
   356 "	finalState := PEGFsaState new.
   214     fsa := node child accept: self.
   357 "	fsa := node child accept: self.
   215     fsa addState: finalState.
   358 "	fsa addState: finalState.
   216     
   359 "	
   217     fsa finalStates do: [ :state |
   360     fsa finalStates do: [ :state |
   218         fsa addTransitionFrom: state to: (fsa startState).
   361         fsa addTransitionFrom: state to: (fsa startState).
   219         self assert: (state hasPriority not).
   362 "		state hasPriority ifFalse: [ state priority: 0 ].
   220         state priority: 0.
       
   221         state final: false.
   363         state final: false.
   222     ].
   364 "	].
   223 
   365 
   224     fsa addTransitionFrom: fsa startState to: finalState priority: -1.
   366 "	fsa addTransitionFrom: fsa startState to: finalState priority: -1."	
   225     fsa finalState: finalState.
   367     fsa finalState: fsa startState.
   226 
   368 
   227     ^ fsa
   369     ^ fsa
       
   370 !
       
   371 
       
   372 visitTokenNode: node
       
   373     ^ self visit: node child
       
   374 !
       
   375 
       
   376 visitTrimmingTokenCharacterNode: node
       
   377     "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"
       
   378     ^ self visit: node child
       
   379 !
       
   380 
       
   381 visitTrimmingTokenNode: node
       
   382     "I do not care about trimming (so far), it should be handled by TokenCodeGenerator"
       
   383     ^ self visit: node child
   228 ! !
   384 ! !
   229 
   385