1 "{ Package: 'stx:goodies/petitparser/compiler' }"

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 PPCCodeGenerator subclass:#PPCTokenizingCodeGenerator

     6 	instanceVariableNames:''

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Visitors'

    10 !

    11 

    12 !PPCTokenizingCodeGenerator methodsFor:'visiting'!

    13 

    14 visitLLChoiceNode: node

    15 	| dictionary currentTokenVar |

    16 	dictionary := IdentityDictionary new.

    17 	

    18 	node children do: [ :child |

    19 		| firstSet |

    20 		firstSet := child firstSetSuchThat: [ :e | e isKindOf: PPCTokenNode ].

    21 		self assert: firstSet size = 1.

    22 		dictionary at: child 

    23 			put: firstSet anyOne.

    24 			

    25 	].

    26 	"Tokens are unique"

    27 	self assert: dictionary values asSet size = node children size.

    28 	

    29 	compiler addConstant: (dictionary values collect: [ :e | compiler idFor: e ])

    30 				as: #tokenMethods.

    31 	

    32 	currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.

    33 	compiler codeAssign: 'self currentTokenType.' to: currentTokenVar.

    34 	node children do: [ :child |

    35 		| tokenMethodName |

    36 		tokenMethodName := compiler idFor: (dictionary at: child).

    37 		compiler add: currentTokenVar , ' = ',  tokenMethodName storeString.

    38 		compiler add: 'ifTrue: ['.

    39 		compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.

    40 		compiler codeReturn: self retvalVar.

    41 		compiler add: '].'

    42 	].

    43 

    44 	compiler codeError: 'no choice found'.

    45 !

    46 

    47 visitTokenConsumeNode: node

    48 	compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'

    49 !

    50 

    51 visitTokenNode: node

    52 	| tokenType |

    53 	self assert: node isMarkedForInline.

    54 

    55 	super visitTokenNode: node.

    56 	

    57 	tokenType := compiler idFor: node.

    58 

    59 	compiler codeAssign: tokenType storeString, '.' to: 'currentTokenType'.

    60 	compiler codeAssign: self retvalVar, '.' to: 'currentTokenValue'.

    61 ! !

    62