SystemOrganization addCategory: #'Cutie-LanguageAspects'! SystemOrganization addCategory: #'Cutie-LanguageAspects-Skins'! 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 4/6/2009 11:56'! 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: #LALispFactoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects-Skins'! !LALispFactoryTest class methodsFor: 'accessing' stamp: 'lr 4/6/2009 11:35'! aspects ^ Array with: LALispFactory! ! !LALispFactoryTest methodsFor: 'as yet unclassified' stamp: 'lr 4/6/2009 17:14'! testLispFactoryMorph | morph1 morph2 | morph1 := <>. morph2 := <>. "self debug: #testLispFactoryMorph"! ! !LALispFactoryTest methodsFor: 'as yet unclassified' stamp: 'lr 4/6/2009 16:54'! testLispFactoryOrderedCollection | collection | collection := <>. self assert: collection size = 4. self assert: collection first = 1. self assert: collection second = 2. self assert: collection third size = 1. self assert: collection third first = 3. self assert: collection fourth size = 2. self assert: collection fourth first = 4. self assert: collection fourth second = 5! ! 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 4/3/2009 11:48'! 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 4/3/2009 11:48'! 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 4/3/2009 11:48'! testParseSplice1 self assert: `@(10 factorial) = 3628800! ! !LAQuoteAspectTest methodsFor: 'testing-splice' stamp: 'lr 4/3/2009 11:48'! testParseSplice2 self assert: `@(DateAndTime now) < DateAndTime now! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote1 | ast | ast := ``(1 + 2). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote2 | ast | ast := ``{ 1 }. self assert: (ast isKindOf: RBArrayNode). self assert: ast formattedCode = '{ 1 }'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote3 | ast | ast := ``[ ]. self assert: (ast isKindOf: RBBlockNode). self assert: ast formattedCode = '[ ]'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote4 | ast | ast := ``123. self assert: (ast isKindOf: RBLiteralNode). self assert: ast formattedCode = '123'! ! !LAQuoteAspectTest methodsFor: 'testing-quote' stamp: 'lr 4/3/2009 11:48'! testQuote5 | ast | ast := ``x. self assert: (ast isKindOf: RBVariableNode). self assert: ast formattedCode = 'x'! ! !LAQuoteAspectTest methodsFor: 'testing-unquote' stamp: 'lr 4/3/2009 11:48'! testUnquote1 | one two ast | one := ``1. two := ``2. ast := ``(`,one + `,two). self assert: (ast isKindOf: RBMessageNode). self assert: ast formattedCode = '1 + 2'! ! !LAQuoteAspectTest methodsFor: 'testing-unquote' stamp: 'lr 4/3/2009 11:48'! testUnquote2 | ast | ast := ``b. ast := ``(`,ast := 12). self assert: ast isAssignment. self assert: ast variable isVariable. self assert: ast variable name = 'b'. self assert: ast value isLiteral. self assert: ast value value = 12! ! 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 4/3/2009 11:48'! testPaper self assert: ('Nena - 99 Luftballons' =~ /.*\d+.*/)! ! !LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 4/3/2009 11:48'! 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! ! CUCompositeParser subclass: #LAFactoryParser instanceVariableNames: 'primary message' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects-Skins'! !LAFactoryParser class methodsFor: 'instance creation' stamp: 'lr 4/6/2009 12:11'! primary: aPrimaryParser message: aMessageParser ^ self basicNew initializePrimary: aPrimaryParser message: aMessageParser! ! !LAFactoryParser methodsFor: 'initialization' stamp: 'lr 4/6/2009 12:11'! initializePrimary: aPrimaryParser message: aMessageParser primary := aPrimaryParser. message := aMessageParser. self initialize! ! LAFactoryParser subclass: #LALispFactoryParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects-Skins'! !LALispFactoryParser methodsFor: 'token' stamp: 'lr 4/6/2009 10:41'! close $) small! ! !LALispFactoryParser methodsFor: 'token' stamp: 'lr 4/6/2009 10:41'! open $( small! ! !LALispFactoryParser methodsFor: 'grammar' stamp: 'lr 4/6/2009 12:16'! send open , message , send star , close! ! !LALispFactoryParser methodsFor: 'grammar' stamp: 'lr 4/6/2009 12:15'! start open , primary , send star , close! ! LAFactoryParser subclass: #LAPythonFactoryParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects-Skins'! !String methodsFor: '*cutie-languageaspects' stamp: 'lr 12/2/2008 16:42'! =~ aRegexp ^ aRegexp matches: self! ! !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 ]! ! LAAspect subclass: #LAFactory instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects-Skins'! !LAFactory methodsFor: 'hooks' stamp: 'lr 4/6/2009 16:14'! advice: aParser ^ LAAdvice new before: (aParser productionAt: #cascadeExpression); parser: ('<<' asParser token , (aParser productionAt: #keywordToken)) wrapped , (LALispFactoryParser primary: (aParser productionAt: #cascadeExpression) message: (aParser productionAt: #message)) , '>>' asParser token! ! !LAFactory methodsFor: 'hooks' stamp: 'lr 4/6/2009 16:49'! compile: aCollection ^ (RBSequenceNode statements: OrderedCollection new) addTemporaryNamed: 'stack'; addNode: ``(stack := OrderedCollection with: `,(aCollection second second)); addNodes: (self compileNested: aCollection second third); addNode: ``(stack last); yourself! ! !LAFactory methodsFor: 'hooks' stamp: 'lr 4/6/2009 16:51'! compileNested: aCollection | messages message | messages := OrderedCollection new. aCollection do: [ :tokens | message := RBMessageNode receiver: ``(stack last) selectorParts: tokens second first arguments: tokens second second. tokens third isEmpty ifTrue: [ messages add: message ] ifFalse: [ messages add: ``(stack addLast: `,message). messages addAll: (self compileNested: tokens third). messages add: ``(stack removeLast) ] ]. ^ messages! ! !LAFactory methodsFor: 'hooks' stamp: 'lr 4/6/2009 11:59'! highlight: aCollection ^ CHHighlighter mark: aCollection with: Color orange! ! 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 4/3/2009 11:47'! advice: aParser ^ LAAdvice new before: (aParser productionAt: #cascadeExpression); parser: (aParser productionAt: #primary) , ('::' asParser small , (aParser productionAt: #unaryToken) , ('()' asParser small / (aParser productionAt: #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 4/2/2009 15:32'! highlight: aCollection ^ CHHighlighter mark: aCollection with: TextEmphasis italic! ! LAAspect subclass: #LAQuoteAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! LAQuoteAspect subclass: #LAPrimaryQuoteAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LAPrimaryQuoteAspect methodsFor: 'hooks' stamp: 'lr 4/3/2009 11:47'! advice: aParser ^ LAAdvice new choice; before: (aParser productionAt: #primary); parser: self metaParser small , (aParser productionAt: #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/25/2009 10:14'! includesSelector: aSelector in: aClass "The quoting operators should be available everywhere." ^ self class name ~= #LAQuoteAspect! ! !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 ]! ! LAQuoteAspect subclass: #LAVariableQuoteAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Cutie-LanguageAspects'! !LAVariableQuoteAspect methodsFor: 'hooks' stamp: 'lr 4/3/2009 11:47'! advice: aParser ^ LAAdvice new choice; before: (aParser productionAt: #variable); parser: self metaParser small , (aParser productionAt: #variable)! ! 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 4/3/2009 11:47'! advice: aParser ^ LAAdvice new before: (aParser productionAt: #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! ! !QQTestCase class methodsFor: '*cutie-languageaspects' stamp: 'lr 2/25/2009 10:09'! languageAspectsHighlight ^ nil! ! !QQTestCase class methodsFor: '*cutie-languageaspects' stamp: 'lr 2/25/2009 10:09'! languageAspectsParser ^ nil! ! LAPathAspect initialize! LARegexpAspect initialize!