NSPatternMatching.ns

Newspeak3
'NSPatternMatching'
class NSPatternMatching usingPlatform: platform = (
(*
Provides pattern matching facilities for Newspeak implemented as a library.

 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|

	private Dictionary = platform Dictionary.

	public PatternClass = Pattern.
	public PatternLibrary = Patterns new.

	(* needed for outer receiver in pattern application *)
	private MessageNotUnderstood = platform Exceptions MessageNotUnderstood.
|) (
class Binding = NewspeakObject (
(* Describe the class in this comment.

 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	private bindee <Object>
	private bindingFlag <Boolean> = false.
|) (
boundValue ^ <Object> = (
	^bindee
)
boundValue: val <Object> = (
	bindee:: val.
	bindingFlag:: true.
)
isBinding ^ <Boolean> = (
	^true.
)
isBound ^ <Boolean> = (
	^bindingFlag
)
) : (
for: aBindee <Object> ^ <Instance> = (
	^Binding new boundValue: aBindee; yourself.
)
)
class NewspeakObject = (
(* Extends Object by Pattern accessor

 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
) (
Pattern = (
	^PatternClass
)
case: pattern <Object> otherwise: fail <[] | [:Object]> ^ <Object> = (
	| MatchFailure <Binding> tempResult <Binding> |
	MatchFailure:: Binding new.
	tempResult:: pattern doesMatch: self else: [ MatchFailure ].

	^tempResult == MatchFailure
		ifTrue: [ pattern matchFailedFor: self escape: fail ]
		ifFalse: [ tempResult boundValue ].
)
) : (
)
class Pattern = NewspeakObject (
(* Describe the class in this comment.

 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	private wrappedClosure <[] | [:Object :Binding]>
	protected Patterns <Patterns> = PatternLibrary.
	protected cachedMatchFailure <Binding>
	private creationContext <MethodContext>
|) (
class PatternApplication of: p and: clsre = Pattern (|
	pattern <Pattern> = p.
	closure <[]> = clsre.
	patternCreationContext <MethodContext>
		(* This variable holds the context in which the application combinator was sent.
		 It is used to verify whether the clsre argument is bound in the same context as
		 the application combinator was sent. This is a partial fix. For example:

			Should work:
			x = (
				(<val: ?y> => [ y ]) doesMatch: self
			)

			Should not work:
			x: c = ( ""where c is [y]""
				(<val: ?y> => c) doesMatch: self
			)

			Should not work:
			x: p = ( ""where p is <val: ?y>""
				(p => [ y ]) doesMatch: self
			)

			Should not work:
			x = (
				(p => [ y ]) doesMatch: self
			)
			where
			p = ( ^ <val: ?y> )
			*)
|) (
doesMatch: subject <Object> else: fail <[]> ^ <Binding> = (
	| bind |
	bind:: pattern doesMatch: subject else: [ MatchFailure ].
	^bind == MatchFailure
		ifTrue: [ matchFailedFor: subject escape: fail ]
		ifFalse: [Binding for: (evaluate: closure withOuterReceiver: bind boundValue)]
)
evaluate: lam <[:Object :Object]> withOuterReceiver: rcv <Object> ^ <Object> = (
	| blk |
	blk:: [ lam valueWithPossibleArgument: rcv ].
	^(isOuterReceiverInLexicalScopeOfClosure: lam)
		ifFalse: blk
		ifTrue: [ blk on: MessageNotUnderstood
				       do: [:ex | (rcv respondsTo: ex message selector)
								ifTrue: [ ex resume: (* inject result of sending msg to outer rcv *)
											(rcv perform: ex message selector
												 withArguments: ex message arguments)]
								ifFalse: [ ex pass (* jump back to ex' context *) ]]]
)
isOuterReceiverInLexicalScopeOfClosure: lam <[]> ^ <Boolean> = (
	^patternCreationContext isNil not
		and: [ lam home = patternCreationContext ]
)
) : (
of: p <Pattern>
and: blk <[] | [:Object]>
in: ctx <MethodContext> ^ <PatternApplication> = (
	^(PatternApplication of: p and: blk)
			patternCreationContext: ctx;
			yourself.
)
)
class PatternConjunction of: lp and: rp = Pattern (
|
	private leftPattern = lp.
	private rightPattern = rp.
|) (
doesMatch: subject else: fail = (
	| bind |
	bind:: leftPattern doesMatch: subject else: [ MatchFailure ].
	^bind == MatchFailure
		ifTrue: [ matchFailedFor: subject escape: fail ]
		ifFalse: [ rightPattern doesMatch: subject else: fail ].
)
) : (
)
class PatternDisjunction of: p and: ap = Pattern (|
	private pattern = p.
	private alternativePattern = ap.
|) (
doesMatch: subject else: fail = (
	^pattern doesMatch: subject else: [
		alternativePattern doesMatch: subject else: fail.
	].
)
) : (
)
class PatternNegation of: p = Pattern (|
	private pattern = p.
|) (
doesMatch: subject else: fail = (
	pattern doesMatch: subject else: [ ^ Binding for: subject ].
	^matchFailedFor: subject escape: fail.
)
) : (
)
class PatternSequence of: lp and: rp = Pattern (|
	private leftPattern <Pattern> = lp.
	private rightPattern <Pattern> = rp.
|) (
doesMatch: subject <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	| bind <Binding> |
	bind:: leftPattern doesMatch: subject else: [ MatchFailure ].
	^bind == MatchFailure
		ifTrue: [ matchFailedFor: subject escape: fail ]
		ifFalse: [ rightPattern doesMatch: bind boundValue else: fail ]
)
) : (
)
class ProxyReceiver wrap: origRcv with: newRcv = (|
	private originalReceiver = origRcv.
	private newReceiver = newRcv.
|) (
doesNotUnderstand: msg = (
	^(newReceiver respondsTo: msg selector)
		ifTrue: [ newReceiver perform: msg selector withArguments: msg arguments ]
		ifFalse: [ halt]
)
) : (
)
& patAlternative <Pattern> ^ <PatternConjunction> = (
	^PatternConjunction of: self and: patAlternative.
)
=> clsre <[] | [:Object]> ^ <PatternApplication> = (
	^PatternApplication of: self and: clsre in: creationContext
)
>> nextPattern <Pattern> ^ <PatternSequence> = (
	^PatternSequence of: self and: nextPattern.
)
MatchFailure ^ <Binding> = (
	cachedMatchFailure = nil ifTrue: [ cachedMatchFailure:: Binding new ].
	^cachedMatchFailure.
)
doesMatch: subject <Object> else: failBlock <[] | [:Object]> ^ <Binding> = (
	^wrappedClosure value: subject value: failBlock.
)
isPattern ^ <Boolean> = (
	^true.
)
matchFailedFor: subject <Object> escape: fail <[] | [:Object]> = (
	^fail valueWithPossibleArgument: subject.
)
not ^ <PatternNegation> = (
	^PatternNegation of: self.
)
| alternativePattern <Pattern> ^ <PatternDisjunction> = (
	^PatternDisjunction of: self and: alternativePattern.
)
) : (
keywords: kws <List[Symbol]> patterns: pats <List[Pattern]> ^ <KeywordPattern> = (
	^(PatternLibrary KeywordPattern keywords: kws patterns: pats)
		creationContext: thisContext sender;
		yourself.
)
literal: litValue <Object> ^ <Pattern> = (
| literalPattern |
	literalPattern:: wrap: [:subject :fail |
		subject = litValue
			ifTrue: [ Binding for: subject ]
			ifFalse: [ literalPattern matchFailedFor: subject escape: fail ]
	].

	^literalPattern.
)
wildcard = (
	^wrap: [:subject :fail | Binding for: subject ]
)
wrap: aClosure <[:Object :([] | [:Object])]> ^ <Instance> = (
	^Pattern new wrappedClosure: aClosure; yourself.
)
)
class Patterns = NewspeakObject (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
) (
class AssociationValuePattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
) (
doesMatch: subj <Object> else: fail <[] | [:Object]> = (
	^(subj class name = #Association)
		ifTrue: [ Binding for: subj value ]
		ifFalse: [ matchFailedFor: subj escape: fail ]
)
) : (
)
class BinaryMessagePattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	selector <Symbol>
	argument <Object>
|) (
doesMatch: subj <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	^(subj respondsTo: selector)
		ifTrue: [ Binding for: (subj perform: selector with: argument) ]
		ifFalse: [ matchFailedFor: subj escape: fail ]
)
) : (
)
class ImmutableSlotPattern = NamedPattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	slot <Object>
	isBound <Boolean> = false.
	predicate <Pattern>
|) (
bind: v <Object> = (
	isBound ifFalse: [
		isBound:: true.
		slot:: v.
		predicate = nil ifTrue: [ predicate:: Pattern literal: v]]
)
doesMatch: subj <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	^isBound
		ifTrue: [ predicate doesMatch: subj else: fail ]
		ifFalse: [ bind: subj. Binding for: subj ]
)
) : (
)
class KeywordBinding = Binding (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	dict <Map[Symbol, Object]> = Map new.
|) (
bind: v <Object> at: k <Symbol> = (
	dict add: (k -> v).
)
boundValue ^ <KeywordBinding> = (
	^self
)
doesNotUnderstand: msg <MessageMirror> ^ <Object> = (
	^dict at: (msg selector) ifAbsent: [ super doesNotUnderstand: msg ].
)
respondsTo: sel <Symbol> ^ <Object> = (
	(dict includesKey: sel) ifTrue: [ ^ true ].
	^super respondsTo: sel.
)
subject = (
	^super boundValue
)
) : (
for: bv <Object> ^ <KeywordBinding> = (
	^KeywordBinding new boundValue: bv; yourself.
)
)
class KeywordPattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	dict <Map[Symbol, Pattern]>
	selector <Symbol>
	variables <Map[Symbol, Pattern]>
|) (
doesMatch: subj <Object> else: fail <[] | [:Object]> = (
	| res <Object> |
	res:: subj match: self.
	^res == MatchFailure
		ifTrue: [ matchFailedFor: subj escape: fail ]
		ifFalse: [ res ]
)
doesNotUnderstand: msg <MessageMirror> ^ <Binding> = (
	| subj <Object> |
	subj:: thisContext sender receiver.
	^msg selector = selector
		ifTrue: [ matchArguments: msg arguments ofSubject: subj ]
		ifFalse: [ MatchFailure ]
	(* n.b.	shouldn't resignal as subject might decide to provide for other
			selectors/views on itself. *)
)
isKeywordPattern ^ <Boolean> = (
	^true
)
matchArguments: args ofSubject: subj = (
	| kwBinding |
	kwBinding:: KeywordBinding for: subj.

	args with: selectors do: [:arg :sel | | res |
		res:: (dict at: sel) doesMatch: arg else: [ ^ MatchFailure ].
		kwBinding bind: res boundValue at: sel.
	].

	variables keysAndValuesDo: [:k :bpat | kwBinding bind: bpat slot at: k ].

	^kwBinding.
)
selectors ^ <Collection[Symbol]> = (
	^selector findTokens: ":"
)
setVariables: vars <Map[String, Pattern]> = (
	| newDict | newDict:: Map new.

	dict keysAndValuesDo: [:k :pat |
		pat case:
			((KeywordPatternPattern new) => [:as | pat setVariables: vars. newDict add: k -> pat])
		   | ((NamedPatternPattern new) => [:p | newDict add: k -> (vars at: p patternName)])
		      otherwise: [:p | newDict add: k -> p ]
	].

	dict: newDict.
	variables: vars.
)
traverseApply: p <Pattern> ifFails: fail <[] | [:Object]> = (
	| kwpat_P <KeywordPatternPattern> |
	kwpat_P:: Patterns new KeywordPatternPattern new.
	dict keysAndValuesDo: [:k :pat |
		p doesMatch: (k -> pat) else: fail.
		pat case:
			(kwpat_P => [:as | pat traverseApply: p ifFails: fail ])
			otherwise: []
	].
)
) : (
keywords: kws <List[Symbol]>
patterns: pats <List[Pattern]> ^ <KeywordPattern> = (
	| target <KeywordPattern>
	kwToPattern <Map[Symbol,Pattern]>
	vars <Map[Symbol, Pattern]> |
	target:: KeywordPattern new.
	kwToPattern:: Map new.
	vars:: Map new.

	(* selector *)
	target selector: (kws inject: '' into: [:m :kw | m,kw ]) asSymbol.

	(* mapping from keyword to pattern *)
	kws with: pats do: [:kw :pat | kwToPattern add: ((kw truncateTo: kw size - 1) -> pat) ].
	target dict: kwToPattern.

	(* collect and install variables *)
	target
		traverseApply: (AssociationValuePattern new >> NamedPatternPattern new)
						=> [:np | vars add: (np patternName -> np) ]
		ifFails: [(* ignore *)].
	target setVariables: vars.

	^target.
)
)
class KeywordPatternPattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
) (
doesMatch: subj <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	^(subj isKeywordPattern)
		ifTrue: [ Binding for: subj dict associations ]
		ifFalse: [ matchFailedFor: subj escape: fail ]
)
) : (
)
class NamedPattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	patternName
|) (
isNamedPattern = (
	^true
)
) : (
)
class NamedPatternPattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
) (
doesMatch: subj <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	^(subj respondsTo: #patternName)
		ifTrue: [ Binding for: subj ]
		ifFalse: [ matchFailedFor: subj escape: fail ]
)
) : (
)
class TypePattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	typeName
|) (
doesMatch: subj <Object> else: fail <[] | [:Object]> ^ <Binding> = (
	^(subj perform: ('is',typeName) asSymbol)
		ifTrue: [ Binding for: subj ]
		ifFalse: [ matchFailedFor: subj escape: fail ].
)
) : (
)
class UnaryMessagePattern = Pattern (
(*
 Copyright (c) 2009-2010 Felix Geller

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the ""Software""), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED ""AS IS"", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.
*)
|
	private symSelector <Symbol>
|) (
doesMatch: subj else: fail = (
	^(subj respondsTo: symSelector)
		ifTrue: [ | res |
			res:: subj perform: symSelector.
			res == true
				ifTrue: [ Binding for: subj ]
				ifFalse: [ res == false
							ifTrue: [ matchFailedFor: subj escape: fail ]
							ifFalse: [ Binding for: res ]]]
		ifFalse: [ matchFailedFor: subj escape: fail ]
)
selector: s = (
	symSelector:: s asSymbol.
)
) : (
)
) : (
)
) : (
)