SystemOrganization addCategory: #'Cutie-LanguageAspects'! TestCase subclass: #LATestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! LATestCase subclass: #LACrosscuttingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LACrosscuttingTest class methodsFor: 'accessing' stamp: 'lr 2/10/2009 15:25'! aspects ^ Array with: LAPathAspect with: LARegexpAspect! ! !LACrosscuttingTest methodsFor: 'testing' stamp: 'lr 2/10/2009 15:26'! 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')! ! LATestCase subclass: #LAPathAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LAPathAspectTest class methodsFor: 'accessing' stamp: 'lr 2/10/2009 15:25'! aspects ^ Array with: LAPathAspect! ! !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)! ! LATestCase subclass: #LAQuoteAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LAQuoteAspectTest class methodsFor: 'accessing' stamp: 'lr 2/10/2009 15:25'! aspects ^ Array with: LAQuoteAspect! ! !LAQuoteAspectTest methodsFor: 'testing-splice' stamp: 'lr 2/10/2009 15:36'! testParseSplice1 self assert: `@(10 factorial) = 3628800! ! !LAQuoteAspectTest methodsFor: 'testing-splice' stamp: 'lr 2/10/2009 15:36'! testParseSplice2 self assert: `@(DateAndTime now) < DateAndTime now! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 2/10/2009 15:37'! testQuote1 | ast | ast := ``(1 + 2). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 2/10/2009 15:37'! testQuote2 | ast | ast := ``{ 1 }. self assert: (ast isKindOf: RBArrayNode). self assert: ast formattedCode = '{ 1 }'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 2/10/2009 15:37'! testQuote3 | ast | ast := ``[ ]. self assert: (ast isKindOf: RBBlockNode). self assert: ast formattedCode = '[ ]'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 2/10/2009 15:38'! testQuote4 | ast | ast := ``123. self assert: (ast isKindOf: RBLiteralNode). self assert: ast formattedCode = '123'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 2/10/2009 15:37'! testQuote5 | ast | ast := ``x. self assert: (ast isKindOf: RBVariableNode). self assert: ast formattedCode = 'x'! ! !LAQuoteAspectTest methodsFor: 'testing-unquote' stamp: 'lr 2/10/2009 15:37'! testUnquote1 | one two ast | one := ``1. two := ``2. ast := ``(`,one + `,two). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! LATestCase subclass: #LARegexpAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LARegexpAspectTest class methodsFor: 'accessing' stamp: 'lr 2/10/2009 15:26'! aspects ^ Array with: LARegexpAspect! ! !LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 2/6/2009 12:13'! testPaper self assert: ('Nena - 99 Luftballons' =~ /.*\d+.*/)! ! !LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 2/6/2009 12:13'! testRegexp self assert: ('10010100' =~ /[01]+/). self assert: ('aaaaab' =~ /a*b/). self assert: ('abbbbbbc' =~ /ab+c/). self assert: ('abbb' =~ /ab*/)! ! !LATestCase class methodsFor: 'accessing' stamp: 'lr 2/10/2009 15:24'! aspects ^ #()! ! !LATestCase class methodsFor: 'private' stamp: 'lr 2/10/2009 15:24'! compile: aString classified: aSymbol notifying: anObject trailer: anArray ifFail: aBlock "Before compilign the methods of the receiver make sure that the aspects are added." self aspects do: [ :aspect | (aspect default environments noneSatisfy: [ :env | env includesClass: self ]) ifTrue: [ aspect default addClass: self ] ]. ^ super compile: aString classified: aSymbol notifying: anObject trailer: anArray ifFail: aBlock! ! !ProtoObject methodsFor: '*cutie-languageaspects' stamp: 'lr 2/6/2009 11:15'! languageAspectsHighlight ^ LASmalltalkGrammar compileUseLanguageAspects ifTrue: [ LAHighlightAction new ]! ! !ProtoObject methodsFor: '*cutie-languageaspects' stamp: 'lr 2/6/2009 11:15'! languageAspectsParser ^ LASmalltalkGrammar compileUseLanguageAspects ifTrue: [ LAParseAction new ]! ! !String methodsFor: '*cutie-languageaspects' stamp: 'lr 12/2/2008 16:42'! =~ aRegexp ^ aRegexp matches: self! ! 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 2/6/2009 11:59'! 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 2/6/2009 12:12'! advice: aParser ^ LAAdvice new before: aParser primary; 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! ! LAPathAspect initialize! LARegexpAspect initialize!