Commits

Anonymous committed 5d5f94b

#416: Add support for Newspeak

  • Participants
  • Parent commits 8b70344
  • Branches trunk

Comments (0)

Files changed (3)

File pygments/lexers/other.py

            'BashLexer', 'BatchLexer', 'BefungeLexer', 'RedcodeLexer',
            'MOOCodeLexer', 'SmalltalkLexer', 'TcshLexer', 'LogtalkLexer',
            'GnuplotLexer', 'PovrayLexer', 'AppleScriptLexer',
-           'BashSessionLexer', 'ModelicaLexer', 'RebolLexer', 'ABAPLexer']
+           'BashSessionLexer', 'ModelicaLexer', 'RebolLexer', 'ABAPLexer',
+           'NewspeakLexer']
 
 line_re  = re.compile('.*?\n')
 
             (r'[/;:()\[\],\.]', Punctuation)
         ],
     }
+
+
+class NewspeakLexer(RegexLexer):
+    """
+    For `Newspeak <http://newspeaklanguage.org/>` syntax.
+    """
+    name = 'Newspeak'
+    filenames = ['*.ns2']
+    aliases = ['newspeak', ]
+    mimetypes = ['text/x-newspeak']
+
+    tokens = {
+       'root' : [
+           (r'\b(Newsqueak2)\b',Keyword.Declaration),
+           (r"'[^']*'",String),
+           (r'\b(class)(\s+)([a-zA-Z0-9_]+)(\s*)',
+            bygroups(Keyword.Declaration,Text,Name.Class,Text)),
+           (r'\b(mixin|self|super|private|public|protected|nil|true|false)\b',
+            Keyword),
+           (r'([a-zA-Z0-9_]+\:)(\s*)([a-zA-Z_]\w+)',
+            bygroups(Name.Function,Text,Name.Variable)),
+           (r'([a-zA-Z0-9_]+)(\s*)(=)',
+            bygroups(Name.Attribute,Text,Operator)),
+           (r'<[a-zA-Z0-9_]+>', Comment.Special),
+           include('expressionstat'),
+           include('whitespace')
+        ],
+
+       'expressionstat': [
+          (r'(\d+\.\d*|\.\d+|\d+[fF])[fF]?', Number.Float),
+          (r'\d+', Number.Integer),
+          (r':\w+',Name.Variable),
+          (r'(\w+)(::)', bygroups(Name.Variable, Operator)),
+          (r'\w+:', Name.Function),
+          (r'\w+', Name.Variable),
+          (r'\(|\)', Punctuation),
+          (r'\[|\]', Punctuation),
+          (r'\{|\}', Punctuation),
+
+          (r'(\^|\+|\/|~|\*|<|>|=|@|%|\||&|\?|!|,|-|:)', Operator),
+          (r'\.|;', Punctuation),
+          include('whitespace'),
+          include('literals'),
+       ],
+       'literals': [
+         (r'\$.', String),
+         (r"'[^']*'", String),
+         (r"#'[^']*'", String.Symbol),
+         (r"#\w+:?", String.Symbol),
+         (r"#(\+|\/|~|\*|<|>|=|@|%|\||&|\?|!|,|-)+", String.Symbol)
+
+       ],
+       'whitespace' : [
+         (r'\s+', Text),
+         (r'"[^"]*"', Comment)
+       ]
+    }
+

File 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)