compiler/PPCFSACodeGen.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 17 Aug 2015 23:11:56 +0100
changeset 518 a6d8b93441b0
parent 515 b5316ef15274
child 524 f6f68d32de73
permissions -rw-r--r--
Portability fixes * do not use Object>>asString. Not all Smalltalks implement it. * do not use Object>>name. Not all Smalltalks implement it. * do not use Dictionary keysAndValuesRemove:. Not all Smalltalks implement it. * do not use Class>>methods The semantics is different among Smalltalks. Use `Class methodDictionary values` instead. * do not modify dictionary in #at:ifAbsentPut: block!

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

"{ NameSpace: Smalltalk }"

PPCCodeGen subclass:#PPCFSACodeGen
	instanceVariableNames:'fsa backlinkStates compiler'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Scanner'
!

!PPCFSACodeGen methodsFor:'accessing'!

methodCategory
    ^ 'generated - scanning'
! !

!PPCFSACodeGen methodsFor:'coding'!

codeAbsoluteReturn: code
    self add: '^ ', code
!

codeAssertPeek: t
    |   id  |
    self assert: (t isKindOf: PEGFsaTransition).

    (t isPredicateTransition and: [t isEOF]) ifTrue: [ 
        self addOnLine: 'currentChar isNil'.
        ^ self
    ].

    
    (t isPredicateTransition) ifTrue: [ 
        self addOnLine: t predicate asString, ' value: currentChar codePoint'.
        ^ self
    ].

    (t isAny) ifTrue: [ 
        self addOnLine: 'true'.
        ^ self
    ].

    
    (t isSingleCharacter) ifTrue: [ 
        self addOnLine: 'currentChar == ', t character storeString.
        ^ self
    ].

    (t isNotSingleCharacter) ifTrue: [ 
        self addOnLine: 'currentChar ~~ ', t notCharacter storeString.
        ^ self
    ].

    (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 := t beginOfRange.
        end := t endOfRange.
        self addOnLine: 'self peekBetween: ', begin asString, ' and: ', end asString.
        ^ self
    ].

    
    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: 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: t.
    self addOnLine: ') ifTrue: ['.
    self indent.
    self code: block.
    self dedent.
    self add: ']'.
!

codeAssertPeek: transition orReturn: priority
    self error: 'deprecated'.
    self add: '('.
    self codeAssertPeek: transition.
    self addOnLine: ') ifFalse: [ '.
    self codeReturnResult: priority.
    self addOnLine: ']'.
    self codeDot.
!

codeAssertPeek: transition whileTrue: block
    self add: '['.
    self codeAssertPeek: transition.
    self addOnLine: '] whileTrue: ['.
    self indent.
    self code: block.
    self dedent.
    self add: '].'.
    self nl.
!

codeEndBlock
    self dedent.	
    self add: ']'.
!

codeEndBlockWhileTrue
    self dedent.	
    self add: '] whileTrue.'.
!

codeIfFalse
    self addOnLine: ' ifFalse: ['.
!

codeNextChar
    self add: 'self step.'
!

codeNl
    self add: ''.
!

codeNlAssertPeek: characterSet
    self add: ''.
    self codeAssertPeek: characterSet.
!

codeNlReturnResult
    self add: '^ self return.'
!

codeNlReturnResult: priority
    priority isNil ifTrue: [ 
        ^ self codeNlReturnResult
    ].
    self add: '^ self returnPriority: ', priority asString, '.'
!

codeRecordDistinctMatch: retval offset: value
    self add: 'self recordDistinctMatch: ', retval storeString, ' offset: ', value storeString, '.'
!

codeRecordMatch: state priority: priority
    priority isNil ifTrue: [ 
        ^ self codeRecordMatch: state
    ].
    
    self add: 'self recordMatch: ', state storeString, ' priority: ', priority asString, '.'
!

codeReturnResult
    self addOnLine: '^ self return.'
!

codeReturnResult: priority
    priority isNil ifTrue: [ 
        ^ self codeReturnResult
    ].

    self addOnLine: '^ self returnPriority: ', priority asString, '.'
!

codeStartBlock
    self add: '['.
    self indent.
! !

!PPCFSACodeGen methodsFor:'coding - results'!

codeRecordDistinctMatch: retval
    self add: 'self recordDistinctMatch: ', retval storeString, '.'
!

codeRecordFailure: index
    self assert: index isInteger.
    self add: 'self recordFailure: ', index asString, '.'
!

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.
! !