
Object subclass: #Parser
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''   !


!Parser class methods !
  
then: aParserClass
    ^ SequentialParser  first: self new then: aParserClass new!
 
then: aParserClass then: another
    ^ (self then: aParserClass) then: another!

then: aParserClass then: another then: aThird
    ^ ((self then: aParserClass) then: another) then: aThird!

then: aParserClass then: another then: aThird then: aFourth
    ^ (((self then: aParserClass) then: another) then: aThird) then: aFourth!
  
| aParserClass
    ^ AlternativeParser  either: self new or: aParserClass new! !



!Parser methods !
  
example
    "an example of using the parser framework, lame, but hey, it's a test at least..."
    | myParser |
    myParser := IF then: IdentifierParser then: EOFParser.
    myParser parse: (TokenStreamOverIndexedCollection
                                     on: (Array with: (KeywordToken new: 'if') with: (IdentifierToken new: 'test')))
            ifFail: [ :ts | ^ self error: 'parser error'].
    ^ myParser remainingInput atEnd.!
   
parse: aTokenStream ifFail: aBlock
    "modifies: self
     effect: either parse part of aTokenStream and set remaining to  the unconsumed input,
                or send the tokenStream to aBlock with the value: message"
    self implementedBySubclass!

remainingInput
      "ensures: result is the rest of the token stream, not consumed during parsing"
    self implementedBySubclass!
   
then: aParser
    "ensures: result is a parser that can parse by self followed by aParser"
    | p |
    p := aParser.
    (aParser isKindOf: Parser class)
        ifTrue: [ p := aParser new ].
    ^SequentialParser first: self then: p!
  
then: aParser then: another
    ^(self then: aParser) then: another!
   
then: aParser then: another then: yetAnother
    ^((self then: aParser) then: another) then: yetAnother!
   
then: aParser then: another then: yetAnother  then: andSoOn
    ^(((self then: aParser) then: another) then: yetAnother) then: andSoOn!

then: aParser then: another then: yetAnother  then: andSoOn  then: well
    ^((((self then: aParser) then: another) then: yetAnother) then: andSoOn) then: well!
   
then: aParser then: another then: yetAnother  then: andSoOn  then: well then: youGetTheIdea
    ^(((((self then: aParser) then: another) then: yetAnother) then: andSoOn) then: well) then: youGetTheIdea!
 
| aParser
    "ensures: result is a parser that can parse by self and if that fails, by aParser"
    | p |
    p := aParser.
    (aParser isKindOf: Parser class)
        ifTrue: [ p := aParser new ].
    ^AlternativeParser either: self or: p! !

Parser subclass: #AlternativeParser
  instanceVariableNames: 
    'p1 p2 successfulParser '
  classVariableNames: ''
  poolDictionaries: ''   !


!AlternativeParser class methods !
   
either: p1 or: p2
    "ensures: result is an instance of AlternativeParser that can parse by either p1 or p2"
    ^ self new either: p1 or: p2! !



!AlternativeParser methods !
 
either: parser1 or: parser2
    "private"
    p1 := parser1.
    p2 := parser2!
  
parse: aTokenStream ifFail: aBlock
    "perhaps this needs to copy the tokenstream, if lookahead doesn't determine what to do..."
    successfulParser := p1.
    ^p1 parse: aTokenStream ifFail: [
         successfulParser := p2.
        ^p2 parse:  aTokenStream ifFail: [
            successfulParser := nil.
            aBlock value: aTokenStream]]!
   
remainingInput
    ^successfulParser remainingInput! !

Parser subclass: #EOFParser
  instanceVariableNames: 
    'remaining '
  classVariableNames: ''
  poolDictionaries: ''   !


!EOFParser class methods ! !



!EOFParser methods !
 
parse: aTokenStream ifFail: aBlock
    (aTokenStream atEnd)
        ifFalse: [aBlock value: aTokenStream].
    remaining := aTokenStream!

remainingInput
    ^ remaining! !

Parser subclass: #IdentifierParser
  instanceVariableNames: 
    'result remaining '
  classVariableNames: ''
  poolDictionaries: ''  !


!IdentifierParser class methods ! !



!IdentifierParser methods !
   
parse: aTokenStream ifFail: aBlock
    | aToken |
    (aTokenStream atEnd)
        ifTrue:  [
            aBlock value: aTokenStream]
        ifFalse: [
            aToken := aTokenStream peek.
            (aToken isKindOf: IdentifierToken)
                ifFalse: [aBlock value: aTokenStream]
                ifTrue: [result := aToken text.
                             aTokenStream advance.
                             remaining := aTokenStream]]!
  
remainingInput
    ^remaining!
 
result
    ^result! !

Parser subclass: #KeywordParser
  instanceVariableNames: 
    'remaining '
  classVariableNames: ''
  poolDictionaries: '' !


!KeywordParser class methods ! !



!KeywordParser methods !
   
expected
    ^self implementedBySubclass!
  
parse: aTokenStream ifFail: aBlock
    | aToken |
    (aTokenStream atEnd)
        ifTrue:  [
            aBlock value: aTokenStream]
        ifFalse: [
            aToken := aTokenStream peek.
            ((aToken isKindOf: KeywordToken) and: [aToken text = self expected])
                ifFalse: [aBlock value: aTokenStream]
                ifTrue: [aTokenStream advance.
                             remaining := aTokenStream]]!
 
remainingInput
    ^remaining!
 
result
    ^self expected! !

KeywordParser subclass: #IF
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''  !


!IF class methods ! !



!IF methods !
   
expected
    ^ 'if'! !

Parser subclass: #SequentialParser
  instanceVariableNames: 
    'p1 p2 '
  classVariableNames: ''
  poolDictionaries: ''    !


!SequentialParser class methods !

first: p1 then: p2
    "ensures: result is an instance of SequentialParser that first parses by p1,
                    then uses p2 on the remaining input."
    ^ self new first: p1 then: p2! !



!SequentialParser methods !

first: parser1 then: parser2
    "private"
    p1 := parser1.
    p2 := parser2!
 
parse: aTokenStream ifFail: aBlock
    p1 parse: aTokenStream ifFail: aBlock.
    ^p2 parse: (p1 remainingInput) ifFail: aBlock.!
 
remainingInput
    ^p2 remainingInput! !
