SystemOrganization addCategory: #'LanguageAspects-Core'! SystemOrganization addCategory: #'LanguageAspects-Tests'! SystemOrganization addCategory: #'LanguageAspects-Examples'! SystemOrganization addCategory: #'LanguageAspects-Integration'! !PPParser methodsFor: '*languageaspects' stamp: 'lr 10/20/2008 13:38'! small ^ LATokenParser on: self! ! !RBAssignmentNode methodsFor: '*languageaspects-override' stamp: 'lr 10/17/2008 15:10'! assignmentOperator ^ self defaultAssignmentOperator! ! Object subclass: #LAAspect instanceVariableNames: 'active environments concerns pointcut' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! LAAspect class instanceVariableNames: 'Default'! LAAspect class instanceVariableNames: 'Default'! !LAAspect class methodsFor: 'querying' stamp: 'lr 10/23/2008 11:00'! all ^ self allSubclasses collect: [ :each | each default ]! ! !LAAspect class methodsFor: 'querying' stamp: 'lr 10/23/2008 11:03'! allActiveForSelector: aSymbol in: aClass ^ self all select: [ :each | each isActive and: [ each includesSelector: aSymbol in: aClass ] ]! ! !LAAspect class methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:03'! default ^ Default ifNil: [ Default := self new ]! ! !LAAspect class methodsFor: 'initialization' stamp: 'lr 10/10/2008 15:08'! reset Default := nil. self subclasses do: [ :each | each reset ]! ! !LAAspect class methodsFor: 'initialization' stamp: 'lr 10/10/2008 15:03'! unload self default active: false! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:09'! active: aBoolean "Enable or disable the receiving language aspect." active = aBoolean ifTrue: [ ^ self ]. active := aBoolean. self recompile! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/23/2008 09:59'! addClassScope: aClass ^ self addScope: (BrowserEnvironment new forClasses: (Array with: aClass))! ! !LAAspect methodsFor: 'concerns' stamp: 'lr 10/23/2008 11:09'! addConcern: aConcern concerns := concerns copyWith: aConcern. ^ aConcern! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/23/2008 09:59'! addPackageScope: aString ^ self addScope: (BrowserEnvironment new forPackageNamed: aString)! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/23/2008 09:59'! addPragmaScope: aKeyword ^ self addScope: (BrowserEnvironment new forPragmas: (Array with: aKeyword))! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/23/2008 09:59'! addScope: anEnvironment "Add a new scope to the receiving aspect and incrementally update all code." environments := environments copyWith: anEnvironment. self isActive ifTrue: [ self recompile: anEnvironment ]. ^ anEnvironment! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:21'! concerns "Answer a collection of concerns." ^ concerns! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/23/2008 09:44'! environment "Answer a a composed environment." ^ environments isEmpty ifTrue: [ BrowserEnvironment new not ] ifFalse: [ environments fold: [ :first :second | first | second ] ]! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:05'! environments "Answer a collection of environments." ^ environments! ! !LAAspect methodsFor: 'testing' stamp: 'lr 10/23/2008 11:12'! includesSelector: aSelector in: aClass "Answer wether the receiving aspect is active in the given context or not." ^ self environment includesSelector: aSelector in: aClass! ! !LAAspect methodsFor: 'initialization' stamp: 'lr 10/10/2008 15:21'! initialize active := true. pointcut := LAPointcut new. concerns := environments := #()! ! !LAAspect methodsFor: 'testing' stamp: 'lr 10/10/2008 15:01'! isActive "Answer wether the receiving aspect is active or not." ^ active! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/13/2008 13:41'! pointcut "Answer the pointcut of the reciever." ^ pointcut! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/20/2008 15:53'! recompile "Recompile all the affected methods in the selected enviornments." self recompile: self environment! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/10/2008 14:43'! recompile: anEnvironment "Recompile all the affected methods in anEnvironment." anEnvironment classesAndSelectorsDo: [ :class :selector | class recompile: selector ]! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/23/2008 09:56'! refresh self isActive ifTrue: [ self recompile ]! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/23/2008 10:01'! reset self initialize. self refresh! ! LAAspect subclass: #LAPathAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! LAAspect subclass: #LARegexpAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LARegexpAspect class methodsFor: 'initialization' stamp: 'lr 10/23/2008 10:01'! initialize self default reset! ! !LARegexpAspect methodsFor: 'initialization' stamp: 'lr 10/23/2008 11:16'! initialize super initialize. self pointcut after; choice; name: 'literal'; parser: $/ asParser , $/ asParser negate , $/ asParser. self addConcern: (LAHighlighter attribute: TextColor red). self addClassScope: LARegexpAspectTest! ! Object subclass: #LAConcern instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LAConcern methodsFor: 'public' stamp: 'lr 10/10/2008 15:30'! apply: aNode self subclassResponsibility! ! !LAConcern methodsFor: 'weaving' stamp: 'lr 10/10/2008 15:30'! weave: aParser ^ aParser => [ :node | self apply: node ]! ! LAConcern subclass: #LAHighlighter instanceVariableNames: 'attribute' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LAHighlighter class methodsFor: 'as yet unclassified' stamp: 'lr 10/23/2008 10:04'! attribute: aTextAttribute ^ self new setAttribute: aTextAttribute! ! !LAHighlighter methodsFor: 'public' stamp: 'lr 10/10/2008 15:31'! apply: aNode ^ self color! ! !LAHighlighter methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:31'! color ^ color! ! !LAHighlighter methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:31'! color: aColor color := aColor! ! !LAHighlighter methodsFor: 'initialization' stamp: 'lr 10/23/2008 10:04'! setAttribute: aTextAttribute attribute := aTextAttribute! ! LAConcern subclass: #LATransformer instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! Object subclass: #LAPointcut instanceVariableNames: 'name parser action class' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LAPointcut methodsFor: 'accessing-place' stamp: 'lr 10/10/2008 15:36'! after "Insert the new parser and concern after the name rule." action := #after! ! !LAPointcut methodsFor: 'accessing-place' stamp: 'lr 10/10/2008 15:35'! around "Insert the concern around the named rule." action := #around! ! !LAPointcut methodsFor: 'accessing-place' stamp: 'lr 10/10/2008 15:36'! before "Insert the new parser and concern before the name rule." action := #before! ! !LAPointcut methodsFor: 'accessing-list' stamp: 'lr 10/10/2008 15:39'! choice "Use a choice to combine the two grammars." class := PPChoiceParser! ! !LAPointcut methodsFor: 'initialization' stamp: 'lr 10/13/2008 13:47'! initialize self after. self choice. self name: #start. self parser: PPEpsilonParser new! ! !LAPointcut methodsFor: 'accessing' stamp: 'lr 10/13/2008 13:46'! name: aSymbol "The name of the rule to identify." name := aSymbol asSymbol! ! !LAPointcut methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:40'! parser: aParser "The new/replacement parser to be used." parser := aParser asParser! ! !LAPointcut methodsFor: 'accessing-place' stamp: 'lr 10/10/2008 15:36'! replace "Replace the named rule with the given parser and concern." action := #replace! ! !LAPointcut methodsFor: 'accessing-list' stamp: 'lr 10/10/2008 15:39'! sequence "Use a sequence to combine the two grammars." class := PPSequenceParser! ! !LAPointcut methodsFor: 'actions' stamp: 'lr 10/13/2008 13:46'! weave: aParser concern: aConcern | original copied | original := aParser perform: name. copied := original copy. original becomeForward: (action = #replace ifTrue: [ aConcern weave: parser ] ifFalse: [ action = #around ifTrue: [ aConcern weave: copied ] ifFalse: [ action = #before ifTrue: [ class with: (aConcern weave: parser) with: copied ] ifFalse: [ action = #after ifTrue: [ class with: copied with: (aConcern weave: parser) ] ifFalse: [ self error: 'Invalid pointcut action.' ] ] ] ])! ! CUCompositeParser subclass: #LASmalltalkParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! LASmalltalkParser subclass: #LASmalltalkCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:47'! array super array ==> [ :nodes | RBArrayNode leftBrace: nodes first rightBrace: nodes last statements: nodes second ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:06'! arrayLiteral super arrayLiteral ==> [ :nodes | RBLiteralNode value: nodes second asArray ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:21'! arrayLiteralArray super arrayLiteralArray ==> [ :nodes | nodes second asArray ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:19'! arrayLiteralChar super arrayLiteralChar ==> [ :token | token value second ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:15'! arrayLiteralFalse super arrayLiteralFalse ==> [ :token | false ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:14'! arrayLiteralNil super arrayLiteralNil ==> [ :token | nil ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:14'! arrayLiteralNumber super arrayLiteralNumber ==> [ :token | Number readFrom: token value ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:21'! arrayLiteralString super arrayLiteralString ==> [ :token | self cleanupString: token value ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:56'! arrayLiteralSymbol super arrayLiteralSymbol ==> [ :token | (self cleanupString: token second value) asSymbol ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:15'! arrayLiteralTrue super arrayLiteralTrue ==> [ :token | true ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/26/2008 11:33'! assignment super assignment ==> #first! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:16'! binaryExpression super binaryExpression map: [ :receiver :message | self build: receiver message: message ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:26'! binaryMessage super binaryMessage ==> [ :nodes | Array with: nodes first value with: (Array with: nodes second) ]! ! !LASmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 11:59'! block super block ==> [ :nodes | RBBlockNode arguments: nodes second body: nodes third ]! ! !LASmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:00'! blockArgument super blockArgument ==> #second! ! !LASmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:07'! blockArgumentsMany super blockArgumentsMany ==> #first! ! !LASmalltalkCompiler methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:05'! blockArgumentsNone super blockArgumentsNone ==> [ :token | Array new ]! ! !LASmalltalkCompiler methodsFor: 'private' stamp: 'lr 9/23/2008 20:53'! build: aNode message: anArray ^ anArray isEmptyOrNil ifTrue: [ aNode ] ifFalse: [ anArray inject: aNode into: [ :receiver :pair | pair isEmptyOrNil ifTrue: [ receiver ] ifFalse: [ RBMessageNode receiver: receiver selector: pair first asSymbol arguments: pair last ] ] ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:49'! cascadeExpression ^ super cascadeExpression map: [ :receiver :messages | messages isEmpty ifTrue: [ receiver ] ifFalse: [ | sends | sends := OrderedCollection new: messages size + 1. sends addLast: receiver. messages do: [ :each | sends addLast: (RBMessageNode receiver: receiver receiver selector: each first asSymbol arguments: each last) ]. RBCascadeNode messages: sends ] ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:39'! cascadeMessage super cascadeMessage ==> [ :nodes | nodes second ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:16'! charLiteral super charLiteral ==> [ :token | RBLiteralNode literalToken: token value: token value second ]! ! !LASmalltalkCompiler methodsFor: 'private' stamp: 'lr 10/13/2008 17:26'! cleanupString: aString (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) ifTrue: [ ^ aString ]. ^ (aString copyFrom: 2 to: aString size - 1) copyReplaceAll: '''''' with: ''''! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:34'! expression super expression map: [ :variables :message | variables isEmpty ifTrue: [ message ] ifFalse: [ variables reverse inject: message into: [ :result :each | RBAssignmentNode variable: each value: result ] ] ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:16'! falseLiteral super falseLiteral ==> [ :token | RBLiteralNode literalToken: token value: false ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 20:43'! keywordExpression super keywordExpression map: [ :receiver :message | self build: receiver message: (Array with: message) ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 20:41'! keywordMessage super keywordMessage ==> [ :nodes | Array with: (nodes inject: String new into: [ :result :each | result , each first value ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 10/20/2008 16:07'! method super method map: [ :declaration :body | (RBMethodNode selector: declaration first asSymbol arguments: declaration second body: (RBSequenceNode temporaries: body second statements: body third)) pragmas: body first; yourself ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:16'! nilLiteral super nilLiteral ==> [ :token | RBLiteralNode literalToken: token value: nil ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! numberLiteral super numberLiteral ==> [ :token | RBLiteralNode literalToken: token value: (Number readFrom: token value) ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:40'! parens super parens ==> #second! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 10/20/2008 16:26'! pragma super pragma ==> [ :nodes | RBPragmaNode pragma: (Pragma keyword: nodes second first asSymbol arguments: nodes second second) spec: nodes second first asSymbol start: nodes first start stop: nodes last stop firstToken: nodes first lastToken: nodes last ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:00'! return super return map: [ :token :expression | RBReturnNode value: expression ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:01'! sequence super sequence map: [ :temporaries :statements | RBSequenceNode temporaries: temporaries statements: statements ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:27'! stringLiteral super stringLiteral ==> [ :token | RBLiteralNode literalToken: token value: (self cleanupString: token value) ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:57'! symbolLiteral super symbolLiteral ==> [ :nodes | RBLiteralNode literalToken: nodes second value: (self cleanupString: nodes second value) asSymbol ]! ! !LASmalltalkCompiler methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:28'! trueLiteral super trueLiteral ==> [ :token | RBLiteralNode literalToken: token value: true ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:15'! unaryExpression super unaryExpression map: [ :receiver :message | self build: receiver message: message ]! ! !LASmalltalkCompiler methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:25'! unaryMessage super unaryMessage ==> [ :node | Array with: node value with: Array new ]! ! !LASmalltalkCompiler methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:02'! variable super variable ==> [ :token | RBVariableNode identifierToken: token ]! ! LASmalltalkParser subclass: #LASmalltalkHighlighter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 10/23/2008 11:17'! array super array ==> [ :nodes | RBArrayNode leftBrace: nodes first rightBrace: nodes last statements: nodes second ]! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 10/23/2008 11:17'! assignment super assignment ==> #first! ! !LASmalltalkHighlighter methodsFor: 'private' stamp: 'lr 10/23/2008 11:17'! build: aNode message: anArray ^ anArray isEmptyOrNil ifTrue: [ aNode ] ifFalse: [ anArray inject: aNode into: [ :receiver :pair | pair isEmptyOrNil ifTrue: [ receiver ] ifFalse: [ RBMessageNode receiver: receiver selector: pair first asSymbol arguments: pair last ] ] ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:27'! charLiteral super charLiteral ==> [ :token | token -> Color magenta ]! ! !LASmalltalkHighlighter methodsFor: 'private' stamp: 'lr 10/23/2008 11:17'! cleanupString: aString (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) ifTrue: [ ^ aString ]. ^ (aString copyFrom: 2 to: aString size - 1) copyReplaceAll: '''''' with: ''''! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 10/23/2008 11:17'! expression super expression map: [ :variables :message | variables isEmpty ifTrue: [ message ] ifFalse: [ variables reverse inject: message into: [ :result :each | RBAssignmentNode variable: each value: result ] ] ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:28'! falseLiteral super falseLiteral ==> [ :token | token -> Color cyan ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:28'! nilLiteral super nilLiteral ==> [ :token | token -> Color cyan ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:28'! numberLiteral super numberLiteral ==> [ :token | token -> Color magenta ]! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 10/23/2008 11:17'! pragma super pragma ==> [ :nodes | RBPragmaNode pragma: (Pragma keyword: nodes second first asSymbol arguments: nodes second second) spec: nodes second first asSymbol start: nodes first start stop: nodes last stop firstToken: nodes first lastToken: nodes last ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:28'! stringLiteral super stringLiteral ==> [ :token | token -> Color magenta ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:29'! symbolLiteral super symbolLiteral ==> [ :token | token second -> Color magenta ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 11:28'! trueLiteral super trueLiteral ==> [ :token | token -> Color cyan ]! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 10/23/2008 11:29'! variable super variable ==> [ :token | token -> Color blue ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/20/2008 10:24'! array ${ small , statements , $} small! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:43'! arrayLiteral '#(' small , arrayLiteralElement star , $) small! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:43'! arrayLiteralArray ($# optional , $() small , arrayLiteralElement star , $) small! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:11'! arrayLiteralChar charToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:10'! arrayLiteralElement arrayLiteralTrue / arrayLiteralFalse / arrayLiteralNil / arrayLiteralNumber / arrayLiteralChar / arrayLiteralString / arrayLiteralSymbol / arrayLiteralArray! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralFalse falseToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralNil nilToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralNumber numberToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralString stringToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:55'! arrayLiteralSymbol $# optional , symbolToken! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:11'! arrayLiteralTrue trueToken! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:27'! assignment variable , assignmentToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! assignmentToken (':=' / '_') small! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 15:07'! binary ($~ / $- / $!! / $@ / $% / $& / $* / $+ / $= / $\ / $| / $? / $/ / $> / $< / $,) , ($~ / $!! / $@ / $% / $& / $* / $+ / $= / $\ / $| / $? / $/ / $> / $< / $,) star! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:43'! binaryExpression unaryExpression , binaryMessage star! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:42'! binaryMessage binaryToken , unaryExpression! ! !LASmalltalkParser methodsFor: 'grammar-methods' stamp: 'lr 9/23/2008 19:55'! binaryMethod binaryToken , variable ==> [ :nodes | Array with: nodes first value with: (Array with: nodes second) ]! ! !LASmalltalkParser methodsFor: 'grammar-pragmas' stamp: 'lr 10/20/2008 16:27'! binaryPragma binaryToken , arrayLiteralElement ==> [ :nodes | Array with: nodes first value with: (Array with: nodes second) ]! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! binaryToken binary small! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 14:43'! block $[ small , blockArguments , sequence , $] small! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/20/2008 17:15'! blockArgument $: small , variable! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:54'! blockArguments blockArgumentsMany / blockArgumentsNone! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 14:43'! blockArgumentsMany blockArgument plus , $| small! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:55'! blockArgumentsNone PPEpsilonParser new! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:29'! cascadeExpression keywordExpression , cascadeMessage star! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:45'! cascadeMessage $; flatten , (keywordMessage / binaryMessage / unaryMessage)! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:22'! char $$ , #any! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:15'! charLiteral charToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! charToken char small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:27'! expression assignment star , cascadeExpression! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:23'! falseLiteral falseToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! falseToken 'false' small! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:22'! identifier #letter , #word star! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! identifierToken identifier small! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! keyword identifier , $:! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:44'! keywordExpression binaryExpression , keywordMessage optional! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:44'! keywordMessage (keywordToken , binaryExpression) plus! ! !LASmalltalkParser methodsFor: 'grammar-methods' stamp: 'lr 9/23/2008 19:55'! keywordMethod (keywordToken , variable) plus ==> [ :nodes | Array with: (nodes inject: String new into: [ :result :each | result , each first value ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkParser methodsFor: 'grammar-pragmas' stamp: 'lr 10/20/2008 16:27'! keywordPragma (keywordToken , arrayLiteralElement) plus ==> [ :nodes | Array with: (nodes inject: String new into: [ :result :each | result , each first value ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! keywordToken keyword small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 11:11'! literal trueLiteral / falseLiteral / nilLiteral / charLiteral / numberLiteral / stringLiteral / symbolLiteral / arrayLiteral! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/20/2008 10:26'! method (keywordMethod / unaryMethod / binaryMethod) , methodSequence! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/20/2008 13:44'! methodSequence pragmas , temporaries , pragmas , statements ==> [ :nodes | Array with: nodes first , nodes third with: nodes second with: nodes fourth ]! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 9/23/2008 21:06'! multiword keyword plus! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! multiwordToken multiword small! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:16'! nilLiteral nilToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! nilToken 'nil' small! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/20/2008 16:48'! number ($- optional , #digit) and , [ :stream | [ Number readFrom: stream ] on: Error do: [ :err | PPFailure reason: err messageText at: stream position ] ] asParser! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! numberLiteral numberToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! numberToken number small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:39'! parens $( small , expression , $) small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/20/2008 17:13'! pragma $< small , (keywordPragma / unaryPragma / binaryPragma) , $> small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/20/2008 10:31'! pragmas pragma star! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:41'! primary variable / literal / block / parens / array! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 14:43'! return $^ small , expression! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:00'! sequence temporaries , statements! ! !LASmalltalkParser methodsFor: 'accessing' stamp: 'lr 10/17/2008 14:20'! start method end! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 14:43'! statements (return , $. small optional ==> [ :nodes | Array with: nodes first ]) / (expression , $. small , statements ==> [ :nodes | nodes third copyWithFirst: nodes first ]) / (expression , $. small optional ==> [ :nodes | Array with: nodes first ]) / ($. small optional ==> [ :node | #() ])! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! string $' , (($' , $') / $' negate) star , $'! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! stringLiteral stringToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! stringToken string small! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:55'! symbolLiteral $# , symbolToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/13/2008 17:21'! symbolToken unaryToken / binaryToken / multiwordToken / stringToken! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 14:43'! temporaries ($| small , variable star , $| small ==> [ :nodes | nodes second ]) / (PPEpsilonParser new ==> [ :nodes | Array new ])! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:18'! trueLiteral trueToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! trueToken 'true' small! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! unary identifier , $: not! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:07'! unaryExpression primary , unaryMessage star! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:47'! unaryMessage unaryToken! ! !LASmalltalkParser methodsFor: 'grammar-methods' stamp: 'lr 9/23/2008 19:55'! unaryMethod identifierToken ==> [ :node | Array with: node value with: #() ]! ! !LASmalltalkParser methodsFor: 'grammar-pragmas' stamp: 'lr 10/20/2008 16:16'! unaryPragma identifierToken ==> [ :node | Array with: node value with: #() ]! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! unaryToken unary small! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:02'! variable identifierToken! ! !ProtoObject methodsFor: '*languageaspects' stamp: 'lr 10/23/2008 10:39'! languageAspectsHighlighter ^ LAHighlightingAction new! ! PPTokenParser subclass: #LATokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LATokenParser methodsFor: 'hooks' stamp: 'lr 10/20/2008 10:17'! consumeSpaces: aStream [ super consumeSpaces: aStream. aStream peek == $" ] whileTrue: [ aStream next. [ aStream atEnd not and: [ aStream next = $" ] ] whileFalse ]! ! DSLRule subclass: #LAHighlightingAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Integration'! !LAHighlightingAction methodsFor: 'visiting' stamp: 'lr 10/23/2008 11:09'! acceptDsl: aVisitor | aspects | aspects := LAAspect allActiveForSelector: aVisitor selector in: (aVisitor theClass ifNil: [ Object ]). aspects isEmpty ifFalse: [ Transcript show: aspects; cr ]! ! TestCase subclass: #LAGrammarTests instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:57'! parse: aString ^ self parse: aString rule: #start! ! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:58'! parse: aString do: aBlock ^ aBlock value: (self parse: aString)! ! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 15:07'! parse: aString rule: aSymbol ^ (self parser productionAt: aSymbol definition: [ self error: 'Invalid production ' , aSymbol printString ]) parse: aString asParserStream! ! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:58'! parse: aString rule: aSymbol do: aBlock ^ aBlock value: (self parse: aString rule: aSymbol)! ! !LAGrammarTests methodsFor: 'accessing' stamp: 'lr 9/23/2008 20:44'! parser ^ parser ifNil: [ parser := LASmalltalkCompiler new ]! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/17/2008 12:58'! testArgumentsBlock self parse: '[ :a | ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: '[ :a :b | ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments size = 2. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node arguments second isVariable. self assert: node arguments second name = 'b'. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: '[ :a :b :c | ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments size = 3. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node arguments second isVariable. self assert: node arguments second name = 'b'. self assert: node arguments third isVariable. self assert: node arguments third name = 'c'. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! testArrayLiteral self parse: '#()' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #( ) ]. self parse: '#(1)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #(1) ]. self parse: '#(1 2)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #(1 2) ]. self parse: '#(true false nil)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #(true false nil) ]. self parse: '#($a)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #($a) ]. self parse: '#(1.2)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #(1.2) ]. self parse: '#(size at: at:put: ==)' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #(size at: at:put: ==) ]. self parse: '#(''baz'')' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #('baz') ]. self parse: '#((1) 2))' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #((1) 2) ]. self parse: '#((1 2) #(1 2 3))' rule: #arrayLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #((1 2)(1 2 3)) ]! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/17/2008 13:59'! testAssignment self parse: '1' rule: #expression do: [ :node | self assert: node isLiteral. self assert: node value = 1 ]. self parse: 'a := 1' rule: #expression do: [ :node | self assert: node isAssignment. self assert: node variable isVariable. self assert: node variable name = 'a'. self assert: node value isLiteral. self assert: node value value = 1 ]. self parse: 'a := b := 1' rule: #expression do: [ :node | self assert: node isAssignment. self assert: node variable isVariable. self assert: node variable name = 'a'. self assert: node value isAssignment. self assert: node value variable isVariable. self assert: node value variable name = 'b'. self assert: node value value isLiteral. self assert: node value value value = 1 ]. self parse: '1' rule: #expression do: [ :node | self assert: node isLiteral. self assert: node value = 1 ]. self parse: 'a _ 1' rule: #expression do: [ :node | self assert: node isAssignment. self assert: node variable isVariable. self assert: node variable name = 'a'. self assert: node value isLiteral. self assert: node value value = 1 ]. self parse: 'a _ b _ 1' rule: #expression do: [ :node | self assert: node isAssignment. self assert: node variable isVariable. self assert: node variable name = 'a'. self assert: node value isAssignment. self assert: node value variable isVariable. self assert: node value variable name = 'b'. self assert: node value value isLiteral. self assert: node value value value = 1 ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 13:16'! testBinaryExpression self parse: '1 + 2' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isLiteral. self assert: node receiver value = 1. self assert: node arguments size = 1. self assert: node arguments first isLiteral. self assert: node arguments first value = 2 ]. self parse: '1 + 2 + 3' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isMessage. self assert: node receiver receiver isLiteral. self assert: node receiver receiver value = 1. self assert: node receiver arguments size = 1. self assert: node receiver arguments first isLiteral. self assert: node receiver arguments first value = 2. self assert: node arguments size = 1. self assert: node arguments first isLiteral. self assert: node arguments first value = 3 ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 14:09'! testBinaryMethod self parse: '+ a' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #+. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: '+ a | b |' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #+. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries size = 1. self assert: node body statements isEmpty ]. self parse: '+ a b' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #+. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries isEmpty. self assert: node body statements size = 1 ]. self parse: '+ a | b | c' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #+. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 13:29'! testCascadeExpression self parse: '1 abs; negated' rule: #expression do: [ :node | self assert: node isCascade. self assert: node receiver isLiteral. self assert: node messages size = 2. self assert: node messages first receiver = node receiver. self assert: node messages first selector = #abs. self assert: node messages second receiver = node receiver. self assert: node messages second selector = #negated ]. self parse: '1 abs negated; raisedTo: 12; negated' rule: #expression do: [ :node | self assert: node isCascade. self assert: node receiver isMessage. self assert: node receiver receiver isLiteral. self assert: node receiver receiver value = 1. self assert: node receiver selector = #abs. self assert: node messages size = 3. self assert: node messages first receiver = node receiver. self assert: node messages first selector = #negated. self assert: node messages second receiver = node receiver. self assert: node messages second selector = #raisedTo:. self assert: node messages third receiver = node receiver. self assert: node messages third selector = #negated ]. self parse: '1 + 2; - 3' rule: #expression do: [ :node | self assert: node isCascade. self assert: node receiver isLiteral. self assert: node receiver value = 1. self assert: node messages size = 2. self assert: node messages first receiver = node receiver. self assert: node messages first selector = #+. self assert: node messages first arguments size = 1. self assert: node messages second receiver = node receiver. self assert: node messages second selector = #-. self assert: node messages second arguments size = 1 ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! testCharLiteral self parse: '$a' rule: #charLiteral do: [ :node | self assert: node isLiteral. self assert: node value = $a ]. self parse: '$ ' rule: #charLiteral do: [ :node | self assert: node isLiteral. self assert: node value = Character space ]. self parse: '$$' rule: #charLiteral do: [ :node | self assert: node isLiteral. self assert: node value = $$ ]! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/17/2008 12:53'! testComplexBlock self parse: '[ :a | | b | c ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments size = 1. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ]. self parse: '[:a||b|c]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments size = 1. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ].! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 13:13'! testKeywordExpression self parse: '1 to: 2' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isLiteral. self assert: node receiver value = 1. self assert: node selector = #to:. self assert: node arguments size = 1. self assert: node arguments first isLiteral. self assert: node arguments first value = 2 ]. self parse: '1 to: 2 by: 3' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isLiteral. self assert: node selector = #to:by:. self assert: node arguments size = 2. self assert: node arguments first isLiteral. self assert: node arguments first value = 2. self assert: node arguments second isLiteral. self assert: node arguments second value = 3 ]. self parse: '1 to: 2 by: 3 do: 4' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isLiteral. self assert: node selector = #to:by:do:. self assert: node arguments size = 3. self assert: node arguments first isLiteral. self assert: node arguments first value = 2. self assert: node arguments second isLiteral. self assert: node arguments second value = 3. self assert: node arguments third isLiteral. self assert: node arguments third value = 4 ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 14:25'! testKeywordMethod self parse: 'to: a' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #to:. self assert: node arguments size = 1. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: 'to: a do: b | c |' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #to:do:. self assert: node arguments size = 2. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node arguments second isVariable. self assert: node arguments second name = 'b'. self assert: node body temporaries size = 1. self assert: node body statements isEmpty ]. self parse: 'to: a do: b by: c d' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #to:do:by:. self assert: node arguments size = 3. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node arguments second isVariable. self assert: node arguments second name = 'b'. self assert: node arguments third isVariable. self assert: node arguments third name = 'c'. self assert: node body temporaries isEmpty. self assert: node body statements size = 1 ]. self parse: 'to: a do: b by: c | d | e' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #to:do:by:. self assert: node arguments size = 3. self assert: node arguments first isVariable. self assert: node arguments first name = 'a'. self assert: node arguments second isVariable. self assert: node arguments second name = 'b'. self assert: node arguments third isVariable. self assert: node arguments third name = 'c'. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/20/2008 16:42'! testNumberLiteral self parse: '0' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 0 ]. self parse: '0.1' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 0.1 ]. self parse: '123' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 123 ]. self parse: '123.456' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 123.456 ]. self parse: '-0' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 0 ]. self parse: '-0.1' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = -0.1 ]. self parse: '-123' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = -123 ]. self parse: '-123.456' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = -123.456 ]. self parse: '10r10' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 10 ]. self parse: '8r777' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 511 ]. self parse: '16rAF' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 175 ]. self parse: '16rCA.FE' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 202.9921875 ]. self parse: '3r-22.2' rule: #numberLiteral do: [ :node | self assert: node isLiteral. self assert: node value floor = -9 ]! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/20/2008 16:14'! testPragmas self parse: 'method ' rule: #method do: [ :node | self assert: node pragmas size = 1. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty. ]. self parse: 'method ' rule: #method do: [ :node | self assert: node pragmas size = 2. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty. ]. self parse: 'method | a | ' rule: #method do: [ :node | self assert: node pragmas size = 1. self assert: node body temporaries size = 1. self assert: node body statements isEmpty. ]. self parse: 'method | a |' rule: #method do: [ :node | self assert: node pragmas size = 1. self assert: node body temporaries size = 1. self assert: node body statements isEmpty. ]. self parse: 'method | a | ' rule: #method do: [ :node | self assert: node pragmas size = 2. self assert: node body temporaries size = 1. self assert: node body statements isEmpty ].! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/17/2008 13:56'! testSequence self parse: '| a | 1 . 2' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries size = 1. self assert: node temporaries first isVariable. self assert: node temporaries first name = 'a'. self assert: node statements size = 2. self assert: node statements first isLiteral. self assert: node statements first value = 1. self assert: node statements second isLiteral. self assert: node statements second value = 2 ]! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/17/2008 12:59'! testSimpleBlock self parse: '[ ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments isEmpty. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: '[ nil ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments isEmpty. self assert: node body temporaries isEmpty. self assert: node body statements size = 1 ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! testSpecialLiteral self parse: 'true' rule: #trueLiteral do: [ :node | self assert: node isLiteral. self assert: node value = true ]. self parse: 'false' rule: #falseLiteral do: [ :node | self assert: node isLiteral. self assert: node value = false ]. self parse: 'nil' rule: #nilLiteral do: [ :node | self assert: node isLiteral. self assert: node value = nil ]! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/17/2008 12:59'! testStatementBlock self parse: '[ nil ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments isEmpty. self assert: node body temporaries isEmpty. self assert: node body statements size = 1 ]. self parse: '[ | a | nil ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments isEmpty. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ]. self parse: '[ | a b | nil ]' rule: #block do: [ :node | self assert: node isBlock. self assert: node arguments isEmpty. self assert: node body temporaries size = 2. self assert: node body statements size = 1 ]! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/17/2008 13:57'! testStatements self parse: '1' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries isEmpty. self assert: node statements size = 1. self assert: node statements first isLiteral. self assert: node statements first value = 1 ]. self parse: '1 . 2' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries isEmpty. self assert: node statements size = 2. self assert: node statements first isLiteral. self assert: node statements first value = 1. self assert: node statements second isLiteral. self assert: node statements second value = 2 ]. self parse: '1 . 2 . 3' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries isEmpty. self assert: node statements size = 3. self assert: node statements first isLiteral. self assert: node statements first value = 1. self assert: node statements second isLiteral. self assert: node statements second value = 2. self assert: node statements third isLiteral. self assert: node statements third value = 3 ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! testStringLiteral self parse: '''''' rule: #stringLiteral do: [ :node | self assert: node isLiteral. self assert: node value = '' ]. self parse: '''ab''' rule: #stringLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 'ab' ]. self parse: '''ab''''cd''' rule: #stringLiteral do: [ :node | self assert: node isLiteral. self assert: node value = 'ab''cd' ]! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! testSymbolLiteral self parse: '#foo' rule: #symbolLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #foo ]. self parse: '#+' rule: #symbolLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #+ ]. self parse: '#key:' rule: #symbolLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #key: ]. self parse: '#key:value:' rule: #symbolLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #key:value: ]. self parse: '#''testing-node''' rule: #symbolLiteral do: [ :node | self assert: node isLiteral. self assert: node value = #'testing-node' ]! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/17/2008 13:59'! testTemporaries self parse: '| a |' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries size = 1. self assert: node temporaries first isVariable. self assert: node temporaries first name = 'a'. self assert: node statements isEmpty ]. self parse: '| a b |' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries size = 2. self assert: node temporaries first isVariable. self assert: node temporaries first name = 'a'. self assert: node temporaries second isVariable. self assert: node temporaries second name = 'b'. self assert: node statements isEmpty ]. self parse: '| a b c |' rule: #sequence do: [ :node | self assert: node isSequence. self assert: node temporaries size = 3. self assert: node temporaries first isVariable. self assert: node temporaries first name = 'a'. self assert: node temporaries second isVariable. self assert: node temporaries second name = 'b'. self assert: node temporaries third isVariable. self assert: node temporaries third name = 'c'. self assert: node statements isEmpty ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 13:13'! testUnaryExpression self parse: '1 abs' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isLiteral. self assert: node selector = #abs. self assert: node arguments isEmpty ]. self parse: '1 abs negated' rule: #expression do: [ :node | self assert: node isMessage. self assert: node receiver isMessage. self assert: node receiver receiver isLiteral. self assert: node receiver receiver value = 1. self assert: node receiver selector = #abs. self assert: node receiver arguments isEmpty. self assert: node selector = #negated. self assert: node arguments isEmpty ]! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/17/2008 14:09'! testUnaryMethod self parse: 'abs' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #abs. self assert: node arguments isEmpty. self assert: node body temporaries isEmpty. self assert: node body statements isEmpty ]. self parse: 'abs | a |' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #abs. self assert: node arguments isEmpty. self assert: node body temporaries size = 1. self assert: node body statements isEmpty ]. self parse: 'abs a' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #abs. self assert: node arguments isEmpty. self assert: node body temporaries isEmpty. self assert: node body statements size = 1 ]. self parse: 'abs | a | b' rule: #method do: [ :node | self assert: node isMethod. self assert: node selector = #abs. self assert: node arguments isEmpty. self assert: node body temporaries size = 1. self assert: node body statements size = 1 ]! ! TestCase subclass: #LAPackagesTests instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LAPackagesTests methodsFor: 'accessing' stamp: 'lr 10/20/2008 16:58'! parser ^ parser ifNil: [ parser := LASmalltalkCompiler new ]! ! !LAPackagesTests methodsFor: 'testing' stamp: 'lr 10/20/2008 17:08'! testCollections self verifyClass: Collection. self verifyClass: SequenceableCollection. self verifyClass: OrderedCollection. self verifyClass: Array. self verifyClass: Dictionary. self verifyClass: Set. self verifyClass: Bag ! ! !LAPackagesTests methodsFor: 'testing' stamp: 'lr 10/20/2008 17:09'! testMorph self verifyClass: Morph! ! !LAPackagesTests methodsFor: 'testing' stamp: 'lr 10/20/2008 17:00'! testPetitParser self verifyPackage: 'PetitParser'! ! !LAPackagesTests methodsFor: 'testing' stamp: 'lr 10/20/2008 17:03'! testQuasiQuote self verifyPackage: 'QuasiQuote'! ! !LAPackagesTests methodsFor: 'private' stamp: 'lr 10/20/2008 17:03'! verifyClass: aClass aClass selectors do: [ :selector | self verifyClass: aClass selector: selector ]! ! !LAPackagesTests methodsFor: 'private' stamp: 'lr 10/20/2008 17:02'! verifyClass: aClass selector: aSelector | source original other | source := aClass sourceCodeAt: aSelector. source isNil ifTrue: [ ^ self ]. original := aClass parseTreeFor: aSelector. original isNil ifTrue: [ ^ self ]. original nodesDo: [ :each | each comments: nil ]. other := self parser parse: source asParserStream. other isFailure ifTrue: [ self assert: false description: other printString resumable: true ] ifFalse: [ self assert: original formattedCode = other formattedCode description: source resumable: true ]! ! !LAPackagesTests methodsFor: 'private' stamp: 'lr 10/20/2008 17:01'! verifyPackage: aString | package | package := PackageInfo named: aString. package classesAndMetaClasses do: [ :each | self verifyClass: each ] displayingProgress: 'Verifying ' , aString! ! TestCase subclass: #LAPathAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! TestCase subclass: #LARegexpAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 10/23/2008 11:16'! aspect ^ LARegexpAspect default! ! LARegexpAspect initialize!