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

"{ NameSpace: Smalltalk }"

PPCompositeParser subclass:#PPCLRPParser_johanfabry_39

	instanceVariableNames:'program variable block bra ket identifier machine body event

		transition epsilon wildcard state onentry running onexit comment

		lineTerminator statebody spawn integer errorNode success failed

		lastError styler timeoutIdentifier timeoutInteger endOfComment

		error'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Benchmarks-Core'

!

!PPCLRPParser_johanfabry_39 class methodsFor:'accessing'!

ignoredNames

    ^super ignoredNames , #(styler failed lastError)

! !

!PPCLRPParser_johanfabry_39 methodsFor:'accessing'!

error

    ^error

    "Modified (format): / 18-08-2015 / 16:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

failed

    ^failed

!

lastError

    ^lastError

!

start

    ^program end

!

styler

    ^styler ifNil:[styler := PPCLRPRubricStyler new]

!

styler: aSHStyler

    styler := aSHStyler.

!

success

    ^success

! !

!PPCLRPParser_johanfabry_39 methodsFor:'block creation'!

createSTBlockFrom: aBlockNode withVariables: aDictionary

    |compiled retval keys|

    keys := OrderedCollection new: aDictionary size.

    aDictionary associations do: [:asoc|

        keys add: asoc key.

    ].

    compiled := (self methodizeBlock: aBlockNode withArguments: keys) compiledMethod.

    retval := compiled valueWithReceiver: Object new arguments: {aDictionary}.

    ^retval.

!

methodizeBlock: parsedBlock withArguments: anArray

    |method retval inspoint|

    method := 'captureV: PPCLRPScopeVariables'.

    retval := PPSmalltalkParser new method parse: method , '^[1]'.

    inspoint := retval body statements first.

    parsedBlock scope: inspoint value scope.

    parsedBlock parent: inspoint.

    inspoint value: parsedBlock.

    retval source: retval asString.

    anArray do: [:aVarName|

        retval := retval rewriteLRPVarNamedWrite: aVarName.

        retval := retval rewriteLRPVarNamedRead: aVarName.

    ].

    ^retval

! !

!PPCLRPParser_johanfabry_39 methodsFor:'error handing'!

failWithValue: anObject

    failed := true.

    lastError := anObject.

! !

!PPCLRPParser_johanfabry_39 methodsFor:'grammar'!

body

    ^(variable / event / state / transition / timeoutIdentifier / timeoutInteger / epsilon / wildcard / comment / errorNode) star

!

errorNode

    ^(bra,  (bra/ket)negate star , ket) token

        ==> [ :token |  

                PPCLRPErrorNode new start: token start stop: token stop; yourself.

            ]

!

event

    ^ (bra, 'event' asParser trim, identifier, block,  ket) token 

        ==> [:token | | ident |

                ident := (token parsedValue at: 3).

                (LRPEvent named: ident parsedValue

                     trigger: (token parsedValue at: 4))

                start: token start stop: token stop;

                nameRange: (ident start to: ident stop);

                yourself.

            ]

!

integer 

    ^(#digit asParser) plus flatten trim token

!

machine

    ^(bra , 'machine' asParser trim , identifier , body , ket) token

        ==> [:token | | ident bod stop |

                ident := (token parsedValue at: 3).

                bod := (token parsedValue at: 4).

                bod isEmpty

                    ifTrue: [ stop := token stop - 1 ]

                 	ifFalse: [ stop := (bod at: 1) start - 1 ].

                (LRPMachine name: ident parsedValue body: bod)

                    start: token start stop: token stop;

                    nameRange: (ident start to: stop);

                    yourself.

            ]

!

onentry

    ^ (bra, 'onentry' asParser trim, (block/spawn) ,  ket ) token

        ==> [:token | 

                (LRPOnEntry block: (token parsedValue at: 3))

                start: token start stop: token stop;

                keywordEnd: (token parsedValue at: 3) start -1;

                yourself.

            ]

!

onexit

    ^ (bra, 'onexit' asParser trim, (block/spawn),  ket) token 

        ==> [:token | 

                (LRPOnExit block: (token parsedValue at: 3))

                start: token start stop: token stop;

                keywordEnd: (token parsedValue at: 3) start -1;

                yourself.

            ]

!

program

    ^ (variable / machine / comment / spawn / errorNode) star

!

running

    ^ (bra, 'running' asParser trim, (block/spawn),  ket) token 

        ==> [:token | 

                (LRPRunning block: (token parsedValue at: 3))

                start: token start stop: token stop;

                keywordEnd: (token parsedValue at: 3) start -1;

                yourself.

            ]

!

spawn

    ^(bra , 'spawn' asParser trim , identifier , identifier , ket) token

        ==> [ :token |  

                (LRPSpawn

                    machine: (token parsedValue at: 3) parsedValue

                    state: (token parsedValue at: 4) parsedValue)

                start: token start stop: token stop;

                nameRange: ((token parsedValue at: 3) start to: (token parsedValue at: 4) stop)

                yourself.

            ]

!

state

    ^(bra , 'state' asParser trim , identifier , statebody , ket) token

        ==> [ :token | | ident |

                ident := (token parsedValue at: 3).

                (LRPState name: ident parsedValue

                    body: (token parsedValue at: 4))

                start: token start stop: token stop;

                nameRange: (ident start to: ident stop);

                yourself.

            ]

!

statebody

    ^(onentry / running / onexit / machine / comment / errorNode) star

!

variable

    ^ (bra , 'var' asParser trim , identifier , ':=' asParser trim , block , ket) token 

        ==> [ :token | |ident|

            ident := (token parsedValue at: 3).

            (LRPVariable name: ident parsedValue

                value: (token parsedValue at: 5))

            start: token start stop: token stop;

            nameRange: (ident start to: ident stop);

            yourself.

        ]

! !

!PPCLRPParser_johanfabry_39 methodsFor:'grammar-comments'!

comment

    ^ ((PPPredicateObjectParser blank / lineTerminator) star,  ( $; asParser , (endOfComment negate star) flatten,  endOfComment)) token

    ==> [ :token |  |text|

            text := token parsedValue at: 2.

                (LRPComment text: (text copyFrom: 2 to: text size -1))

                start: token start stop: token stop;

                yourself.

        ]

!

endOfComment

    ^ #eof asParser / lineTerminator

!

lineTerminator

    ^ (Character lf asParser) / (Character cr asParser , (Character lf asParser ) optional )

! !

!PPCLRPParser_johanfabry_39 methodsFor:'grammar-common'!

block

    ^PPSmalltalkParser new block

!

bra

    ^ $( asParser trim

!

identifier 

    ^(#letter asParser ,(#letter asParser / #digit asParser /  $_ asParser) star)  flatten trim token

!

ket

    ^ $) asParser trim

! !

!PPCLRPParser_johanfabry_39 methodsFor:'grammar-transitions'!

epsilon

    ^ (bra, 'eps' asParser trim, identifier, '->' asParser trim, identifier,  identifier optional, ket) token

        ==> [ :token |  | trans name |

                name := (token parsedValue at: 6).

                name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ].

                trans := 

                    (LRPEpsilonTransition

                        from: (token parsedValue at: 3) parsedValue

                        to: (token parsedValue at: 5) parsedValue

                        name: name).

                self setTransitionRangesIn: trans for: token withArrowAt: 3. 

                trans

        ]

!

timeoutIdentifier

    ^ (bra, 'ontime' asParser trim, identifier , identifier, '->' asParser trim, identifier,  identifier optional, ket) token

        ==> (self transitionActionHandlerFor: PPCLRPTimeoutTransition).

!

timeoutInteger

    ^ (bra, 'ontime' asParser trim,  integer, identifier, '->' asParser trim, identifier,  identifier optional, ket) token

        ==> [ :token | | trans name |

        name := (token parsedValue at: 7).

        name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ].

        trans :=

            (LRPTimeoutTransition

                on: (Integer readFrom: (token parsedValue at: 3) parsedValue)

                from: (token parsedValue at: 4) parsedValue

                to: (token parsedValue at: 6) parsedValue

                name: name).

        self setTransitionRangesIn: trans for: token withArrowAt: 4.

        trans.

    ]

!

transition

    ^ (bra, 'on' asParser trim, identifier, identifier, '->' asParser trim, identifier,  identifier optional , ket) token

        ==> (self transitionActionHandlerFor: PPCLRPTransition).

!

wildcard

    ^ (bra, 'on' asParser trim, identifier,  '*->' asParser trim, identifier,  identifier optional, ket) token

        ==> [ :token |  | trans name |

                name := (token parsedValue at: 6).

                name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ].

                trans :=

                    (LRPWildcardTransition

                        on: (token parsedValue at: 3) parsedValue

                        to: (token parsedValue at: 5) parsedValue

                        name: name ).

                self setTransitionRangesIn: trans for: token withArrowAt: 3. 

                trans

            ]

! !

!PPCLRPParser_johanfabry_39 methodsFor:'parsing'!

parse: aString

    |parsedProgram |

    failed := false.

    parsedProgram := super parse: aString.

    parsedProgram isPetitFailure ifTrue:[

        parsedProgram := 

            {LRPErrorNode new 

                start: 1;

                stop: aString size; 

                yourself.

            }

    ].

    "visit pattern?"

    parsedProgram do:[:aNode|

        (aNode onErrorNode: [:anErrorNode| ] parser: self)

    ].

    ^parsedProgram.

!

parse: aString onError: aBlock

    |parsedProgram|

    parsedProgram := self parse: aString.

    failed ifTrue:[

        "visit pattern?"

        parsedProgram do:[:aNode|

            (aNode onErrorNode: aBlock parser: self)

        ].

    ].

    ^parsedProgram.

!

parse: aText styleOn: aViewOrMorph

    |parsedProgram|

    parsedProgram := self parse: aText.

    self styler view: aViewOrMorph; parser: self; nodes: parsedProgram; style: aText.

    ^parsedProgram.

! !

!PPCLRPParser_johanfabry_39 methodsFor:'transitions'!

setTransitionRangesIn: aTransition for: aToken withArrowAt: index

    | ident |

    ident := (aToken parsedValue at: index + 3).

    ident

        ifNil: [ aTransition nameRange: (1 to: 1) ]

        ifNotNil: [ aTransition nameRange: (ident start to: ident stop) ].

    aTransition

        start: aToken start stop: aToken stop;

        arrowRange:

                    ((aToken parsedValue at: index) stop + 1

                        to: (aToken parsedValue at: index + 2) start -1);

        keywordEnd: (aToken parsedValue at: 3) start -1

!

transitionActionHandlerFor: aTransitionClass

    ^[ :token | | trans name|

        name := (token parsedValue at: 7).

        name ifNil: [name := '' ] ifNotNil: [ name := name parsedValue ].

        trans :=

            (aTransitionClass

                on: (token parsedValue at: 3) parsedValue

                from: (token parsedValue at: 4) parsedValue

                to: (token parsedValue at: 6) parsedValue

                name: name).

        self setTransitionRangesIn: trans for: token withArrowAt: 4.

        trans.

    ]

! !