SystemOrganization addCategory: #'PetitRegex-Core'!

PPCompositeParser subclass: #PPRegexParser
	instanceVariableNames: 'regex atom anyAtom beginOfLineAtom endOfLineAtom characterAtom rangePieceSpec number groupAtom escapeAtom characterGroup'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PetitRegex-Core'!

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/7/2010 23:28'!
anyAtom
	^ $. asParser map: [ :char | #any asParser ]! !

!PPRegexParser methodsFor: 'grammar' stamp: 'lr 2/8/2010 00:18'!
atom
	^ escapeAtom / anyAtom / beginOfLineAtom / endOfLineAtom / characterGroup / groupAtom / characterAtom! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/7/2010 23:28'!
beginOfLineAtom
	^ $^ asParser map: [ :char | [ :stream | stream position or: [ (stream skip: -1; next) = Character cr ] ] asParser ]! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 00:16'!
characterAtom
	^ $) asParser negate map: [ :char | char asParser ]! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 00:29'!
characterGroup
	^ $[ asParser , $^ asParser optional , [ :stream |
			| set |
			set := OrderedCollection new.
			[ stream atEnd or: [ stream peek = $] ] ] whileFalse: [
				(stream peek = $- and: [ set notEmpty ])
					ifTrue: [ set addAll: (set removeLast to: (stream next; next)) ]
					ifFalse: [ set add: stream next ] ].
			set ] asParser , $] asParser map: [ :open :negate :set :close |
				negate isNil
					ifTrue: [ (PPPredicateParser anyOf: set asSet)  ]
					ifFalse: [ (PPPredicateParser anyOf: set asSet) negate ] ]! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/7/2010 23:28'!
endOfLineAtom
	^ $$ asParser map: [ :char | [ :stream | stream atEnd or: [ stream peek = Character cr ] ] asParser ]! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 00:13'!
escapeAtom
	^ $\ asParser , #any asParser map: [ :escape :char | char asParser ]! !

!PPRegexParser methodsFor: 'grammar-atoms' stamp: 'lr 2/8/2010 00:11'!
groupAtom
	^ $( asParser , regex , $) asParser ==> #second! !

!PPRegexParser methodsFor: 'other' stamp: 'lr 2/8/2010 00:07'!
number
	^ #digit asParser plus flatten ==> [ :token | token asInteger ]! !

!PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 2/8/2010 00:09'!
oneOrMorePiece
	"+	1 or more times"
	
	^ $+ asParser map: [ :op | PPRepeatingParser on: nil min: 1 ]! !

!PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 2/8/2010 00:08'!
rangePiece
	^ ${ asParser , rangePieceSpec ,  $} asParser ==> #second! !

!PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 2/8/2010 00:05'!
rangePieceSpec
	"{n,m}	at least n but not more than m times
	{n,}	at least n times
	{n}	exactly n times"
	
	^ (number , $, asParser , number map: [ :n :op :m | PPRepeatingParser on: nil min: n max: m ])
	/ (number , $, asParser map: [ :n :op | PPRepeatingParser on: nil min: n ])
	/ (number map: [ :n  | PPRepeatingParser on: nil min: n max: n ])! !

!PPRegexParser methodsFor: 'grammar' stamp: 'lr 2/8/2010 00:07'!
regex
	^ PPExpressionParser new
		term: atom;
		group: [ :g |.
			g postfix: self zeroOrOnePiece do: [ :atom :op | op setParser: atom ].
			g postfix: self zeroOrMorePiece do: [ :atom :op | op setParser: atom ].
			g postfix: self oneOrMorePiece do: [ :atom :op | op setParser: atom ].
			g postfix: self rangePiece do: [ :atom :op | op setParser: atom ] ];
		group: [ :g |
			g left: nil asParser do: [ :left :op :right | left , right ] ];
		group: [ :g |
			g left: $| do: [ :left :op :right | left / right ] ];
		yourself! !

!PPRegexParser methodsFor: 'accessing' stamp: 'lr 2/7/2010 23:24'!
start
	^ regex end! !

!PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 2/8/2010 00:09'!
zeroOrMorePiece
	"*	0 or more times"
		
	^ $* asParser map: [ :op | PPRepeatingParser on: nil min: 0 ]! !

!PPRegexParser methodsFor: 'grammar-operators' stamp: 'lr 2/8/2010 00:09'!
zeroOrOnePiece
	"?	0 or 1 times"

	^ $? asParser map: [ :op | PPRepeatingParser on: nil min: 0 max: 1 ]! !