path: root/tests/examplefiles/RegexMatcher.ns2

Newsqueak2
'Regex'

class RegexMatcher main: platform = NewspeakObject ("Ported to NS2 by Ryan Macnak from:

The Regular Expression Matcher (''The Software'') is Copyright (C) 1996, 1999 Vassili Bykov. 
It is provided to the Smalltalk community in hope it will be useful.

The software is provided free of charge ``as is'', in hope that it will be useful, with ABSOLUTELY NO WARRANTY. The entire risk and all responsibility for the use of the software is with you.  Under no circumstances the author may be held responsible for loss of data, loss of profit, or any other damage resulting directly or indirectly from the use of the software, even if the damage is caused by defects in the software.

You may use this software in any applications you build.

You may distribute this software with the restrictions that no fee (with the exception of a reasonable fee to cover the cost of distribution media) may be charged for the distribution without a prior written consent of the author, and the software must be distributed with its documentation and copyright notices included and intact.

You may create and distribute modified versions of the software, such as ports to other Smalltalk dialects or derived work, provided that:  
a. any modified version is expressly marked as such and is not misrepresented as the original software; 
b. credit is given to the original software in the source code and documentation of the derived work;  
c. the copyright notice at the top of this document accompanies copyright notices of any modified version. "
|

	OrderedCollection = platform OrderedCollection.
	WriteStream = platform WriteStream.
	ReadStream = platform ReadStream.
	Dictionary = platform Dictionary.
	Association = platform Association.
	Transcript = platform Transcript.
	Set = platform Set.
	Error = platform Error.
	MessageNotUnderstood = platform MessageNotUnderstood.

	Cr = Character cr.
	Lf = Character lf.
	BackslashConstants ::= nil. "?????"
	BackslashSpecials ::= nil. "?????"
	EscapedLetterSelectors ::= nil.
	NamedClassSelectors ::= nil.
|
	RxParser initialize.
	RxsPredicate initialize.
)
(

class RxmSpecial = RxmLink (
"A special node that matches a specific matcher state rather than any input character.
The state is either at-beginning-of-line or at-end-of-line."
|
	matchSelector
|
)
('initialize-release'
beBeginningOfLine = (

	matchSelector:: #atBeginningOfLine
)

beBeginningOfWord = (

	matchSelector:: #atBeginningOfWord
)

beEndOfLine = (

	matchSelector:: #atEndOfLine
)

beEndOfWord = (
	matchSelector:: #atEndOfWord
)

beNotWordBoundary = (
	matchSelector:: #notAtWordBoundary
)

beWordBoundary = (
	matchSelector:: #atWordBoundary
)

'matching'
matchAgainst: aMatcher = (
	"Match without consuming any input, if the matcher is
	in appropriate state."

	^(aMatcher perform: matchSelector)
		and: [next matchAgainst: aMatcher]
)

)

class CompilationError = RegexError ("Regex compilation error")
()

class SyntaxError = RegexError ("Regex syntax error")
()

class RxsContextCondition = RxsNode (
"One of a few special nodes more often representing special state of the match rather than a predicate on a character.  The ugly exception is the #any condition which *is* a predicate on a character.

Instance variables:
	kind		<Selector>"
|
	kind
|
)
('accessing'
dispatchTo: aBuilder = (

	^aBuilder perform: kind
)

'testing'
isNullable = (

	^#syntaxAny ~~ kind
)

'initialize-release'
beAny = (
	"Matches anything but a newline."

	kind:: #syntaxAny
)

beBeginningOfLine = (
	"Matches empty string at the beginning of a line."

	kind:: #syntaxBeginningOfLine
)

beBeginningOfWord = (
	"Matches empty string at the beginning of a word."

	kind:: #syntaxBeginningOfWord
)

beEndOfLine = (
	"Matches empty string at the end of a line."

	kind:: #syntaxEndOfLine
)

beEndOfWord = (
	"Matches empty string at the end of a word."

	kind:: #syntaxEndOfWord
)

beNonWordBoundary = (
	"Analog of \B."

	kind:: #syntaxNonWordBoundary
)

beWordBoundary = (
	"Analog of \w (alphanumeric plus _)."

	kind:: #syntaxWordBoundary
)

)

class RxsBranch piece: p branch: b = RxsNode(
"A Branch is a Piece followed by a Branch or an empty string.

Instance variables:
	piece		<RxsPiece>
	branch		<RxsBranch|RxsEpsilon>"
|
	piece::= p. branch::= b.
|
)
('accessing'
dispatchTo: aMatcher = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxBranch: self
)

'optimization'
tryMergingInto: aStream = (
	"Concatenation of a few simple characters can be optimized
	to be a plain substring match. Answer the node to resume
	syntax tree traversal at. Epsilon node used to terminate the branch
	will implement this to answer nil, thus indicating that the branch
	has ended."

	piece isAtomic ifFalse: [^self].
	aStream nextPut: piece character.
	^branch isNil
		ifTrue: [branch]
		ifFalse: [branch tryMergingInto: aStream]
)

'testing'
isNullable = (
	^piece isNullable and: [branch isNil or: [branch isNullable]]
)

)

class RxmMarker = RxmLink (
"A marker is used to remember positions of match of certain points of a regular expression. The marker receives an identifying key from the Matcher and uses that key to report positions of successful matches to the Matcher.

Instance variables:
	index	<Object> Something that makes sense for the Matcher. Received from the latter during initalization and later passed to it to identify the receiver."
|
	index
|
)
('matching'
matchAgainst: aMatcher = (
	"If the rest of the link chain matches successfully, report the
	position of the stream *before* the match started to the matcher."

	| startPosition |
	startPosition:: aMatcher position.
	(next matchAgainst: aMatcher)
		ifTrue:
			[aMatcher markerPositionAt: index add: startPosition.
			^true].
	^false
)

)

class RxMatcher for: syntaxTreeRoot ignoreCase: aBoolean  = (
"This is a recursive regex matcher. Not strikingly efficient, but simple. Also, keeps track of matched subexpressions.  The life cycle goes as follows:

1. Initialization. Accepts a syntax tree (presumably produced by RxParser) and compiles it into a matcher built of other classes in this category.

2. Matching. Accepts a stream or a string and returns a boolean indicating whether the whole stream or its prefix -- depending on the message sent -- matches the regex.

3. Subexpression query. After a successful match, and before any other match, the matcher may be queried about the range of specific stream (string) positions that matched to certain parenthesized subexpressions of the original expression.

Any number of queries may follow a successful match, and any number or matches may follow a successful initialization.

Note that `matcher' is actually a sort of a misnomer. The actual matcher is a web of Rxm* instances built by RxMatcher during initialization. RxMatcher is just the interface facade of this network.  It is also a builder of it, and also provides a stream-like protocol to easily access the stream being matched.

Slots:
	matcher				<RxmLink> The entry point into the actual matcher.
	stream				<Stream> The stream currently being matched against.
	markerPositions		<Array of: Integer> Positions of markers' matches.
	markerCount		<Integer> Number of markers.
	lastResult 			<Boolean> Whether the latest match attempt succeeded or not.
	lastChar			<Character | nil> character last seen in the matcher stream"
|
	matcher ignoreCase startOptimizer stream markerPositions markerCount lastResult lastChar
|

	"Compile thyself for the regex with the specified syntax tree.
	See comment and `building' protocol in this class and 
	#dispatchTo: methods in syntax tree components for details 
	on double-dispatch building. 
	The argument is supposedly a RxsRegex."

	ignoreCase:: aBoolean.
	self buildFrom: syntaxTreeRoot.
	startOptimizer:: RxMatchOptimizer for: syntaxTreeRoot ignoreCase: aBoolean. 

)
('private'
allocateMarker = (
	"Answer an integer to use as an index of the next marker."

	markerCount:: markerCount + 1.
	^markerCount
)

hookBranchOf: regexNode onto: endMarker = (
	"Private - Recurse down the chain of regexes starting at
	regexNode, compiling their branches and hooking their tails 
	to the endMarker node."

	| rest |
	rest:: regexNode regex isNil
		ifTrue: [nil]
		ifFalse: [self hookBranchOf: regexNode regex onto: endMarker].
	^RxmBranch new
		next: ((regexNode branch dispatchTo: self)
					pointTailTo: endMarker; 
					yourself);
		alternative: rest;
		yourself
)

isWordChar: aCharacterOrNil = (
	"Answer whether the argument is a word constituent character:
	alphanumeric or _."

	^aCharacterOrNil ~~ nil
		and: [aCharacterOrNil isAlphaNumeric]
)

makeOptional: aMatcher = (
	"Private - Wrap this matcher so that the result would match 0 or 1
	occurrences of the matcher."

	| dummy branch |
	dummy:: RxmLink new.
	branch:: (RxmBranch new beLoopback)
		next: aMatcher;
		alternative: dummy.
	aMatcher pointTailTo: dummy.
	^branch
)

makePlus: aMatcher = (
	"Private - Wrap this matcher so that the result would match 1 and more
	occurrences of the matcher."

	| loopback |
	loopback:: (RxmBranch new beLoopback)
		next: aMatcher.
	aMatcher pointTailTo: loopback.
	^aMatcher
)

makeStar: aMatcher = (
	"Private - Wrap this matcher so that the result would match 0 and more
	occurrences of the matcher."

	| dummy detour loopback |
	dummy:: RxmLink new.
	detour:: RxmBranch new
		next: aMatcher;
		alternative: dummy.
	loopback:: (RxmBranch new beLoopback)
		next: aMatcher;
		alternative: dummy.
	aMatcher pointTailTo: loopback.
	^detour
)

proceedSearchingStream: aStream = (

	| position |
	position:: aStream position.
	[aStream atEnd] whileFalse:
		[self tryMatch ifTrue: [^true].
		aStream position: position.
		lastChar:: aStream next.
		position:: aStream position].
	"Try match at the very stream end too!"
	self tryMatch ifTrue: [^true]. 
	^false
)

tryMatch = (
	"Match thyself against the current stream."

	markerPositions:: Array new: markerCount.
	1 to: markerCount do: [:i | markerPositions at: i put: OrderedCollection new].
	startOptimizer == nil
		ifTrue: [lastResult:: matcher matchAgainst: self]
		ifFalse: [lastResult:: (startOptimizer canStartMatch: stream peek in: self)
									and: [matcher matchAgainst: self]].
	^lastResult
)

'testing'
atBeginningOfLine = (
	^self position = 0 or: [lastChar = Cr]
)

atBeginningOfWord = (
	^(self isWordChar: lastChar) not
		and: [self isWordChar: stream peek]
)

atEndOfLine = (
	^self atEnd or: [stream peek = Cr]
)

atEndOfWord = (
	^(self isWordChar: lastChar)
		and: [(self isWordChar: stream peek) not]
)

atWordBoundary = (
	^(self isWordChar: lastChar)
		xor: (self isWordChar: stream peek)
)

notAtWordBoundary = (
	^self atWordBoundary not
)

supportsSubexpressions = (
	^true
)

'streaming'
atEnd = (
	^stream atEnd
)

next = (
	lastChar:: stream next.
	^lastChar
)

position = (
	^stream position
)

'accessing'
buildFrom: aSyntaxTreeRoot = (
	"Private - Entry point of matcher build process."

	markerCount:: 0.  "must go before #dispatchTo: !"
	matcher:: aSyntaxTreeRoot dispatchTo: self.
	matcher terminateWith: RxmTerminator new
)

matches: aString = (
	"Match against a string."
	^self matchesStream: aString readStream
)

matchesPrefix: aString = (
	"Match against a string."

	^self matchesStreamPrefix: aString readStream
)

matchesStream: theStream = (
	"Match thyself against a positionable stream."

	^(self matchesStreamPrefix: theStream)
		and: [stream atEnd]
)

matchesStreamPrefix: theStream = (
	"Match thyself against a positionable stream."

	stream:: theStream.
	lastChar:: nil.
	^self tryMatch
)

search: aString = (
	"Search the string for occurrence of something matching myself.
	Answer a Boolean indicating success."

	^self searchStream: aString readStream
)

searchStream: aStream = (
	"Search the stream for occurrence of something matching myself.
	After the search has occurred, stop positioned after the end of the
	matched substring. Answer a Boolean indicating success."

	| position |
	stream:: aStream.
	lastChar:: nil.
	position:: aStream position.
	[aStream atEnd] whileFalse:
		[self tryMatch ifTrue: [^true].
		aStream position: position.
		lastChar:: aStream next.
		position:: aStream position].
	"Try match at the very stream end too!"
	self tryMatch ifTrue: [^true]. 
	^false
)

subBeginning: subIndex = (
	^markerPositions at: subIndex * 2 - 1
)

subEnd: subIndex = (
	^markerPositions at: subIndex * 2
)

subexpression: subIndex = (
	"Answer a string that matched the subexpression at the given index.
	If there are multiple matches, answer the last one.
	If there are no matches, answer nil. 
	(NB: it used to answer an empty string but I think nil makes more sense)."

	| matches |
	matches:: self subexpressions: subIndex.
	^matches isEmpty ifTrue: [nil] ifFalse: [matches last]
)

subexpressionCount = (
	^markerCount // 2
)

subexpressions: subIndex = (
	"Answer an array of all matches of the subexpression at the given index.
	The answer is always an array; it is empty if there are no matches."

	| originalPosition startPositions stopPositions reply |
	originalPosition:: stream position.
	startPositions:: self subBeginning: subIndex.
	stopPositions:: self subEnd: subIndex.
	(startPositions isEmpty or: [stopPositions isEmpty]) ifTrue: [^Array new].
	reply:: OrderedCollection new.
	startPositions with: stopPositions do:
		[:start :stop |
		stream position: start.
		reply add: (stream next: stop - start)].
	stream position: originalPosition.
	^reply asArray
)

'match enumeration'
copy: aString replacingMatchesWith: replacementString = (
	"Copy <aString>, except for the matches. Replace each match with <aString>."

	| answer |
	answer:: (String new: 40) writeStream.
	self
		copyStream: aString readStream
		to: answer
		replacingMatchesWith: replacementString.
	^answer contents
)

copy: aString translatingMatchesUsing: aBlock = (
	"Copy <aString>, except for the matches. For each match, evaluate <aBlock> passing the matched substring as the argument.  Expect the block to answer a String, and replace the match with the answer."

	| answer |
	answer:: (String new: 40) writeStream.
	self copyStream: aString readStream to: answer translatingMatchesUsing: aBlock.
	^answer contents
)

copyStream: aStream to: writeStream replacingMatchesWith: aString = (
	"Copy the contents of <aStream> on the <writeStream>, except for the matches. Replace each match with <aString>."

	| searchStart matchStart matchEnd |
	stream:: aStream.
	lastChar:: nil.
	[searchStart:: aStream position.
	self proceedSearchingStream: aStream] whileTrue:
		[matchStart:: (self subBeginning: 1) first.
		matchEnd:: (self subEnd: 1) first.
		aStream position: searchStart.
		searchStart to: matchStart - 1 do:
			[:ignoredPos | writeStream nextPut: aStream next].
		writeStream nextPutAll: aString.
		aStream position: matchEnd.
		"Be extra careful about successful matches which consume no input.
		After those, make sure to advance or finish if already at end."
		matchEnd = searchStart ifTrue: 
			[aStream atEnd
				ifTrue:	[^self "rest after end of whileTrue: block is a no-op if atEnd"]
				ifFalse:	[writeStream nextPut: aStream next]]].
	aStream position: searchStart.
	[aStream atEnd] whileFalse: [writeStream nextPut: aStream next]
)

copyStream: aStream to: writeStream translatingMatchesUsing: aBlock = (
	"Copy the contents of <aStream> on the <writeStream>, except for the matches. For each match, evaluate <aBlock> passing the matched substring as the argument.  Expect the block to answer a String, and write the answer to <writeStream> in place of the match."

	| searchStart matchStart matchEnd match |
	stream:: aStream.
	lastChar:: nil.
	[searchStart:: aStream position.
	self proceedSearchingStream: aStream] whileTrue:
		[matchStart:: (self subBeginning: 1) first.
		matchEnd:: (self subEnd: 1) first.
		aStream position: searchStart.
		searchStart to: matchStart - 1 do:
			[:ignoredPos | writeStream nextPut: aStream next].
		match:: (String new: matchEnd - matchStart + 1) writeStream.
		matchStart to: matchEnd - 1 do:
			[:ignoredPos | match nextPut: aStream next].
		writeStream nextPutAll: (aBlock value: match contents).
		"Be extra careful about successful matches which consume no input.
		After those, make sure to advance or finish if already at end."
		matchEnd = searchStart ifTrue: 
			[aStream atEnd
				ifTrue:	[^self "rest after end of whileTrue: block is a no-op if atEnd"]
				ifFalse:	[writeStream nextPut: aStream next]]].
	aStream position: searchStart.
	[aStream atEnd] whileFalse: [writeStream nextPut: aStream next]
)

matchesIn: aString = (
	"Search aString repeatedly for the matches of the receiver.  Answer an OrderedCollection of all matches (substrings)."

	| result |
	result:: OrderedCollection new.
	self
		matchesOnStream: aString readStream
		do: [:match | result add: match].
	^result
)

matchesIn: aString collect: aBlock = (
	"Search aString repeatedly for the matches of the receiver.  Evaluate aBlock for each match passing the matched substring as the argument, collect evaluation results in an OrderedCollection, and return in. The following example shows how to use this message to split a string into words."
	"'\w+' asRegex matchesIn: 'Now is the Time' collect: [:each | each asLowercase]"

	| result |
	result:: OrderedCollection new.
	self
		matchesOnStream: aString readStream
		do: [:match | result add: (aBlock value: match)].
	^result
)

matchesIn: aString do: aBlock = (
	"Search aString repeatedly for the matches of the receiver.
	Evaluate aBlock for each match passing the matched substring
	as the argument."

	self
		matchesOnStream: aString readStream
		do: aBlock
)

matchesOnStream: aStream = (

	| result |
	result:: OrderedCollection new.
	self
		matchesOnStream: aStream
		do: [:match | result add: match].
	^result
)

matchesOnStream: aStream collect: aBlock = (
	| result |
	result:: OrderedCollection new.
	self
		matchesOnStream: aStream
		do: [:match | result add: (aBlock value: match)].
	^result
)

matchesOnStream: aStream do: aBlock = (
	"Be extra careful about successful matches which consume no input.
	After those, make sure to advance or finish if already at end."

	| position |
	[position:: aStream position.
	self searchStream: aStream] whileTrue:
		[aBlock value: (self subexpression: 1).
		position = aStream position ifTrue: 
			[aStream atEnd
				ifTrue: [^self]
				ifFalse: [aStream next]]]
)

matchingRangesIn: aString = (
	"Search aString repeatedly for the matches of the receiver.  Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."

	| result |
	result:: OrderedCollection new.
	self
		matchesIn: aString 
		do: [:match | result add: (self position - match size + 1 to: self position)].
	^result
)

'privileged'
currentState = (
	"Answer an opaque object that can later be used to restore the
	matcher's state (for backtracking)."

	| origPosition origLastChar |
	origPosition:: stream position.
	origLastChar:: lastChar.
	^	[stream position: origPosition.
		lastChar:: origLastChar]
)

markerPositionAt: anIndex add: position = (
	"Remember position of another instance of the given marker."

	(markerPositions at: anIndex) addFirst: position
)

restoreState: aBlock = (
	aBlock value
)

'double dispatch'
syntaxAny = (
	"Double dispatch from the syntax tree. 
	Create a matcher for any non-null character."

	^RxmPredicate new
		predicate: [:char | char asInteger ~= 0]
)

syntaxBeginningOfLine = (
	"Double dispatch from the syntax tree. 
	Create a matcher for beginning-of-line condition."

	^RxmSpecial new beBeginningOfLine
)

syntaxBeginningOfWord = (
	"Double dispatch from the syntax tree. 
	Create a matcher for beginning-of-word condition."

	^RxmSpecial new beBeginningOfWord
)

syntaxBranch: branchNode = (
	"Double dispatch from the syntax tree. 
	Branch node is a link in a chain of concatenated pieces.
	First build the matcher for the rest of the chain, then make 
	it for the current piece and hook the rest to it."

	| result next rest |
	branchNode branch isNil
		ifTrue: [^branchNode piece dispatchTo: self].
	"Optimization: glue a sequence of individual characters into a single string to match."
	branchNode piece isAtomic ifTrue:
		[result:: WriteStream on: (String new: 40).
		next:: branchNode tryMergingInto: result.
		result:: result contents.
		result size > 1 ifTrue: "worth merging"
			[rest:: next notNil 
				ifTrue: [next dispatchTo: self]
				ifFalse: [nil].
			^(RxmSubstring new substring: result ignoreCase: ignoreCase)
				pointTailTo: rest;
				yourself]].
	"No optimization possible or worth it, just concatenate all. "
	^(branchNode piece dispatchTo: self)
		pointTailTo: (branchNode branch dispatchTo: self);
		yourself
)

syntaxCharSet: charSetNode = (
	"Double dispatch from the syntax tree. 
	A character set is a few characters, and we either match any of them,
	or match any that is not one of them."

	^RxmPredicate with: (charSetNode predicateIgnoringCase: ignoreCase)
)

syntaxCharacter: charNode = (
	"Double dispatch from the syntax tree. 
	We get here when no merging characters into strings was possible."

	| wanted |
	wanted:: charNode character.
	^RxmPredicate new predicate: 
		(ignoreCase
			ifTrue: [[:char | char sameAs: wanted]]
			ifFalse: [[:char | char = wanted]])
)

syntaxEndOfLine = (
	"Double dispatch from the syntax tree. 
	Create a matcher for end-of-line condition."

	^RxmSpecial new beEndOfLine
)

syntaxEndOfWord = (
	"Double dispatch from the syntax tree. 
	Create a matcher for end-of-word condition."

	^RxmSpecial new beEndOfWord
)

syntaxEpsilon = (
	"Double dispatch from the syntax tree. Match empty string. This is unlikely
	to happen in sane expressions, so we'll live without special epsilon-nodes."

	^RxmSubstring new
		substring: String new
		ignoreCase: ignoreCase
)

syntaxMessagePredicate: messagePredicateNode = (
	"Double dispatch from the syntax tree. 
	Special link can handle predicates."

	^messagePredicateNode negated
		ifTrue: [RxmPredicate new bePerformNot: messagePredicateNode selector]
		ifFalse: [RxmPredicate new bePerform: messagePredicateNode selector]
)

syntaxNonWordBoundary = (
	"Double dispatch from the syntax tree. 
	Create a matcher for the word boundary condition."

	^RxmSpecial new beNotWordBoundary
)

syntaxPiece: pieceNode = (
	"Double dispatch from the syntax tree. 
	Piece is an atom repeated a few times. Take care of a special
	case when the atom is repeated just once."

	| atom |
	atom:: pieceNode atom dispatchTo: self.
	^pieceNode isSingular
		ifTrue: [atom]
		ifFalse: [pieceNode isStar
			ifTrue: [self makeStar: atom]
			ifFalse: [pieceNode isPlus
				ifTrue: [self makePlus: atom]
				ifFalse: [pieceNode isOptional
					ifTrue: [self makeOptional: atom]
					ifFalse: [CompilationError signal: 
						'repetitions are not supported by RxMatcher']]]]
)

syntaxPredicate: predicateNode = (
	"Double dispatch from the syntax tree. 
	A character set is a few characters, and we either match any of them,
	or match any that is not one of them."

	^RxmPredicate with: predicateNode predicate
)

syntaxRegex: regexNode = (
	"Double dispatch from the syntax tree. 
	Regex node is a chain of branches to be tried. Should compile this 
	into a bundle of parallel branches, between two marker nodes." 
	
	| startIndex endIndex endNode alternatives |
	startIndex:: self allocateMarker.
	endIndex:: self allocateMarker.
	endNode:: RxmMarker new index: endIndex.
	alternatives:: self hookBranchOf: regexNode onto: endNode.
	^(RxmMarker new index: startIndex)
		pointTailTo: alternatives;
		yourself
)

syntaxWordBoundary = (
	"Double dispatch from the syntax tree. 
	Create a matcher for the word boundary condition."

	^RxmSpecial new beWordBoundary
)

) : (
'as yet unclassified'
for: aRegex = (
	^self for: aRegex ignoreCase: false
)

forString: aString = (
	"Create and answer a matcher that will match the regular expression
	`aString'."

	^self for: (RxParser new parse: aString)
)

forString: aString ignoreCase: aBoolean = (
	"Create and answer a matcher that will match the regular expression
	`aString'."

	^self for: (RxParser new parse: aString) ignoreCase: aBoolean
)

)

class RxMatchOptimizer for: aRegex ignoreCase: aBoolean = (
"A match start optimizer, handy for searching a string. Takes a regex syntax tree and sets itself up so that prefix characters or matcher states that cannot start a match are later recognized with #canStartMatch:in: method.

Used by RxMatcher, but can be used by other matchers (if implemented) as well."
|
	ignoreCase prefixes nonPrefixes conditions testBlock methodPredicates nonMethodPredicates predicates nonPredicates
|
	ignoreCase:: aBoolean.
	prefixes:: Set new: 10.
	nonPrefixes:: Set new: 10.
	conditions:: Set new: 3.
	methodPredicates:: Set new: 3.
	nonMethodPredicates:: Set new: 3.
	predicates:: Set new: 3.
	nonPredicates:: Set new: 3.
	aRegex dispatchTo: self.	"If the whole expression is nullable, 
		end-of-line is an implicit can-match condition!"
	aRegex isNullable ifTrue: [conditions add: #atEndOfLine].
	testBlock:: self determineTestMethod
)
('accessing'
canStartMatch: aCharacter in: aMatcher = (
	"Answer whether a match could commence at the given lookahead
	character, or in the current state of <aMatcher>. True answered
	by this method does not mean a match will definitly occur, while false
	answered by this method *does* guarantee a match will never occur."

	aCharacter isNil ifTrue: [^true].
	^testBlock == nil or: [testBlock value: aCharacter value: aMatcher]
)

conditionTester = (
	"#any condition is filtered at the higher level;
	it cannot appear among the conditions here."

	| matchCondition |
	conditions isEmpty ifTrue: [^nil].
	conditions size = 1 ifTrue:
		[matchCondition:: conditions detect: [:ignored | true].
		"Special case all of the possible conditions."
		#atBeginningOfLine = matchCondition ifTrue: [^[:c :matcher | matcher atBeginningOfLine]].
		#atEndOfLine = matchCondition ifTrue: [^[:c :matcher | matcher atEndOfLine]].
		#atBeginningOfWord = matchCondition ifTrue: [^[:c :matcher | matcher atBeginningOfWord]].
		#atEndOfWord = matchCondition ifTrue: [^[:c :matcher | matcher atEndOfWord]].
		#atWordBoundary = matchCondition ifTrue: [^[:c :matcher | matcher atWordBoundary]].
		#notAtWordBoundary = matchCondition ifTrue: [^[:c :matcher | matcher notAtWordBoundary]].
		CompilationError signal: 'invalid match condition'].
	"More than one condition. Capture them as an array in scope."
	matchCondition:: conditions asArray.
	^[:c :matcher |
		matchCondition contains:
			[:conditionSelector |
			matcher perform: conditionSelector]]
)

methodPredicateTester = (
	| p selector |
	methodPredicates isEmpty ifTrue: [^nil].
	p:: self optimizeSet: methodPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			["might be a pretty common case"
			selector:: p first.
			[:char :matcher | 
			RxParser doHandlingMessageNotUnderstood:
				[char perform: selector]]]
		ifFalse: 
			[[:char :m | 
			RxParser doHandlingMessageNotUnderstood:
				[p contains: [:sel | char perform: sel]]]]
)

nonMethodPredicateTester = (
	| p selector |
	nonMethodPredicates isEmpty ifTrue: [^nil].
	p:: self optimizeSet: nonMethodPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			[selector:: p first.
			[:char :matcher | 
			RxParser doHandlingMessageNotUnderstood:
				[(char perform: selector) not]]]
		ifFalse: 
			[[:char :m | 
			RxParser doHandlingMessageNotUnderstood:
				[p contains: [:sel | (char perform: sel) not]]]]
)

'double dispatch'
syntaxAny = (
	"Any special char is among the prefixes."

	conditions add: #any
)

syntaxBeginningOfLine = (
	"Beginning of line is among the prefixes."

	conditions add: #atBeginningOfLine
)

syntaxBeginningOfWord = (
	"Beginning of line is among the prefixes."

	conditions add: #atBeginningOfWord
)

syntaxBranch: branchNode = (
	"If the head piece of the branch is transparent (allows 0 matches),
	we must recurse down the branch. Otherwise, just the head atom
	is important."

	(branchNode piece isNullable and: [branchNode branch notNil])
		ifTrue: [branchNode branch dispatchTo: self].
	branchNode piece dispatchTo: self
)

syntaxCharSet: charSetNode = (
	"All these (or none of these) characters is the prefix."

	charSetNode isNegated
		ifTrue: [nonPrefixes addAll: (charSetNode enumerableSetIgnoringCase: ignoreCase)]
		ifFalse: [prefixes addAll: (charSetNode enumerableSetIgnoringCase: ignoreCase)].
	charSetNode hasPredicates ifTrue: 
			[charSetNode isNegated
				ifTrue: [nonPredicates addAll: charSetNode predicates]
				ifFalse: [predicates addAll: charSetNode predicates]]
)

syntaxCharacter: charNode = (
	"This character is the prefix, of one of them."

	prefixes add: charNode character
)

syntaxEndOfLine = (
	"Beginning of line is among the prefixes."

	conditions add: #atEndOfLine
)

syntaxEndOfWord = (

	conditions add: #atEndOfWord
)

syntaxEpsilon = (
	"Empty string, terminate the recursion (do nothing)."
)

syntaxMessagePredicate: messagePredicateNode = ( 
	messagePredicateNode negated
		ifTrue: [nonMethodPredicates add: messagePredicateNode selector]
		ifFalse: [methodPredicates add: messagePredicateNode selector]
)

syntaxNonWordBoundary = (
	conditions add: #notAtWordBoundary
)

syntaxPiece: pieceNode = (
	"Pass on to the atom."

	pieceNode atom dispatchTo: self
)

syntaxPredicate: predicateNode = (

	predicates add: predicateNode predicate
)

syntaxRegex: regexNode = (
	"All prefixes of the regex's branches should be combined.
	Therefore, just recurse."

	regexNode branch dispatchTo: self.
	regexNode regex notNil
		ifTrue: [regexNode regex dispatchTo: self]
)

syntaxWordBoundary = (

	conditions add: #atWordBoundary
)

'private'
determineTestMethod = (
	"Answer a block closure that will work as a can-match predicate.
	Answer nil if no viable optimization is possible (too many chars would
	be able to start a match)."

	| testers |
	(conditions includes: #any) ifTrue: [^nil].
	testers:: OrderedCollection new: 5.
	{#prefixTester. #nonPrefixTester. #conditionTester. #methodPredicateTester. #nonMethodPredicateTester. #predicateTester. #nonPredicateTester}
		do: 
			[:selector | 
			| tester |
			tester:: self perform: selector.
			tester notNil ifTrue: [testers add: tester]].
	testers isEmpty ifTrue: [^nil].
	testers size = 1 ifTrue: [^testers first].
	testers:: testers asArray.
	^[:char :matcher | testers contains: [:t | t value: char value: matcher]]
)

nonPredicateTester = (

	| p pred |
	nonPredicates isEmpty ifTrue: [^nil].
	p:: self optimizeSet: nonPredicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			[pred:: p first.
			[:char :matcher | (pred value: char) not]]
		ifFalse: 
			[[:char :m | p contains: [:some | (some value: char) not]]]
)

nonPrefixTester = (

	| np nonPrefixChar |
	nonPrefixes isEmpty ifTrue: [^nil].
	np:: self optimizeSet: nonPrefixes. "also allows copying closures"
	^np size = 1 "might be be pretty common case"
		ifTrue: 
			[nonPrefixChar:: np first.
			[:char :matcher | char ~= nonPrefixChar]]
		ifFalse: [[:char : matcher | (np includes: char) not]]
)

optimizeSet: aSet = (
	"If a set is small, convert it to array to speed up lookup
	(Array has no hashing overhead, beats Set on small number
	of elements)."

	^aSet size < 10 ifTrue: [aSet asArray] ifFalse: [aSet]
)

predicateTester = (
	| p pred |
	predicates isEmpty ifTrue: [^nil].
	p:: self optimizeSet: predicates.	"also allows copying closures"
	^p size = 1
		ifTrue: 
			[pred:: p first.
			[:char :matcher | pred value: char]]
		ifFalse: 
			[[:char :m | p contains: [:some | some value: char]]]
)

prefixTester = (

	| p prefixChar |
	prefixes isEmpty ifTrue: [^nil].
	p:: self optimizeSet: prefixes. "also allows copying closures"
	ignoreCase ifTrue: [p:: p collect: [:each | each asUppercase]].
	^p size = 1 "might be a pretty common case"
		ifTrue: 
			[prefixChar:: p first.
			ignoreCase
				ifTrue: [[:char :matcher | char sameAs: prefixChar]]
				ifFalse: [[:char :matcher | char = prefixChar]]]
		ifFalse:
			[ignoreCase
				ifTrue: [[:char :matcher | p includes: char asUppercase]]
				ifFalse: [[:char :matcher | p includes: char]]]
)

)

class RxsMessagePredicate selector: s negated: aBoolean = RxsNode (
"A message predicate represents a condition on a character that is tested (at the match time) by sending a unary message to the character expecting a Boolean answer.

Instance variables:
	selector		<Symbol>"
|
	selector::= s.
	negated::= aBoolean.
|
)
('accessing'
dispatchTo: aBuilder = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aBuilder syntaxMessagePredicate: self
)

)

class RxCharSetParser on: aStream = (
"I am a parser created to parse the insides of a character set ([...]) construct. I create and answer a collection of 'elements', each being an instance of one of: RxsCharacter, RxsRange, or RxsPredicate."
|
	source lookahead elements
|
source: aStream.
lookahead: aStream next.
elements: OrderedCollection new.
)
('accessing'
parse = (
	lookahead = $- ifTrue:
		[self addChar: $-.
		self match: $-].
	[lookahead isNil] whileFalse: [self parseStep].
	^elements
)

'parsing'
addChar: aChar = (
	elements add: (RxsCharacter with: aChar)
)

addRangeFrom: firstChar to: lastChar = (
	firstChar asInteger > lastChar asInteger ifTrue:
		[SyntaxError signal: ' bad character range'].
	elements add: (RxsRange from: firstChar to: lastChar)
)

match: aCharacter = (
	aCharacter = lookahead
		ifFalse: [SyntaxError signal: 'unexpected character: ', (String with: lookahead)].
	^source atEnd
		ifTrue: [lookahead: nil]
		ifFalse: [lookahead: source next]
)

parseCharOrRange = (
	| firstChar |
	firstChar: lookahead.
	self match: firstChar.
	lookahead = $- ifTrue:
		[self match: $-.
		lookahead isNil
			ifTrue: [^self addChar: firstChar; addChar: $-]
			ifFalse: 
				[self addRangeFrom: firstChar to: lookahead.
				^self match: lookahead]].
	self addChar: firstChar
)

parseEscapeChar = (
	self match: $\.
	$- = lookahead
		ifTrue: [elements add: (RxsCharacter with: $-)]
		ifFalse: [elements add: (RxsPredicate forEscapedLetter: lookahead)].
	self match: lookahead
)

parseNamedSet = (
	| name |
	self match: $[; match: $:.
	name:: (String with: lookahead), (source upTo: $:).
	lookahead:: source next.
	self match: $].
	elements add: (RxsPredicate forNamedClass: name)
)

parseStep = (
	lookahead = $[ ifTrue:
		[source peek = $:
			ifTrue: [^self parseNamedSet]
			ifFalse: [^self parseCharOrRange]].
	lookahead = $\ ifTrue:
		[^self parseEscapeChar].
	lookahead = $- ifTrue:
		[SyntaxError signal: 'invalid range'].
	self parseCharOrRange
)

)

class RxsRange from: aChar to: anotherChar = RxsNode (
"I represent a range of characters as appear in character classes such as

	[a-ZA-Z0-9].

I appear in a syntax tree only as an element of RxsCharSet.

Instance Variables:

	first	<Character>
	last	<Character>"
|
	first ::= aChar.
	last ::= anotherChar.
|
)
('accessing'
enumerateTo: aSet ignoringCase: aBoolean = (
	"Add all of the elements I represent to the collection."

	first asInteger to: last asInteger do:
		[:charCode | | character |
		character:: charCode asCharacter.
		aBoolean
		ifTrue: 
			[aSet 
				add: character asUppercase;
				add: character asLowercase]
		ifFalse: [aSet add: character]]
)

'testing'
isEnumerable = (

	^true
)

)

class RxsNode = (
"A generic syntax tree node, provides some common responses to the standard tests, as well as tree structure printing -- handy for debugging."

)
('constants'
indentCharacter = (
	"Normally, #printOn:withIndent: method in subclasses
	print several characters returned by this method to indicate
	the tree structure."

	^$+
)

'testing'
isAtomic = (
	"Answer whether the node is atomic, i.e. matches exactly one 
	constant predefined normal character.  A matcher may decide to 
	optimize matching of a sequence of atomic nodes by glueing them 
	together in a string."

	^false "tentatively"
)

isNullable = (
	"True if the node can match an empty sequence of characters."

	^false "for most nodes"
)

)

class RegexError = Error ("Regex error")
()

class RxsPredicate = RxsNode (
"This represents a character that satisfies a certain predicate.

Instance Variables:

	predicate	<BlockClosure>	A one-argument block. If it evaluates to the value defined by <negated> when it is passed a character, the predicate is considered to match.
	negation	<BlockClosure>	A one-argument block that is a negation of <predicate>."
|
	predicate
	negation
|
)
('accessing'
dispatchTo: anObject = (

	^anObject syntaxPredicate: self
)

negated = (

	^self copy negate
)

predicateNegation = (

	^negation
)

value: aCharacter = (

	^predicate value: aCharacter
)

'private'
negate = (

	| tmp |
	tmp:: predicate.
	predicate:: negation.
	negation:: tmp
)

'testing'
isAtomic = (
	"A predicate is a single character but the character is not known in advance."

	^false
)

isEnumerable = (

	^false
)

'initialize-release'
beAlphaNumeric = (

	predicate:: [:char | char isAlphaNumeric].
	negation:: [:char | char isAlphaNumeric not]
)

beAlphabetic = (

	predicate:: [:char | char isAlphabetic].
	negation:: [:char | char isAlphabetic not]
)

beBackslash = (

	predicate:: [:char | char == $\].
	negation:: [:char | char ~~ $\]
)

beControl = (

	predicate:: [:char | char asInteger < 32].
	negation:: [:char | char asInteger >= 32]
)

beDigit = (

	predicate:: [:char | char isDigit].
	negation:: [:char | char isDigit not]
)

beGraphics = (
	beControl.
	negate
)

beHexDigit = (

	| hexLetters |
	hexLetters:: 'abcdefABCDEF'.
	predicate:: [:char | char isDigit or: [hexLetters includes: char]].
	negation:: [:char | char isDigit not and: [(hexLetters includes: char) not]]
)

beLowercase = (

	predicate:: [:char | char isLowercase].
	negation:: [:char | char isLowercase not]
)

beNotDigit = (

	beDigit.
	negate.
)

beNotSpace = (

	beSpace.
	negate
)

beNotWordConstituent = (

	beWordConstituent.
	negate.
)

bePrintable = (

	beControl.
	negate.
)

bePunctuation = (

	| punctuationChars |
	punctuationChars:: {$.. $,. $!. $?. $;. $:. $". $'. $-. $(. $). $`.}.
	predicate:: [:char | punctuationChars includes: char].
	negation:: [:char | (punctuationChars includes: char) not]
)

beSpace = (

	predicate:: [:char | char isSeparator].
	negation:: [:char | char isSeparator not]
)

beUppercase = (

	predicate:: [:char | char isUppercase].
	negation:: [:char | char isUppercase not]
)

beWordConstituent = (

	predicate:: [:char | char isAlphaNumeric].
	negation:: [:char | char isAlphaNumeric not]
)

) : (
'as yet unclassified'
forEscapedLetter: aCharacter = (

	^self new perform:
		(EscapedLetterSelectors
			at: aCharacter
			ifAbsent: [SyntaxError signal: 'bad backslash escape'])
)

forNamedClass: aString = (

	^self new perform:
		(NamedClassSelectors
			at: aString
			ifAbsent: [SyntaxError signal: 'bad character class name'])
)

initialize = (
	"self initialize"

	
		initializeNamedClassSelectors.
		initializeEscapedLetterSelectors.
)

initializeEscapedLetterSelectors = (
	"self initializeEscapedLetterSelectors"

	(EscapedLetterSelectors:: Dictionary new).
	EscapedLetterSelectors
		at: $w put: #beWordConstituent;
		at: $W put: #beNotWordConstituent;
		at: $d put: #beDigit;
		at: $D put: #beNotDigit;
		at: $s put: #beSpace;
		at: $S put: #beNotSpace;
		at: $\ put: #beBackslash
)

initializeNamedClassSelectors = (
	"self initializeNamedClassSelectors"

	(NamedClassSelectors:: Dictionary new).
	NamedClassSelectors 
		at: 'alnum' put: #beAlphaNumeric;
		at: 'alpha' put: #beAlphabetic;
		at: 'cntrl' put: #beControl;
		at: 'digit' put: #beDigit;
		at: 'graph' put: #beGraphics;
		at: 'lower' put: #beLowercase;
		at: 'print' put: #bePrintable;
		at: 'punct' put: #bePunctuation;
		at: 'space' put: #beSpace;
		at: 'upper' put: #beUppercase;
		at: 'xdigit' put: #beHexDigit
)

)

class RxsEpsilon = RxsNode (
"This is an empty string.  It terminates some of the recursive constructs."

)
('building'
dispatchTo: aBuilder = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aBuilder syntaxEpsilon
)

'testing'
isNullable = (
	"See comment in the superclass."

	^true
)

)

class RxsCharacter with: aCharacter = RxsNode (
"A character is a literal character that appears either in the expression itself or in a character set within an expression.

Instance variables:
	character		<Character>"
|
	character ::= aCharacter.
|
)
('accessing'
dispatchTo: aMatcher = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxCharacter: self
)

enumerateTo: aSet ignoringCase: aBoolean = (
	aBoolean
		ifTrue: 
			[aSet 
				add: character asUppercase;
				add: character asLowercase]
		ifFalse: [aSet add: character]
)

'testing'
isAtomic = (
	"A character is always atomic."

	^true
)

isEnumerable = (
	^true
)

isNullable = (
	^false
)

)

class RxParser = (
"The regular expression parser. Translates a regular expression read from a stream into a parse tree. ('accessing' protocol). The tree can later be passed to a matcher initialization method.  All other classes in this category implement the tree. Refer to their comments for any details.

Instance variables:
	input		<Stream> A stream with the regular expression being parsed.
	lookahead	<Character>"
|
	input lookahead
|
)
('accessing'
parse: aString = (
	"Parse input from a string <aString>.
	On success, answers an RxsRegex -- parse tree root.
	On error, raises `RxParser syntaxErrorSignal' with the current
	input stream position as the parameter."

	^self parseStream: (ReadStream on: aString)
)

parseStream: aStream = (
	"Parse an input from a character stream <aStream>.
	On success, answers an RxsRegex -- parse tree root.
	On error, raises `RxParser syntaxErrorSignal' with the current
	input stream position as the parameter."

	| tree |
	input:: aStream.
	lookahead:: nil.
	self match: nil.
	tree:: self regex.
	self match: #epsilon.
	^tree
)

piece = (
	"<piece> ::= <atom> | <atom>* | <atom>+ | <atom>?"

	| atom errorMessage |
	errorMessage:: ' nullable closure'.
	atom:: self atom.
	lookahead = $* ifTrue: 
		[self next.
		atom isNullable ifTrue: [self signalParseError: errorMessage].
		^RxsPiece starAtom: atom].
	lookahead = $+ ifTrue: 
		[self next.
		atom isNullable ifTrue: [self signalParseError: errorMessage].
		^RxsPiece plusAtom: atom].
	lookahead = $? ifTrue: 
		[self next.
		atom isNullable ifTrue: [self signalParseError: errorMessage].
		^RxsPiece optionalAtom: atom].
	^RxsPiece atom: atom
)

regex = (
	"<regex> ::= e | <branch> `|' <regex>"

	| branch regex |
	branch:: self branch.
	(lookahead = #epsilon or: [lookahead = $)])
		ifTrue: [regex:: nil]
		ifFalse: 
			[self match: $|.
			regex:: self regex].
	^RxsRegex branch: branch regex: regex
)

'private'
characterSetFrom: setSpec = (
	"<setSpec> is what goes between the brackets in a charset regex
	(a String). Make a string containing all characters the spec specifies.
	Spec is never empty."

	| negated spec |
	spec:: ReadStream on: setSpec.
	spec peek = $^
		ifTrue: 	[negated:: true.
				spec next]
		ifFalse:	[negated:: false].
	^RxsCharSet elements: (RxCharSetParser on: spec) parse negated: negated
)

ifSpecial: aCharacter then: aBlock = (
	"If the character is such that it defines a special node when follows a $\,
	then create that node and evaluate aBlock with the node as the parameter.
	Otherwise just return."

	| classAndSelector |
	classAndSelector:: BackslashSpecials at: aCharacter ifAbsent: [^self].
	^aBlock value: (classAndSelector key new perform: classAndSelector value)
)

inputUpTo: aCharacter errorMessage: aString = (
	"Accumulate input stream until <aCharacter> is encountered
	and answer the accumulated chars as String, not including
	<aCharacter>. Signal error if end of stream is encountered,
	passing <aString> as the error description."

	| accumulator |
	accumulator:: WriteStream on: (String new: 20).
	[lookahead ~= aCharacter and: [lookahead ~= #epsilon]]
		whileTrue:
			[accumulator nextPut: lookahead.
			self next].
	lookahead = #epsilon ifTrue: [self signalParseError: aString].
	^accumulator contents
)

inputUpTo: aCharacter nestedOn: anotherCharacter errorMessage: aString = (
	"Accumulate input stream until <aCharacter> is encountered
	and answer the accumulated chars as String, not including
	<aCharacter>. Signal error if end of stream is encountered,
	passing <aString> as the error description."

	| accumulator nestLevel |
	accumulator:: WriteStream on: (String new: 20).
	nestLevel:: 0.
	[lookahead ~= aCharacter or: [nestLevel > 0]] whileTrue: 
			[#epsilon = lookahead ifTrue: [self signalParseError: aString].
			accumulator nextPut: lookahead.
			lookahead = anotherCharacter ifTrue: [nestLevel:: nestLevel + 1].
			lookahead = aCharacter ifTrue: [nestLevel:: nestLevel - 1].
			self next].
	^accumulator contents
)

match: aCharacter = (
	"<aCharacter> MUST match the current lookeahead.
	If this is the case, advance the input. Otherwise, blow up."

	aCharacter ~= lookahead 
		ifTrue: [^self signalParseError].	"does not return"
	self next
)

next = (
	"Advance the input storing the just read character
	as the lookahead."

	input atEnd
		ifTrue: [lookahead:: #epsilon]
		ifFalse: [lookahead:: input next]
)

signalParseError = (
	self class signalSyntaxException: 'Regex syntax error'
)

signalParseError: aString = (
	self class signalSyntaxException: aString
)

'recursive descent'
atom = (
	"An atom is one of a lot of possibilities, see below."

	| atom |
	(lookahead = #epsilon or: 
			[lookahead = $| or: 
					[lookahead = $)
						or: [lookahead = $* or: [lookahead = $+ or: [lookahead = $?]]]]])
		ifTrue: [^RxsEpsilon new].
	lookahead = $( ifTrue: 
			["<atom> ::= '(' <regex> ')' "

			self match: $(.
			atom:: self regex.
			self match: $).
			^atom].
	lookahead = $[ ifTrue: 
			["<atom> ::= '[' <characterSet> ']' "

			self match: $[.
			atom:: self characterSet.
			self match: $].
			^atom].
	lookahead = $: ifTrue: 
			["<atom> ::= ':' <messagePredicate> ':' "

			self match: $:.
			atom:: self messagePredicate.
			self match: $:.
			^atom].
	lookahead = $. ifTrue: 
			["any non-whitespace character"

			self next.
			^RxsContextCondition new beAny].
	lookahead = $^ ifTrue: 
			["beginning of line condition"

			self next.
			^RxsContextCondition new beBeginningOfLine].
	lookahead = $$ ifTrue: 
			["end of line condition"

			self next.
			^RxsContextCondition new beEndOfLine].
	lookahead = $\ ifTrue: 
			["<atom> ::= '\' <character>"
			self next.
			lookahead = #epsilon ifTrue: 
				[self signalParseError: 'bad quotation'].
			(BackslashConstants includesKey: lookahead) ifTrue:
				[atom:: RxsCharacter with: (BackslashConstants at: lookahead).
				self next.
				^atom].
			self ifSpecial: lookahead
				then: [:node | self next. ^node]].
	"If passed through the above, the following is a regular character."
	atom:: RxsCharacter with: lookahead.
	self next.
	^atom
)

branch = (
	"<branch> ::= e | <piece> <branch>"

	| piece branch |
	piece:: self piece.
	(lookahead = #epsilon or: [lookahead = $| or: [lookahead = $) ]])
		ifTrue: [branch:: nil]
		ifFalse: [branch:: self branch].
	^RxsBranch piece: piece branch: branch
)

characterSet = (
	"Match a range of characters: something between `[' and `]'.
	Opening bracked has already been seen, and closing should
	not be consumed as well. Set spec is as usual for
	sets in regexes."

	| spec errorMessage |
	errorMessage:: ' no terminating "]"'.
	spec:: self inputUpTo: $] nestedOn: $[ errorMessage: errorMessage.
	(spec isEmpty or: [spec = '^']) ifTrue: "This ']' was literal."
		[self next.
		spec:: spec, ']', (self inputUpTo: $] nestedOn: $[ errorMessage: errorMessage)].
	^self characterSetFrom: spec
)

messagePredicate = (
	"Match a message predicate specification: a selector (presumably
	understood by a Character) enclosed in :'s ."

	| spec negated |
	spec:: (self inputUpTo: $: errorMessage: ' no terminating ":"').
	negated:: false.
	spec first = $^ ifTrue:
		[negated:: true.
		spec:: spec copyFrom: 2 to: spec size].
	^RxsMessagePredicate selector: spec asSymbol negated: negated
)

) : (
'as yet unclassified'
initialize = (
	initializeExceptions.
	initializeBackslashConstants.
	initializeBackslashSpecials.
)

initializeBackslashConstants = (

	(BackslashConstants:: Dictionary new).
	BackslashConstants
		at: $e put: Character escape;
		at: $n put: Character lf;
		at: $r put: Character cr;
		at: $f put: Character newPage;
		at: $t put: Character tab
)

initializeBackslashSpecials = (
	"Keys are characters that normally follow a \, the values are
	associations of classes and initialization selectors on the instance side
	of the classes."
	"self initializeBackslashSpecials"

	(BackslashSpecials:: Dictionary new).
	BackslashSpecials 
		at: $w put: (Association key: RxsPredicate value: #beWordConstituent);
		at: $W put: (Association key: RxsPredicate value: #beNotWordConstituent);
		at: $s put: (Association key: RxsPredicate value: #beSpace);
		at: $S put: (Association key: RxsPredicate value: #beNotSpace);
		at: $d put: (Association key: RxsPredicate value: #beDigit);
		at: $D put: (Association key: RxsPredicate value: #beNotDigit);
		at: $b put: (Association key: RxsContextCondition value: #beWordBoundary);
		at: $B put: (Association key: RxsContextCondition value: #beNonWordBoundary);
		at: $< put: (Association key: RxsContextCondition value: #beBeginningOfWord);
		at: $> put: (Association key: RxsContextCondition value: #beEndOfWord)
)

initializeExceptions = (
	"self initializeExceptions"

"	I'm not sure how to port this:

	| parentSignal |
	ExceptionObjects := (Dictionary new: 4).
	ExceptionObjects
		at: #regexErrorSignal
		put: (parentSignal := Object errorSignal newSignal
			notifierString: 'Regex error - ';
			nameClass: self message: #regexErrorSignal);

		at: #syntaxErrorSignal
		put: (parentSignal newSignal
			notifierString: 'Regex syntax error - ';
			nameClass: self message: #syntaxErrorSignal);

		at: #compilationErrorSignal
		put: (parentSignal newSignal
			notifierString: 'Regex compilation error - ';
			nameClass: self message: #compilationErrorSignal);

		at: #matchErrorSignal
		put: (parentSignal newSignal
			notifierString: 'Regex matching error - ';
			nameClass: self message: #matchErrorSignal)"
)

'documentation'
a:_ introduction:__ = (
" 
A regular expression is a template specifying a class of strings. A
regular expression matcher is an tool that determines whether a string
belongs to a class specified by a regular expression.  This is a
common task of a user input validation code, and the use of regular
expressions can GREATLY simplify and speed up development of such
code.  As an example, here is how to verify that a string is a valid
hexadecimal number in Smalltalk notation, using this matcher package:

	aString matchesRegex: '16r[[:xdigit:]]+'

(Coding the same ``the hard way'' is an exercise to a curious reader).

This matcher is offered to the Smalltalk community in hope it will be
useful. It is free in terms of money, and to a large extent--in terms
of rights of use. Refer to `Boring Stuff' section for legalese.

The 'What's new in this release' section describes the functionality
introduced in 1.1 release.

The `Syntax' section explains the recognized syntax of regular
expressions.

The `Usage' section explains matcher capabilities that go beyond what
String>>matchesRegex: method offers.

The `Implementation notes' sections says a few words about what is
under the hood.

Happy hacking,

--Vassili Bykov 
<vassili@objectpeople.com> <vassili@magma.ca>

August 6, 1996
April 4, 1999
"

	self error: 'comment only'
)

b:_ whatsNewInThisRelease: __ = (
"
VERSION 1.2.3 (November 2007)

1. Regexs with ^ or $ applied to copy empty strings caused infinite loops, e.g. ('' copyWithRegex: '^.*$' matchesReplacedWith: 'foo'). Applied a similar correction to that from version 1.1c, to #copyStream:to:(replacingMatchesWith:|translatingMatchesUsing:).
2. Extended RxParser testing to run each test for #copy:translatingMatchesUsing: as well as #search:.
3. Corrected #testSuite test that a dot does not match a null, which was passing by luck with Smalltalk code in a literal array.
4. Added test to end of test suite for fix 1 above.

VERSION 1.2.2 (November 2006)

There was no way to specify a backslash in a character set. Now [\\] is accepted.

VERSION 1.2.1	(August 2006)

1. Support for returning all ranges (startIndex to: stopIndex) matching a regex - #allRangesOfRegexMatches:, #matchingRangesIn:
2. Added hint to usage documentation on how to get more information about matches when enumerating
3. Syntax description of dot corrected: matches anything but NUL since 1.1a

VERSION 1.2	(May 2006)

Fixed case-insensitive search for character sets.

VERSION 1.1c	(December 2004)

Fixed the issue with #matchesOnStream:do: which caused infinite loops for matches 
that matched empty strings.

VERSION 1.1b	(November 2001)

Changes valueNowOrOnUnwindDo: to ensure:, plus incorporates some earlier fixes.

VERSION 1.1a	(May 2001)

1. Support for keeping track of multiple subexpressions.
2. Dot (.) matches anything but NUL character, as it should per POSIX spec.
3. Some bug fixes.

VERSION 1.1	(October 1999)

Regular expression syntax corrections and enhancements:

1. Backslash escapes similar to those in Perl are allowed in patterns:

	\w	any word constituent character (equivalent to [a-zA-Z0-9_])
	\W	any character but a word constituent (equivalent to [^a-xA-Z0-9_]
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character
	\S	anything but a whitespace character
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

For example, '\w+' is now a valid expression matching any word.

2. The following backslash escapes are also allowed in character sets
(between square brackets):

	\w, \W, \d, \D, \s, and \S.

3. The following grep(1)-compatible named character classes are
recognized in character sets as well:

	[:alnum:]
	[:alpha:]
	[:cntrl:]
	[:digit:]
	[:graph:]
	[:lower:]
	[:print:]
	[:punct:]
	[:space:]
	[:upper:]
	[:xdigit:]

For example, the following patterns are equivalent:

	'[[:alnum:]]+' '\w+'  '[\w]+' '[a-zA-Z0-9_]+'

4. Some non-printable characters can be represented in regular
expressions using a common backslash notation:

	\t	tab (Character tab)
	\n	newline (Character lf)
	\r	carriage return (Character cr)
	\f	form feed (Character newPage)
	\e	escape (Character esc)

5. A dot is corectly interpreted as 'any character but a newline'
instead of 'anything but whitespace'.

6. Case-insensitive matching.  The easiest access to it are new
messages CharacterArray understands: #asRegexIgnoringCase,
#matchesRegexIgnoringCase:, #prefixMatchesRegexIgnoringCase:.

7. The matcher (an instance of RxMatcher, the result of
String>>asRegex) now provides a collection-like interface to matches
in a particular string or on a particular stream, as well as
substitution protocol. The interface includes the following messages:

	matchesIn: aString
	matchesIn: aString collect: aBlock
	matchesIn: aString do: aBlock

	matchesOnStream: aStream
	matchesOnStream: aStream collect: aBlock
	matchesOnStream: aStream do: aBlock

	copy: aString translatingMatchesUsing: aBlock
	copy: aString replacingMatchesWith: replacementString

	copyStream: aStream to: writeStream translatingMatchesUsing: aBlock
	copyStream: aStream to: writeStream replacingMatchesWith: aString

Examples:

	'\w+' asRegex matchesIn: 'now is the time'

returns an OrderedCollection containing four strings: 'now', 'is',
'the', and 'time'.

	'\<t\w+' asRegexIgnoringCase
		copy: 'now is the Time'
		translatingMatchesUsing: [:match | match asUppercase]

returns 'now is THE TIME' (the regular expression matches words
beginning with either an uppercase or a lowercase T).

ACKNOWLEDGEMENTS

Since the first release of the matcher, thanks to the input from
several fellow Smalltalkers, I became convinced a native Smalltalk
regular expression matcher was worth the effort to keep it alive. For
the contributions, suggestions, and bug reports that made this release 
possible, I want to thank:

	Felix Hack
	Peter Hatch
	Alan Knight
	Eliot Miranda
	Thomas Muhr
	Robb Shecter
	David N. Smith
	Francis Wolinski

and anyone whom I haven't yet met or heard from, but who agrees this
has not been a complete waste of time.

--Vassili Bykov
October 3, 1999
"

	self error: 'comment only'
)

c:_ syntax:__ = (
" 

[You can select and `print it' examples in this method. Just don't
forget to cancel the changes.]

The simplest regular expression is a single character.  It matches
exactly that character. A sequence of characters matches a string with
exactly the same sequence of characters:

	'a' matchesRegex: 'a'				-- true
	'foobar' matchesRegex: 'foobar'		-- true
	'blorple' matchesRegex: 'foobar'		-- false

The above paragraph introduced a primitive regular expression (a
character), and an operator (sequencing). Operators are applied to
regular expressions to produce more complex regular expressions.
Sequencing (placing expressions one after another) as an operator is,
in a certain sense, `invisible'--yet it is arguably the most common.

A more `visible' operator is Kleene closure, more often simply
referred to as `a star'.  A regular expression followed by an asterisk
matches any number (including 0) of matches of the original
expression. For example:

	'ab' matchesRegex: 'a*b'		 		-- true
	'aaaaab' matchesRegex: 'a*b'	 	-- true
	'b' matchesRegex: 'a*b'		 		-- true
	'aac' matchesRegex: 'a*b'	 		-- false: b does not match

A star's precedence is higher than that of sequencing. A star applies
to the shortest possible subexpression that precedes it. For example,
'ab*' means `a followed by zero or more occurrences of b', not `zero
or more occurrences of ab':

	'abbb' matchesRegex: 'ab*'	 		-- true
	'abab' matchesRegex: 'ab*'		 	-- false

To actually make a regex matching `zero or more occurrences of ab',
`ab' is enclosed in parentheses:

	'abab' matchesRegex: '(ab)*'		 	-- true
	'abcab' matchesRegex: '(ab)*'	 	-- false: c spoils the fun

Two other operators similar to `*' are `+' and `?'. `+' (positive
closure, or simply `plus') matches one or more occurrences of the
original expression. `?' (`optional') matches zero or one, but never
more, occurrences.

	'ac' matchesRegex: 'ab*c'	 		-- true
	'ac' matchesRegex: 'ab+c'	 		-- false: need at least one b
	'abbc' matchesRegex: 'ab+c'		 	-- true
	'abbc' matchesRegex: 'ab?c'		 	-- false: too many b's

As we have seen, characters `*', `+', `?', `(', and `)' have special
meaning in regular expressions. If one of them is to be used
literally, it should be quoted: preceded with a backslash. (Thus,
backslash is also special character, and needs to be quoted for a
literal match--as well as any other special character described
further).

	'ab*' matchesRegex: 'ab*'		 	-- false: star in the right string is special
	'ab*' matchesRegex: 'ab\*'	 		-- true
	'a\c' matchesRegex: 'a\\c'		 	-- true

The last operator is `|' meaning `or'. It is placed between two
regular expressions, and the resulting expression matches if one of
the expressions matches. It has the lowest possible precedence (lower
than sequencing). For example, `ab*|ba*' means `a followed by any
number of b's, or b followed by any number of a's':

	'abb' matchesRegex: 'ab*|ba*'	 	-- true
	'baa' matchesRegex: 'ab*|ba*'	 	-- true
	'baab' matchesRegex: 'ab*|ba*'	 	-- false

A bit more complex example is the following expression, matching the
name of any of the Lisp-style `car', `cdr', `caar', `cadr',
... functions:

	c(a|d)+r

It is possible to write an expression matching an empty string, for
example: `a|'.  However, it is an error to apply `*', `+', or `?' to
such expression: `(a|)*' is an invalid expression.

So far, we have used only characters as the 'smallest' components of
regular expressions. There are other, more `interesting', components.

A character set is a string of characters enclosed in square
brackets. It matches any single character if it appears between the
brackets. For example, `[01]' matches either `0' or `1':

	'0' matchesRegex: '[01]'		 		-- true
	'3' matchesRegex: '[01]'		 		-- false
	'11' matchesRegex: '[01]'		 		-- false: a set matches only one character

Using plus operator, we can build the following binary number
recognizer:

	'10010100' matchesRegex: '[01]+'	 	-- true
	'10001210' matchesRegex: '[01]+'	 	-- false

If the first character after the opening bracket is `^', the set is
inverted: it matches any single character *not* appearing between the
brackets:

	'0' matchesRegex: '[^01]'		  		-- false
	'3' matchesRegex: '[^01]'		 		-- true

For convenience, a set may include ranges: pairs of characters
separated with `-'. This is equivalent to listing all characters
between them: `[0-9]' is the same as `[0123456789]'.

Special characters within a set are `^', `-', and `]' that closes the
set. Below are the examples of how to literally use them in a set:

	[01^]		-- put the caret anywhere except the beginning
	[01-]		-- put the dash as the last character
	[]01]		-- put the closing bracket as the first character 
	[^]01]			(thus, empty and universal sets cannot be specified)

Regular expressions can also include the following backquote escapes
to refer to popular classes of characters:

	\w	any word constituent character (same as [a-zA-Z0-9_])
	\W	any character but a word constituent
	\d	a digit (same as [0-9])
	\D	anything but a digit
	\s 	a whitespace character
	\S	anything but a whitespace character

These escapes are also allowed in character classes: '[\w+-]' means
'any character that is either a word constituent, or a plus, or a
minus'.

Character classes can also include the following grep(1)-compatible
elements to refer to:

	[:alnum:]		any alphanumeric, i.e., a word constituent, character
	[:alpha:]		any alphabetic character
	[:cntrl:]		any control character. In this version, it means any character which code is < 32.
	[:digit:]		any decimal digit.
	[:graph:]		any graphical character. In this version, this mean any character with the code >= 32.
	[:lower:]		any lowercase character
	[:print:]		any printable character. In this version, this is the same as [:cntrl:]
	[:punct:]		any punctuation character.
	[:space:]		any whitespace character.
	[:upper:]		any uppercase character.
	[:xdigit:]		any hexadecimal character.

Note that these elements are components of the character classes,
i.e. they have to be enclosed in an extra set of square brackets to
form a valid regular expression.  For example, a non-empty string of
digits would be represented as '[[:digit:]]+'.

The above primitive expressions and operators are common to many
implementations of regular expressions. The next primitive expression
is unique to this Smalltalk implementation.

A sequence of characters between colons is treated as a unary selector
which is supposed to be understood by Characters. A character matches
such an expression if it answers true to a message with that
selector. This allows a more readable and efficient way of specifying
character classes. For example, `[0-9]' is equivalent to `:isDigit:',
but the latter is more efficient. Analogously to character sets,
character classes can be negated: `:^isDigit:' matches a Character
that answers false to #isDigit, and is therefore equivalent to
`[^0-9]'.

As an example, so far we have seen the following equivalent ways to
write a regular expression that matches a non-empty string of digits:

	'[0-9]+'
	'\d+'
	'[\d]+'
	'[[:digit::]+'
	:isDigit:+'

The last group of special primitive expressions includes: 

	.	matching any character except a NULL; 
	^	matching an empty string at the beginning of a line; 
	$	matching an empty string at the end of a line.
	\b	an empty string at a word boundary
	\B	an empty string not at a word boundary
	\<	an empty string at the beginning of a word
	\>	an empty string at the end of a word

	'axyzb' matchesRegex: 'a.+b'		-- true
	'ax zb' matchesRegex: 'a.+b'			-- true (space is matched by `.')
	'ax
zb' matchesRegex: 'a.+b'				-- true (carriage return is matched by `.')

Again, the dot ., caret ^ and dollar $ characters are special and should be quoted
to be matched literally.

	EXAMPLES

As the introductions said, a great use for regular expressions is user
input validation. Following are a few examples of regular expressions
that might be handy in checking input entered by the user in an input
field. Try them out by entering something between the quotes and
print-iting. (Also, try to imagine Smalltalk code that each validation
would require if coded by hand).  Most example expressions could have
been written in alternative ways.

Checking if aString may represent a nonnegative integer number:

	'' matchesRegex: ':isDigit:+'
or
	'' matchesRegex: '[0-9]+'
or
	'' matchesRegex: '\d+'

Checking if aString may represent an integer number with an optional
sign in front:

	'' matchesRegex: '(\+|-)?\d+'

Checking if aString is a fixed-point number, with at least one digit
is required after a dot:

	'' matchesRegex: '(\+|-)?\d+(\.\d+)?'

The same, but allow notation like `123.':

	'' matchesRegex: '(\+|-)?\d+(\.\d*)?'

Recognizer for a string that might be a name: one word with first
capital letter, no blanks, no digits.  More traditional:

	'' matchesRegex: '[A-Z][A-Za-z]*'

more Smalltalkish:

	'' matchesRegex: ':isUppercase::isAlphabetic:*'

A date in format MMM DD, YYYY with any number of spaces in between, in
XX century:

	'' matchesRegex: '(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(\d\d?)[ ]*,[ ]*19(\d\d)'

Note parentheses around some components of the expression above. As
`Usage' section shows, they will allow us to obtain the actual strings
that have matched them (i.e. month name, day number, and year number).

For dessert, coming back to numbers: here is a recognizer for a
general number format: anything like 999, or 999.999, or -999.999e+21.

	'' matchesRegex: '(\+|-)?\d+(\.\d*)?((e|E)(\+|-)?\d+)?'

"

	self error: 'comment only'
)

d:_ usage:__ = (
" 
The preceding section covered the syntax of regular expressions. It
used the simplest possible interface to the matcher: sending
#matchesRegex: message to the sample string, with regular expression
string as the argument.  This section explains hairier ways of using
the matcher.

	PREFIX MATCHING AND CASE-INSENSITIVE MATCHING

A CharacterArray (an EsString in VA) also understands these messages:

	#prefixMatchesRegex: regexString
	#matchesRegexIgnoringCase: regexString
	#prefixMatchesRegexIgnoringCase: regexString

#prefixMatchesRegex: is just like #matchesRegex, except that the whole
receiver is not expected to match the regular expression passed as the
argument; matching just a prefix of it is enough.  For example:

	'abcde' matchesRegex: '(a|b)+'		-- false
	'abcde' prefixMatchesRegex: '(a|b)+'	-- true

The last two messages are case-insensitive versions of matching.

	ENUMERATION INTERFACE

An application can be interested in all matches of a certain regular
expression within a String.  The matches are accessible using a
protocol modelled after the familiar Collection-like enumeration
protocol:

	#regex: regexString matchesDo: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string.

	#regex: regexString matchesCollect: aBlock

Evaluates a one-argument <aBlock> for every match of the regular
expression within the receiver string. Collects results of evaluations
and anwers them as a SequenceableCollection.

	#allRegexMatches: regexString

Returns a collection of all matches (substrings of the receiver
string) of the regular expression.  It is an equivalent of <aString
regex: regexString matchesCollect: [:each | each]>.

	#allRangesOfRegexMatches: regexString

Returns a collection of all character ranges (startIndex to: stopIndex)
that match the regular expression.

	REPLACEMENT AND TRANSLATION

It is possible to replace all matches of a regular expression with a
certain string using the message:

	#copyWithRegex: regexString matchesReplacedWith: aString

For example:

	'ab cd ab' copyWithRegex: '(a|b)+' matchesReplacedWith: 'foo'

A more general substitution is match translation:

	#copyWithRegex: regexString matchesTranslatedUsing: aBlock

This message evaluates a block passing it each match of the regular
expression in the receiver string and answers a copy of the receiver
with the block results spliced into it in place of the respective
matches.  For example:

	'ab cd ab' copyWithRegex: '(a|b)+' matchesTranslatedUsing: [:each | each asUppercase]

All messages of enumeration and replacement protocols perform a
case-sensitive match.  Case-insensitive versions are not provided as
part of a CharacterArray protocol.  Instead, they are accessible using
the lower-level matching interface.

	LOWER-LEVEL INTERFACE

Internally, #matchesRegex: works as follows:

1. A fresh instance of RxParser is created, and the regular expression
string is passed to it, yielding the expression's syntax tree.

2. The syntax tree is passed as an initialization parameter to an
instance of RxMatcher. The instance sets up some data structure that
will work as a recognizer for the regular expression described by the
tree.

3. The original string is passed to the matcher, and the matcher
checks for a match.

	THE MATCHER

If you repeatedly match a number of strings against the same regular
expression using one of the messages defined in CharacterArray, the
regular expression string is parsed and a matcher is created anew for
every match.  You can avoid this overhead by building a matcher for
the regular expression, and then reusing the matcher over and over
again. You can, for example, create a matcher at a class or instance
initialization stage, and store it in a variable for future use.

You can create a matcher using one of the following methods:

	- Sending #forString:ignoreCase: message to RxMatcher class, with
the regular expression string and a Boolean indicating whether case is
ignored as arguments.

	- Sending #forString: message.  It is equivalent to <... forString:
regexString ignoreCase: false>.

A more convenient way is using one of the two matcher-created messages
understood by CharacterArray.

	- <regexString asRegex> is equivalent to <RxMatcher forString:
regexString>.

	- <regexString asRegexIgnoringCase> is equivalent to <RxMatcher
forString: regexString ignoreCase: true>.

Here are four examples of creating a matcher:

	hexRecognizer := RxMatcher forString: '16r[0-9A-Fa-f]+'
	hexRecognizer := RxMatcher forString: '16r[0-9A-Fa-f]+' ignoreCase: false
	hexRecognizer := '16r[0-9A-Fa-f]+' asRegex
	hexRecognizer := '16r[0-9A-F]+' asRegexIgnoringCase

	MATCHING

The matcher understands these messages (all of them return true to
indicate successful match or search, and false otherwise):

matches: aString

	True if the whole target string (aString) matches.

matchesPrefix: aString

	True if some prefix of the string (not necessarily the whole
	string) matches.

search: aString

	Search the string for the first occurrence of a matching
	substring. (Note that the first two methods only try matching from
	the very beginning of the string). Using the above example with a
	matcher for `a+', this method would answer success given a string
	`baaa', while the previous two would fail.

matchesStream: aStream
matchesStreamPrefix: aStream
searchStream: aStream

	Respective analogs of the first three methods, taking input from a
	stream instead of a string. The stream must be positionable and
	peekable.

All these methods answer a boolean indicating success. The matcher
also stores the outcome of the last match attempt and can report it:

lastResult

	Answers a Boolean -- the outcome of the most recent match
	attempt. If no matches were attempted, the answer is unspecified.

	SUBEXPRESSION MATCHES

After a successful match attempt, you can query the specifics of which
part of the original string has matched which part of the whole
expression.

A subexpression is a parenthesized part of a regular expression, or
the whole expression. When a regular expression is compiled, its
subexpressions are assigned indices starting from 1, depth-first,
left-to-right. For example, `((ab)+(c|d))?ef' includes the following
subexpressions with these indices:

	1:	((ab)+(c|d))?ef
	2:	(ab)+(c|d)
	3:	ab
	4:	c|d

After a successful match, the matcher can report what part of the
original string matched what subexpression. It understandards these
messages:

subexpressionCount

	Answers the total number of subexpressions: the highest value that
	can be used as a subexpression index with this matcher. This value
	is available immediately after initialization and never changes.

subexpression: anIndex

	An index must be a valid subexpression index, and this message
	must be sent only after a successful match attempt. The method
	answers a substring of the original string the corresponding
	subexpression has matched to.

subBeginning: anIndex
subEnd: anIndex

	Answer positions within the original string or stream where the
	match of a subexpression with the given index has started and
	ended, respectively.

This facility provides a convenient way of extracting parts of input
strings of complex format. For example, the following piece of code
uses the 'MMM DD, YYYY' date format recognizer example from the
`Syntax' section to convert a date to a three-element array with year,
month, and day strings (you can select and evaluate it right here):

	| matcher |
	matcher := RxMatcher forString: '(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(:isDigit::isDigit:?)[ ]*,[ ]*(19|20)(:isDigit::isDigit:)'.
	(matcher matches: 'Aug 6, 1996')
		ifTrue: 
			[Array 
				with: (matcher subexpression: 5)
				with: (matcher subexpression: 2)
				with: (matcher subexpression: 3)]
		ifFalse: ['no match']

(should answer ` #('96' 'Aug' '6')').

	ENUMERATION AND REPLACEMENT

The enumeration and replacement protocols exposed in CharacterArray
are actually implemented by the matcher.  The following messages are
understood:

	#matchesIn: aString
	#matchesIn: aString do: aBlock
	#matchesIn: aString collect: aBlock
	#copy: aString replacingMatchesWith: replacementString
	#copy: aString translatingMatchesUsing: aBlock
	#matchingRangesIn: aString

	#matchesOnStream: aStream
	#matchesOnStream: aStream do: aBlock
	#matchesOnStream: aStream collect: aBlock
	#copy: sourceStream to: targetStream replacingMatchesWith: replacementString
	#copy: sourceStream to: targetStream translatingMatchesWith: aBlock

Note that in those methods that take a block, the block may refer to the rxMatcher itself, 
e.g. to collect information about the position the match occurred at, or the
subexpressions of the match. An example can be seen in #matchingRangesIn:

	ERROR HANDLING

Exception signaling objects (Signals in VisualWorks, Exceptions in VisualAge) are
accessible through RxParser class protocol. To handle possible errors, use
the protocol described below to obtain the exception objects and use the
protocol of the native Smalltalk implementation to handle them.

If a syntax error is detected while parsing expression,
RxParser>>syntaxErrorSignal is raised/signaled.

If an error is detected while building a matcher,
RxParser>>compilationErrorSignal is raised/signaled.

If an error is detected while matching (for example, if a bad selector
was specified using `:<selector>:' syntax, or because of the matcher's
internal error), RxParser>>matchErrorSignal is raised

RxParser>>regexErrorSignal is the parent of all three.  Since any of
the three signals can be raised within a call to #matchesRegex:, it is
handy if you want to catch them all.  For example:

VisualWorks:

	RxParser regexErrorSignal
		handle: [:ex | ex returnWith: nil]
		do: ['abc' matchesRegex: '))garbage[']

VisualAge:

	['abc' matchesRegex: '))garbage[']
		when: RxParser regexErrorSignal
		do: [:signal | signal exitWith: nil]

"

	self error: 'comment only'
)

e:_ implementationNotes:__ = (
"	
	Version:		1.1
	Released:		October 1999
	Mail to:		Vassili Bykov <vassili@parcplace.com>, <v_bykov@yahoo.com>
	Flames to:		/dev/null

	WHAT IS ADDED

The matcher includes classes in two categories:
	VB-Regex-Syntax
	VB-Regex-Matcher
and a few CharacterArray methods in `VB-regex' protocol.  No system
classes or methods are modified.

	WHAT TO LOOK AT FIRST

String>>matchesRegex: -- in 90% cases this method is all you need to
access the package.

RxParser -- accepts a string or a stream of characters with a regular
expression, and produces a syntax tree corresponding to the
expression. The tree is made of instances of Rxs<whatever> classes.

RxMatcher -- accepts a syntax tree of a regular expression built by
the parser and compiles it into a matcher: a structure made of
instances of Rxm<whatever> classes. The RxMatcher instance can test
whether a string or a positionable stream of characters matches the
original regular expression, or search a string or a stream for
substrings matching the expression. After a match is found, the
matcher can report a specific string that matched the whole
expression, or any parenthesized subexpression of it.

All other classes support the above functionality and are used by
RxParser, RxMatcher, or both.

	CAVEATS

The matcher is similar in spirit, but NOT in the design--let alone the
code--to the original Henry Spencer's regular expression
implementation in C.  The focus is on simplicity, not on efficiency.
I didn't optimize or profile anything.  I may in future--or I may not:
I do this in my spare time and I don't promise anything.

The matcher passes H. Spencer's test suite (see 'test suite'
protocol), with quite a few extra tests added, so chances are good
there are not too many bugs.  But watch out anyway.

	EXTENSIONS, FUTURE, ETC.

With the existing separation between the parser, the syntax tree, and
the matcher, it is easy to extend the system with other matchers based
on other algorithms. In fact, I have a DFA-based matcher right now,
but I don't feel it is good enough to include it here.  I might add
automata-based matchers later, but again I don't promise anything.

	HOW TO REACH ME

As of today (December 20, 2000), you can contact me at
<vassili@parcplace.com>. If this doesn't work, look around
comp.lang.smalltalk or comp.lang.lisp.  
"

	self error: 'comment only'
)

f:_ boringStuff: __ = (
"
The Regular Expression Matcher (``The Software'') 
is Copyright (C) 1996, 1999 Vassili Bykov.  
It is provided to the Smalltalk community in hope it will be useful.

1. This license applies to the package as a whole, as well as to any
   component of it. By performing any of the activities described
   below, you accept the terms of this agreement.

2. The software is provided free of charge, and ``as is'', in hope
   that it will be useful, with ABSOLUTELY NO WARRANTY. The entire
   risk and all responsibility for the use of the software is with
   you.  Under no circumstances the author may be held responsible for
   loss of data, loss of profit, or any other damage resulting
   directly or indirectly from the use of the software, even if the
   damage is caused by defects in the software.

3. You may use this software in any applications you build.

4. You may distribute this software provided that the software
   documentation and copyright notices are included and intact.

5. You may create and distribute modified versions of the software,
   such as ports to other Smalltalk dialects or derived work, provided
   that: 

   a. any modified version is expressly marked as such and is not
   misrepresented as the original software; 

   b. credit is given to the original software in the source code and
   documentation of the derived work; 

   c. the copyright notice at the top of this document accompanies
   copyright notices of any modified version.  "

	self error: 'comment only'
)

'exception signaling'
doHandlingMessageNotUnderstood: aBlock = (
	"MNU should be trapped and resignaled as a match error in a few places in the matcher.
	This method factors out this dialect-dependent code to make porting easier."

	"^Object messageNotUnderstoodSignal
		handle:
			[:ex | ex restartDo:
					[RxParser signalMatchException: 'invalid predicate selector']]
		do: aBlock"

"	^[aBlock value] on: Exception do: [:ex | ex return: false]"

	^aBlock on: MessageNotUnderstood do: [:ex | MatchError signal: 'invalid predicate selector']

)

signalCompilationException: errorString = (
	^self compilationErrorSignal raiseErrorString: errorString
)

signalMatchException: errorString = (
	^self matchErrorSignal raiseErrorString: errorString
)

signalSyntaxException: errorString = (
	^self syntaxErrorSignal raiseErrorString: errorString
)

'preferences'
preferredMatcherClass = (
	"The matcher to use. For now just one is available, but in
	principle this determines the matchers built implicitly,
	such as by String>>asRegex, or String>>matchesRegex:.
	This might seem a bit strange place for this preference, but
	Parser is still more or less `central' thing in the whole package."

	^RxMatcher
)

'test suite'
compileRegex: regexSource into: matcherClass = (
	"Compile the regex and answer the matcher, or answer nil if compilation fails."

	| syntaxTree |
	syntaxTree:: self safelyParse: regexSource.
	syntaxTree == nil ifTrue: [^nil].
	^matcherClass for: syntaxTree
)

runProtocolTestsForMatcher: matcherClass = (
	| matcher |
	Transcript show: 'Testing matcher protocol...'.
	matcher:: matcherClass forString: '\w+'.
	(matcher matchesIn: 'now is the time') asArray = {'now'. 'is'. 'the'. 'time'}
		ifFalse: [self error: 'matchesIn: test failed'].
	(matcher copy: 'now is  the   time    ' translatingMatchesUsing: [:s | s reverse])
		= 'won si  eht   emit    '
		ifFalse: [self error: 'copy:translatingMatchesWith: test failed'].
	"See that the match context is preserved while copying stuff between matches:"
	((matcherClass forString: '\<\d\D+') 
		copy: '9aaa1bbb 8ccc'
		replacingMatchesWith: 'foo') = 'foo1bbb foo'
			ifFalse: [self error: 'test failed'].
	Transcript show: 'OK'; cr
)

runRegexTestsForMatcher: matcherClass = (
	"Run the whole suite of tests for the given matcher class. May blow up
	if anything goes wrong with the matcher or parser. Since this is a 
	developer's tool, who cares?"
	"self runRegexTestsForMatcher: RxMatcher"

	| failures |
	failures:: 0.
	Transcript cr.
	self testSuite do: [:clause |
		| rxSource matcher isOK |
		rxSource:: clause first.
		Transcript show: 'Testing regex: '; show: rxSource printString; cr.
		matcher:: self compileRegex: rxSource into: matcherClass.
		matcher == nil
			ifTrue:
				[(clause at: 2) isNil
					ifTrue: 
						[Transcript tab; show: 'Compilation error as expected (ok)'; cr]
					ifFalse: 
						[Transcript tab; 
							show: 'Compilation error, UNEXPECTED -- FAILED'; cr.
						failures:: failures + 1]]
			ifFalse:
				[(clause at: 2) == nil
					ifTrue: 
						[Transcript tab;
							show: 'Compilation succeeded, should have failed -- FAILED!';
							cr.
						failures:: failures + 1]
					ifFalse:
						[2 to: clause size by: 3 do: 
							[:i |
							isOK:: self
								test: matcher
								with: (clause at: i)
								expect: (clause at: i + 1)
								withSubexpressions: (clause at: i + 2).
							isOK ifFalse: [failures:: failures + 1].
							Transcript 
								show: (isOK ifTrue: [' (ok).'] ifFalse: [' -- FAILED!']);
								cr]]]].
	failures = 0
		ifTrue: [Transcript show: 'PASSED ALL TESTS.'; cr]
		ifFalse: [Transcript show: failures printString, ' TESTS FAILED!'; cr]
)

runTestsForMatcher: matcherClass = (
	"Run the whole suite of tests for the given matcher class. May blow up
	if something goes wrong with the matcher or the parser. Since this is a 
	developer's tool, who cares?"
	"self runTestsForMatcher: RxMatcher"

	self
		runRegexTestsForMatcher: matcherClass;
		runProtocolTestsForMatcher: matcherClass
)

test: aMatcher with: testString expect: expected withSubexpressions: subexpr = (

	| copy got |
	Transcript tab; 
		show: 'Matching: ';
		show: testString printString.
	copy:: aMatcher copy: testString translatingMatchesUsing: [:s | s].
	copy ~= testString ifTrue:
		[Transcript show: ' (copy failed: "', copy, '")'.
		^false].
	Transcript
		show: ' expected: '; 
		show: expected printString;
		show: ' got: '.
	got:: aMatcher search: testString.
	Transcript show: got printString.
	got ~= expected
		ifTrue: [^false].
	(subexpr notNil and: [aMatcher supportsSubexpressions])
		ifFalse:
			[^true]
		ifTrue:
			[ | isOK |
			isOK:: true.
			1 to: subexpr size by: 2 do: [: i |
				| sub subExpect subGot |
				sub:: subexpr at: i.
				subExpect:: subexpr at: i + 1.
				subGot:: aMatcher subexpression: sub.
				Transcript cr; tab; tab;
					show: 'Subexpression: ', sub printString;
					show: ' expected: ';
					show: subExpect printString;
					show: ' got: ';
					show: subGot printString.
				subExpect ~= subGot
					ifTrue: 
					[Transcript show: ' -- MISMATCH'.
					isOK:: false]].
			^isOK]
)

'utilities'
parse: aString = (
	"Parse the argument and return the result (the parse tree).
	In case of a syntax error, the corresponding exception is signaled."

	^self new parse: aString
)

safelyParse: aString = (
	"Parse the argument and return the result (the parse tree).
	In case of a syntax error, return nil.
	Exception handling here is dialect-dependent."

	^self syntaxErrorSignal
		handle: [:ex | ex returnWith: nil]
		do: [self new parse: aString]
)

)

class RxsCharSet elements: aCollection negated: aBoolean = RxsNode (
"
A character set corresponds to a [...] construct in the regular expression.

Instance variables:
	elements	<OrderedCollection> An element can be one of: RxsCharacter, RxsRange, or RxsPredicate.
	negated		<Boolean>"
|
	negated::= aBoolean.
	elements::= aCollection.
|
)
('accessing'
dispatchTo: aMatcher = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxCharSet: self
)

hasPredicates = (

	^elements contains: [:some | some isEnumerable not]
)

predicateIgnoringCase: aBoolean = (

	| predicate enumerable |
	enumerable:: self enumerablePartPredicateIgnoringCase: aBoolean.
	^self hasPredicates
		ifFalse: [enumerable]
		ifTrue:
			[predicate:: self predicatePartPredicate.
			negated
				ifTrue: [[:char | (enumerable value: char) and: [predicate value: char]]]
				ifFalse: [[:char | (enumerable value: char) or: [predicate value: char]]]]
)

predicates = (

	^(elements reject: [:some | some isEnumerable])
		collect: [:each | each predicate]
)

'privileged'
enumerablePartPredicateIgnoringCase: aBoolean = (

	| enumeration |
	enumeration:: self optimalSetIgnoringCase: aBoolean.
	^negated
		ifTrue: [[:char | (enumeration includes: char) not]]
		ifFalse: [[:char | enumeration includes: char]]
)

enumerableSetIgnoringCase: aBoolean = (
	"Answer a collection of characters that make up the portion of me
	that can be enumerated."

	| set |
	set:: Set new.
	elements do:
		[:each |
		each isEnumerable ifTrue:
			[each enumerateTo: set ignoringCase: aBoolean]].
	^set
)

optimalSetIgnoringCase: aBoolean = (
	"Assuming the client with search the `set' using #includes:,
	answer a collection with the contents of `set', of the class
	that will provide the fastest lookup. Strings are faster than
	Sets for short strings."

	| set |
	set:: self enumerableSetIgnoringCase: aBoolean.
	"fails: quirk btwn VW and Sq?
	^set size < 10
		ifTrue: [String withAll: set]
		ifFalse: [set]"
	^set
)

predicatePartPredicate = (
	"Answer a predicate that tests all of my elements that cannot be
	enumerated."

	| predicates |
	predicates:: elements reject: [:some | some isEnumerable].
	predicates isEmpty
		ifTrue: [^[:char | negated]].
	predicates size = 1
		ifTrue: [^negated
			ifTrue: [predicates first predicateNegation]
			ifFalse: [predicates first predicate]].
	predicates:: predicates collect: [:each | each predicate].
	^negated
		ifFalse:
			[[:char | predicates contains: [:some | some value: char]]]
		ifTrue:
			[[:char | (predicates contains: [:some | some value: char]) not]]
)

'testing'
isEnumerable = (

	elements detect: [:some | some isEnumerable not] ifNone: [^true].
	^false
)

isNegated = (

	^negated
)

)

class MatchError = RegexError ("Regex matching error")
()

class RxmPredicate = RxmLink (
"Instance holds onto a one-argument block and matches exactly one character if the block evaluates to true when passed the character as the argument.

Instance variables:
	predicate		<BlockClosure>"
|
	predicateS
|
)
('initialize-release'
bePerform: aSelector = (
	"Match any single character that answers true  to this message."

	self predicate: 
		[:char | 
		RxParser doHandlingMessageNotUnderstood: [char perform: aSelector]]
)

bePerformNot: aSelector = (
	"Match any single character that answers false to this message."

	self predicate: 
		[:char | 
		RxParser doHandlingMessageNotUnderstood: [(char perform: aSelector) not]]
)

predicate: aBlock = (
	"This link will match any single character for which <aBlock>
	evaluates to true."

	aBlock numArgs ~= 1 ifTrue: [self error: 'bad predicate block'].
	predicateS:: aBlock.
	^self
)

'accessing'
predicate = ( ^predicateS)

'matching'
matchAgainst: aMatcher = (
	"Match if the predicate block evaluates to true when given the
	current stream character as the argument."

	| original |
	original:: aMatcher currentState.
	(aMatcher atEnd not 
		and: [(predicate value: aMatcher next)
			and: [next matchAgainst: aMatcher]])
		ifTrue: [^true]
		ifFalse:
			[aMatcher restoreState: original.
			^false]
)

) : (
'as yet unclassified'
with: unaryBlock = (
	^self new predicate: unaryBlock
)

)

class RxsRegex branch: b regex: r = RxsNode(
"The body of a parenthesized thing, or a top-level expression, also an atom.  

Instance variables:
	branch		<RxsBranch>
	regex		<RxsRegex | RxsEpsilon>"
|
	branch ::= b.
	regex ::= r.
|
)
('accessing'
dispatchTo: aMatcher = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxRegex: self
)

'testing'
isNullable = (

	^branch isNullable or: [regex notNil and: [regex isNullable]]
)

)

class RxmSubstring = RxmLink (
"Instance holds onto a string and matches exactly this string, and exactly once."
|
	sample compare
|
	self beCaseSensitive.
)
('initialize-release'
beCaseInsensitive = (
	compare:: [:char1 :char2 | char1 sameAs: char2]
)

beCaseSensitive = (
	compare:: [:char1 :char2 | char1 = char2]
)

character: aCharacter ignoreCase: aBoolean = (
	"Match exactly this character."

	sample:: String with: aCharacter.
	aBoolean ifTrue: [self beCaseInsensitive]
)

substring: aString ignoreCase: aBoolean = (
	"Match exactly this string."

	sample:: aString.
	aBoolean ifTrue: [self beCaseInsensitive]
)

'matching'
matchAgainst: aMatcher = (
	"Match if my sample stream is exactly the current prefix
	of the matcher stream's contents."

	| originalState sampleStream mismatch |
	originalState:: aMatcher currentState.
	sampleStream:: self sampleStream.
	mismatch:: false.
	[sampleStream atEnd
		or: [aMatcher atEnd
		or: [mismatch:: (compare value: sampleStream next value: aMatcher next) not]]] whileFalse.
	(mismatch not and: [sampleStream atEnd and: [next matchAgainst: aMatcher]])
		ifTrue: [^true]
		ifFalse: 
			[aMatcher restoreState: originalState.
			^false]
)

'private'
sampleStream = (
	^sample readStream
)

)

class RxmTerminator = (
"Instances of this class are used to terminate matcher's chains. When a match reaches this (an instance receives #matchAgainst: message), the match is considered to succeed. Instances also support building protocol of RxmLinks, with some restrictions."
||
)
('matching'
matchAgainst: aStream = (
	"If got here, the match is successful."
	^true
)

'building'
pointTailTo: anRxmLink = (
	"Branch tails are never redirected by the build algorithm.
	Healthy terminators should never receive this."

	CompilationError signal:
		'internal matcher build error - redirecting terminator tail'
)

terminateWith: aTerminator = (
	"Branch terminators are never supposed to change.
	Make sure this is the case."

	aTerminator ~~ self
		ifTrue: [CompilationError signal:
				'internal matcher build error - wrong terminator']
)

)

class RxmLink = (
"A matcher is built of a number of links interconnected into some intricate structure. Regardless of fancy stuff, any link (except for the terminator) has the next one. Any link can match against a stream of characters, recursively propagating the match to the next link. Any link supports a number of matcher-building messages. This superclass does all of the above. 

The class is not necessarily abstract. It may double as an empty string matcher: it recursively propagates the match to the next link, thus always matching nothing successfully.

Principal method:
	matchAgainst: aMatcher
		Any subclass will reimplement this to test the state of the matcher, most
		probably reading one or more characters from the matcher's stream, and
		either decide it has matched and answer true, leaving matcher stream
		positioned at the end of match, or answer false and restore the matcher
		stream position to whatever it was before the matching attempt.

Instance variables:
	next		<RxmLink | RxmTerminator> The next link in the structure."
|
	next
|
)
('building'
pointTailTo: anRxmLink = (
	"Propagate this message along the chain of links.
	Point `next' reference of the last link to <anRxmLink>.
	If the chain is already terminated, blow up."

	next == nil
		ifTrue: [next:: anRxmLink]
		ifFalse: [next pointTailTo: anRxmLink]
)

terminateWith: aTerminator = (
	"Propagate this message along the chain of links, and
	make aTerminator the `next' link of the last link in the chain.
	If the chain is already reminated with the same terminator, 
	do not blow up."

	next == nil
		ifTrue: [next:: aTerminator]
		ifFalse: [next terminateWith: aTerminator]
)

'matching'
matchAgainst: aMatcher = (
	"If a link does not match the contents of the matcher's stream,
	answer false. Otherwise, let the next matcher in the chain match."

	^next matchAgainst: aMatcher
)

)

class RxmBranch = RxmLink (
"This is a branch of a matching process. Either `next' chain should match, or `alternative', if not nil, should match. Since this is also used to build loopbacks to match repetitions, `loopback' variable indicates whether the instance is a loopback: it affects the matcher-building operations (which of the paths through the branch is to consider as the primary when we have to find the 'tail' of a matcher construct)."
|
	alternative loopback
|

	loopback:: false.
)
('building'
pointTailTo: aNode = (
	"See superclass for explanations."

	loopback
		ifTrue: [alternative == nil
			ifTrue: [alternative:: aNode]
			ifFalse: [alternative pointTailTo: aNode]]
		ifFalse: [super pointTailTo: aNode]
)

terminateWith: aNode = (
	"See superclass for explanations."

	loopback
		ifTrue: [alternative == nil
			ifTrue: [alternative:: aNode]
			ifFalse: [alternative terminateWith: aNode]]
		ifFalse: [super terminateWith: aNode]
)

'initialize-release'
beLoopback = (
	"See class comment for instance variable description."

	loopback:: true
)

'matching'
matchAgainst: aMatcher = (
	"Match either `next' or `alternative'. Fail if the alternative is nil."

	^(next matchAgainst: aMatcher)
		or: [alternative notNil
			and: [alternative matchAgainst: aMatcher]]
)

)

class RxsPiece atom: a min: mn max: mx = RxsNode (
"A piece is an atom, possibly optional or repeated a number of times.

Instance variables:
	atom	<RxsCharacter|RxsCharSet|RxsPredicate|RxsRegex|RxsSpecial>
	min		<Integer>
	max	<Integer|nil> nil means infinity"
|
	atom ::= a.
	min ::= mn.
	max ::= mx.
|
)
('accessing'
character = (
	"If this node is atomic, answer the character it
	represents. It is the caller's responsibility to make sure this
	node is indeed atomic before using this."

	^atom character
)

dispatchTo: aMatcher = (
	"Inform the matcher of the kind of the node, and it
	will do whatever it has to."

	^aMatcher syntaxPiece: self
)

'restricted'
isAtomic = (
	"A piece is atomic if only it contains exactly one atom
	which is atomic (sic)."

	^self isSingular and: [atom isAtomic]
)

'testing'
isNullable = (
	"A piece is nullable if it allows 0 matches. 
	This is often handy to know for optimization."

	^min = 0 or: [atom isNullable]
)

isOptional = (

	^min = 0 and: [max = 1]
)

isPlus = (

	^min = 1 and: [max == nil]
)

isSingular = (
	"A piece with a range is 1 to 1 needs can be compiled
	as a simple match."

	^min = 1 and: [max = 1]
)

isStar = (
	^min = 0 and: [max == nil]
)

) : (
'initialize-release'
atom: a = (
	"This piece is exactly one occurrence of the specified RxsAtom."

	^atom: a min: 1 max: 1
)

optionalAtom: a = (
	"This piece is 0 or 1 occurrences of the specified RxsAtom."

	^atom: a min: 0 max: 1
)

plusAtom: a = (
	"This piece is one or more occurrences of the specified RxsAtom."

	^atom: a min: 1 max: nil
)

starAtom: anAtom = (
	"This piece is any number of occurrences of the atom."

	^atom: anAtom min: 0 max: nil
)

)'as yet unclassified'
asRegex: aCharacterArray = (
	"Compile the receiver as a regex matcher. May raise RxParser>>syntaxErrorSignal
	or RxParser>>compilationErrorSignal.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^RxParser preferredMatcherClass for: (RxParser new parse: aCharacterArray)
)

asRegexIgnoringCase: aCharacterArray = (
	"Compile the receiver as a regex matcher. May raise RxParser>>syntaxErrorSignal
	or RxParser>>compilationErrorSignal.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^RxParser preferredMatcherClass
		for: (RxParser new parse: aCharacterArray)
		ignoreCase: true
)

string: aCharacterArray allRangesOfRegexMatches: rxString = (

	^(asRegex: rxString) matchingRangesIn: aCharacterArray
)

string: aCharacterArray allRegexMatches: rxString = (
	^(asRegex: rxString) matchesIn: self
)

string: aCharacterArray copyWithRegex: rxString matchesReplacedWith: aString = (

	^(asRegex: rxString)
		copy: aCharacterArray replacingMatchesWith: aString
)

string: aCharacterArray copyWithRegex: rxString matchesTranslatedUsing: aBlock = (

	^(asRegex: rxString)
		copy: aCharacterArray translatingMatchesUsing: aBlock
)

string: aCharacterArray matchesRegex: regexString = (
	"Test if the receiver matches a regex.  May raise RxParser>>regexErrorSignal or
	child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^(asRegex: regexString) matches: aCharacterArray
)

string: aCharacterArray matchesRegexIgnoringCase: regexString = (
	"Test if the receiver matches a regex.  May raise RxParser>>regexErrorSignal or
	child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^(asRegexIgnoringCase: regexString) matches: aCharacterArray
)

string: aCharacterArray prefixMatchesRegex: regexString = (
	"Test if the receiver's prefix matches a regex.	
	May raise RxParser class>>regexErrorSignal or child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^(asRegex: regexString) matchesPrefix: aCharacterArray
)

string: aCharacterArray prefixMatchesRegexIgnoringCase: regexString = (
	"Test if the receiver's prefix matches a regex.	
	May raise RxParser class>>regexErrorSignal or child signals.
	This is a part of the Regular Expression Matcher package, (c) 1996, 1999 Vassili Bykov.
	Refer to `documentation' protocol of RxParser class for details."

	^(asRegexIgnoringCase: regexString) matchesPrefix: aCharacterArray
)

string: aCharacterArray regex: rxString matchesCollect: aBlock = (

	^(asRegex: rxString) matchesIn: aCharacterArray collect: aBlock
)

string: aCharacterArray regex: rxString matchesDo: aBlock = (

	^(asRegex: rxString) matchesIn: aCharacterArray do: aBlock
)

)