"{ Encoding: utf8 }"

"{ Package: 'jv:libgdbs' }"

Object subclass:#GDBParser
	instanceVariableNames:'source lookahead token'
	classVariableNames:''
	poolDictionaries:'GDBCommandStatus'
	category:'GDB-Private'
!

!GDBParser class methodsFor:'instance creation'!

on: aStringOrStream
    ^ self new on: aStringOrStream

    "Created: / 27-05-2014 / 23:50:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'initialization'!

on: aStringOrStream
    source := aStringOrStream readStream

    "Created: / 27-05-2014 / 23:50:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing'!

parseCString
    | buffer inString nextChar |

    self expect: $".
    nextChar := self next.
    buffer := (String new: 50) writeStream.
    inString := true.
    [inString] whileTrue:[
	nextChar isNil ifTrue:[
	    self error: 'Unexpected end of input'.
	].
	nextChar == $\ ifTrue:[
	    nextChar := self next.
	    nextChar := self parseCStringEscape:nextChar.
	] ifFalse:[
	    (nextChar == $") ifTrue:[
		(self peekOrNil == $") ifTrue:[
		    self next
		] ifFalse:[
		    inString := false
		]
	    ].
	].
	inString ifTrue:[
	    buffer nextPut:nextChar.
	    nextChar := self next
	]
    ].
    ^ buffer contents

    "Created: / 27-05-2014 / 23:51:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseCStringEscape: char
    |ascii c |

    char == $" ifTrue:[
	^ $".
    ].

    char == $b ifTrue:[
	^ Character backspace
    ].
    char == $t ifTrue:[
	^ Character tab
    ].
    char == $n ifTrue:[
	^ Character cr
    ].
    char == $r ifTrue:[
	^ Character return
    ].
    char == $f ifTrue:[
	^ Character newPage
    ].

"/    char == $u ifTrue:[
"/        ascii := 0.
"/        c := source peekOrNil.
"/        4 timesRepeat:[
"/            (c isDigitRadix:16) ifFalse:[
"/                self syntaxError:'invalid hex character constant'
"/                        position:source position-2 to:(source position - 1).
"/                ^ Character value:ascii
"/            ].
"/            ascii := (ascii bitShift:4).
"/            ascii := ascii + c digitValue.
"/            source next. c := source peekOrNil.
"/        ].
"/        ^ Character value:ascii
"/    ].
    char == $x ifTrue:[
	ascii := 0.
	c := self peekOrNil.
	2 timesRepeat:[
	    (c isDigitRadix:16) ifFalse:[
		self error:'Invalid hex character escape'.
		^ Character value:ascii
	    ].
	    ascii := (ascii bitShift:4).
	    ascii := ascii + c digitValue.
	    self next. c := self peekOrNil.
	].
	^ Character value:ascii
    ].
    "OctalEscape ::= \ OctalDigit |
		     \ OctalDigit OctalDigit
		     \ ZeroToThree OctalDigit OctalDigit"

    (char between:$0 and:$3) ifTrue:[
	ascii := char digitValue.
	c := self peekOrNil.
	(c between: $0 and: $7) ifTrue:[
	    self next.
	    ascii := (ascii bitShift:3).
	    ascii := ascii + c digitValue.
	].
	c := self peekOrNil.
	(c between: $0 and: $7) ifTrue:[
	    self next.
	    ascii := (ascii bitShift:3).
	    ascii := ascii + c digitValue.
	].
	^ Character value:ascii
    ].
    (char between:$4 and: $7) ifTrue:[
	ascii := char digitValue.
	c := self peekOrNil.
	(c between: $0 and: $7) ifTrue:[
	    self next.
	    ascii := (ascii bitShift:3).
	    ascii := ascii + c digitValue.
	].
	^ Character value:ascii
    ].

    ^ char

    "Created: / 28-05-2014 / 00:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseNl
    | c |

    c := self peek.
    (c == Character return or:[ c == Character cr ]) ifTrue:[
	self next
    ].

    "Created: / 30-05-2014 / 09:52:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2014 / 00:38:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseOutput
    "
    output → ( out-of-band-record )* [ result-record ] '(gdb)' nl
    out-of-band-record → async-record | stream-record

    "

    | peek events |

    events := GDBEventSet new.

    peek := self peek.
    peek == Character space ifTrue:[ self next ].
    peek := self peek.
    peek == Character cr ifTrue:[ self next ].
    [
        peek := self peek.
        peek isNil ifTrue:[ 
            source atEnd ifTrue:[ ^ events ].
        ].
        peek isDigit ifTrue:[ self parseToken. peek := self peek ].
        peek ~~ $(
    ] whileTrue:[
        ('*+=' includes: self peek) ifTrue:[
            events add: self parseAsyncRecord.
        ] ifFalse:[
            ('~@&' includes: self peek) ifTrue:[
                events add: self parseStreamRecord.
            ] ifFalse:[
                peek == $^ ifTrue:[
                    events add: self parseResultRecord.
                ] ifFalse:[
                    self error:'Invalid MI record'.
                ].
            ].
        ].
        events last token: token.
    ].
    self expect: '(gdb)'.
    self parseNl.
    ^ events

    "Created: / 30-05-2014 / 09:52:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 04-06-2014 / 00:38:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseResultClass
    "
    result-class → 'done' | 'running' | 'connected' | 'error' | 'exit'
    "
    | c1 c2 |

    c1 := self peek.
    c1 == $d ifTrue:[
	self expect: 'done'.
	^ CommandStatusDone.
    ].
    c1 == $r ifTrue:[
	self expect: 'running'.
	^ CommandStatusDone.
    ].
    c1 == $c ifTrue:[
	self expect: 'connected'.
	^ CommandStatusConnected.
    ].
    c1 == $e ifTrue:[
	self next.
	c2 := self peek.
	c2 == $x ifTrue:[
	    self expect: 'xit'.
	    ^ CommandStatusExit.
	].
	c2 == $r ifTrue:[
	    self expect: 'rror'.
	    ^ CommandStatusError.
	].
    ].
    ^ self error:'Unsupported result class'

    "Created: / 31-05-2014 / 00:16:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-06-2014 / 23:21:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseResultRecord
    "
    result-record → '^' result-class ( ',' result )* nl
    "

    | result |

    self expect: $^.
    result := GDBCommandResult new.
    result status: self parseResultClass.
    self peek == $, ifTrue:[
        self next.
        result value: self parseResult.
    ].
    self parseNl.
    ^ GDBCommandResultEvent new result: result.

    "Created: / 30-05-2014 / 09:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-06-2014 / 22:22:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseToken
    token := 0.
    [ self peek isDigit ] whileTrue:[ 
        token := (token * 10) + (self next codePoint - $0 codePoint).
    ].

    "Created: / 28-05-2014 / 00:14:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-06-2014 / 00:49:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing-async events'!

parseAsyncRecord
    "
    async-record → exec-async-output | status-async-output | notify-async-output
    "
    self peek == $* ifTrue:[
        self next.
        ^ self parseAsyncRecord: GDBExecutionEvent.
    ].
    self peek == $+ ifTrue:[
        self next.
        ^ self parseAsyncRecord: GDBStatusEvent .
    ].
    self peek == $= ifTrue:[
        self next.
        ^ self parseAsyncRecord: GDBNotificationEvent.
    ].

    ^ self error: 'Invalid async-record'

    "Created: / 30-05-2014 / 09:57:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-06-2014 / 22:19:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseAsyncRecord: eventClassBase
    "
    async-output → async-class ( ',' result )* nl
    "

    | type eventClass data |

    type := self parseString.
    eventClass := eventClassBase eventClassForType: type.

    data := Array streamContents:[ :s |
        [ self peek == $, ] whileTrue:[
            self next.
            s nextPut: self parseResult.
        ]
    ].
    self parseNl.

    ^ eventClass new
        type: type;
        data: data;
        yourself

    "Created: / 01-06-2014 / 23:43:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 12-06-2014 / 17:07:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing-misc'!

parseResult
    "
    result → variable = value
    "

    | name value |

    name := self parseVariable.
    self expect: $=.
    value := self parseValue.
    ^ name -> value

    "Created: / 30-05-2014 / 10:15:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2014 / 00:39:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseString
    ^ String streamContents:[:s|
	[ self peek isLetter or:['-' includes: self peek ] ]  whileTrue:[
	    s nextPut: self next.
	]
    ].

    "Created: / 30-05-2014 / 10:32:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2014 / 00:33:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseVariable
    "
    variable → string
    "
    ^ self parseString

    "Created: / 30-05-2014 / 10:31:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing-stream output'!

parseStreamRecord
    "
    stream-record → console-stream-output | target-stream-output | log-stream-output
    "

    self peek == $~ ifTrue:[
        self next.
        ^ self parseStreamRecord: GDBConsoleOutputEvent.
    ].
    self peek == $@ ifTrue:[
        self next.
        ^ self parseStreamRecord: GDBTargetOutputEvent.
    ].
    self peek == $& ifTrue:[
        self next.
        ^ self parseStreamRecord: GDBLogOutputEvent.
    ].
    self error:'Invalid stream record'

    "Created: / 30-05-2014 / 09:57:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-06-2014 / 22:21:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseStreamRecord: eventClass
    | value |

    value := self parseCString.
    self parseNl.
    ^ eventClass new value: value; yourself

    "Created: / 01-06-2014 / 23:41:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing-utils'!

expect: aStringOrChar

    | c |
    aStringOrChar isCharacter ifTrue:[
	(self atEnd or:[(c := self next) ~= aStringOrChar]) ifTrue:[
	    self error:('Expected ''%1'' got ''%2''.' bindWith: aStringOrChar with: c).
	].
	^self.
    ].
    aStringOrChar isString ifTrue:[
	aStringOrChar do:[:expected|
	    (self atEnd or:[(c := self next) ~= expected]) ifTrue:[
		self error:('Expected ''%1''.' bindWith: aStringOrChar).
	    ].
	].
	^self.
    ].

    self error:'Invalid expected value'.

    "Created: / 19-11-2012 / 20:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-05-2014 / 00:17:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

expectLineEnd
    self expect: Character cr.

    "Created: / 19-11-2012 / 20:06:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

expectSpace
    self expect: Character space.

    "Created: / 19-11-2012 / 20:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'parsing-values'!

parseConst
    "
    const → c-string
    "

    ^ self parseCString.

    "Created: / 30-05-2014 / 10:36:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseList
    "
    list → '[]' | '[' value ( ',' value )* ']' | '[' result ( ',' result )* ']'
    "

    self expect: $[.
    self peek == $] ifTrue:[
	self next.
	^ #()
    ] ifFalse:[
	^ Array streamContents:[ :s|
	    s nextPut: self parseValue.
	    [ self peek == $, ] whileTrue:[
		self next.
		s nextPut: self parseValue.
	    ].
	    self expect: $].
	].
    ].

    "Created: / 30-05-2014 / 10:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseTuple
    "raise an error: this method should be implemented (TODO)"

    | object |

    object := GDBTuple new.
    self expect: ${.
    self peek == $} ifTrue:[
	self next.
    ] ifFalse:[
	| name value |

	name := self parseVariable.
	self expect: $=.
	value := self parseValue.
	object propertyAt: name put: value.
	[ self peek == $, ] whileTrue:[
	    self next.
	    name := self parseVariable.
	    self expect: $=.
	    value := self parseValue.
	    object propertyAt: name put: value.
	].
	self expect: $}.
    ].
    ^ object

    "Created: / 30-05-2014 / 10:36:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2014 / 00:35:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseValue
    "
    value → const | tuple | list
    "

    self peek == $" ifTrue:[
	^ self parseConst
    ].
    self peek == ${ ifTrue:[
	^ self parseTuple.
    ].
    self peek == $[ ifTrue:[
	^ self parseList
    ].
    self error:'Invalid value'

    "Created: / 30-05-2014 / 10:31:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBParser methodsFor:'streaming'!

atEnd
    ^ source atEnd

    "Created: / 28-05-2014 / 00:17:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

next
    | next |
    lookahead notNil ifTrue:[
	next := lookahead.
	lookahead := nil.
	^ next.
    ].
    ^ source next.

    "Created: / 23-10-2012 / 10:57:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-05-2014 / 00:23:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

nextLine
    lookahead := nil.
    ^source nextLine

    "Created: / 23-10-2012 / 11:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-05-2014 / 00:21:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

peek
    lookahead notNil ifTrue:[
	^ lookahead
    ].
    ^ lookahead := source next.

    "Created: / 28-05-2014 / 00:18:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

peekOrNil
    lookahead notNil ifTrue:[ ^ lookahead ].
    source atEnd ifTrue:[ ^ nil ].
    ^ self peek

    "Created: / 28-05-2014 / 00:15:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

skipSeparators
    lookahead := nil.
    source skipSeparators

    "Created: / 19-11-2012 / 20:05:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-05-2014 / 00:21:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !