SystemOrganization addCategory: #'Cutie-LanguageAspects'!

LAAspect subclass: #LAPathAspect
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LAPathAspect class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'!
initialize
	self default recompile! !

!LAPathAspect methodsFor: 'hooks' stamp: 'lr 1/22/2009 11:10'!
advice: aParser
	^ LAAdvice new
		before: aParser cascadeExpression;
		parser: aParser primary , ('::' asParser small , aParser unaryToken , ('()' asParser small / aParser block optional)) plus! !

!LAPathAspect methodsFor: 'hooks' stamp: 'lr 1/22/2009 10:55'!
compile: aCollection 
	^ (aCollection second collect: [ :each | each flatten ])
		inject: aCollection first
		into: [ :receiver :array |
			| result |
			result := ``(`,(receiver) gather: `,(array second value asSymbol)).
			array third isNil 
				ifFalse: [ result := ``(`,result select: `,(array third)) ].
			result ]! !

!LAPathAspect methodsFor: 'hooks' stamp: 'lr 1/19/2009 09:17'!
highlight: aCollection
	^ DSLHighlighter mark: aCollection with: TextEmphasis italic! !

LAAspect subclass: #LAQuoteAspect
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LAQuoteAspect methodsFor: 'hooks' stamp: 'lr 2/3/2009 19:32'!
advice: aParser
	^ LAAdvice new
		choice;
		before: aParser primary;
		parser: self metaParser small , aParser primary! !

!LAQuoteAspect methodsFor: 'hooks' stamp: 'lr 2/3/2009 19:08'!
compile: aCollection
	^ (self findMetaClass: aCollection first value) value: aCollection second! !

!LAQuoteAspect methodsFor: 'private' stamp: 'lr 2/3/2009 19:08'!
findMetaClass: aString
	^ QQMetaNode subclasses
		detect: [ :each | aString last = each prefix ]
		ifNone: [ self error: 'Unknown meta node ' , aString printString ]! !

!LAQuoteAspect methodsFor: 'hooks' stamp: 'lr 2/3/2009 19:08'!
highlight: aCollection
	^ (self findMetaClass: aCollection first value) highlight: aCollection! !

!LAQuoteAspect methodsFor: 'testing' stamp: 'lr 2/3/2009 19:33'!
includesSelector: aSelector in: aClass
	"The quoting operators should be available everywhere."

	^ true! !

!LAQuoteAspect methodsFor: 'private' stamp: 'lr 2/3/2009 19:24'!
metaParser
	^ QQMetaNode subclasses
		inject: PPChoiceParser new
		into: [ :parser :class | parser / (String with: $` with: class prefix) asParser ]! !

LAAspect subclass: #LARegexpAspect
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LARegexpAspect class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'!
initialize
	self default recompile! !

!LARegexpAspect methodsFor: 'hooks' stamp: 'lr 1/22/2009 11:10'!
advice: aParser
	^ LAAdvice new
		after: aParser literal;
		parser: ($/ asParser , $/ asParser negate star , $/ asParser) small! !

!LARegexpAspect methodsFor: 'hooks' stamp: 'lr 1/19/2009 09:49'!
compile: aToken
	^ QQObjectNode 
		literalToken: aToken
		value: (aToken value copyFrom: 2 to: aToken size - 1)
			asRegex! !

!LARegexpAspect methodsFor: 'hooks' stamp: 'lr 1/19/2009 09:49'!
highlight: aToken
	^ aToken -> Color orange! !

TestCase subclass: #LACrosscuttingTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LACrosscuttingTest class methodsFor: 'initialization' stamp: 'lr 11/6/2008 14:34'!
initialize
	LARegexpAspect default addClass: self.
	LAPathAspect default addClass: self! !

!LACrosscuttingTest methodsFor: 'testing' stamp: 'lr 1/22/2009 11:16'!
testModular
	| input output |
	input := #(('aaaa') ('aaab' 'aaba' 'abaa' 'baaa') ('aabb' 'abba' 'bbaa' 'abab' 'baba' 'baab') ('abbb' 'babb' 'bbab' 'bbba') ('bbbb')).
	output := input::yourself[ :each | each =~ /a*b*/ ].
	self assert: output = #('aaaa' 'aaab' 'aabb' 'abbb' 'bbbb')! !

TestCase subclass: #LAPathAspectTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LAPathAspectTest class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:58'!
initialize
	LAPathAspect default addClass: self! !

!LAPathAspectTest methodsFor: 'testing' stamp: 'lr 1/22/2009 11:15'!
testSimpleFilter
	| input output |
	input := #((1 2 3) (4 5) (6)).
	output := input::yourself[ :each | each odd ].
	self assert: output = #(1 3 5)! !

!LAPathAspectTest methodsFor: 'testing' stamp: 'lr 1/22/2009 11:15'!
testSimplePath
	| input output |
	input := #((1 2 3) (4 5) (6)).
	output := input::yourself.
	self assert: output = #(1 2 3 4 5 6)! !

TestCase subclass: #LAQuoteAspectTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

TestCase subclass: #LARegexpAspectTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cutie-LanguageAspects'!

!LARegexpAspectTest class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:58'!
initialize
	LARegexpAspect default addClass: self! !

!LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 1/22/2009 11:15'!
testPaper
	self assert: ('Nena - 99 Luftballons' =~ /.*\d+.*/)! !

!LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 1/22/2009 11:15'!
testRegexp
	self assert: ('10010100' =~ /[01]+/).
	self assert: ('aaaaab' =~ /a*b/).
	self assert: ('abbbbbbc' =~ /ab+c/).
	self assert: ('abbb' =~ /ab*/)! !
LAPathAspect initialize!
LARegexpAspect initialize!
LACrosscuttingTest initialize!
LAPathAspectTest initialize!
LARegexpAspectTest initialize!