SystemOrganization addCategory: #'LanguageAspects-Core'! SystemOrganization addCategory: #'LanguageAspects-Tests'! SystemOrganization addCategory: #'LanguageAspects-Examples'! CUCompositeParser subclass: #LASmalltalkParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! LASmalltalkParser subclass: #LASmalltalkCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !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 11:08'! arrayLiteralArray super arrayLiteralArray ==> [ :nodes | nodes third 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 9/23/2008 19:59'! method super method map: [ :declaration :sequence | RBMethodNode selector: declaration first asSymbol arguments: declaration second body: sequence ]! ! !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 9/23/2008 20:35'! parens super parens ==> #second! ! !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 methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! anyChar #any! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:13'! arrayLiteral '#(' token , arrayLiteralElement star , $) token! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:55'! arrayLiteralArray $# optional , $( token , arrayLiteralElement star , $) token! ! !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 9/23/2008 19:54'! assignmentToken (':=' / '_') token! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:07'! barChar $_! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 9/23/2008 19:53'! 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: 'token' stamp: 'lr 9/23/2008 19:53'! binaryToken binary token! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 11:58'! block $[ token , blockArguments , sequence , $] token! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 11:59'! blockArgument $: , variable! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:54'! blockArguments blockArgumentsMany / blockArgumentsNone! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:57'! blockArgumentsMany blockArgument plus , $| token! ! !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/13/2008 17:06'! char dollarChar , anyChar! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:15'! charLiteral charToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 9/23/2008 19:54'! charToken char token! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! colonChar $:! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! commaChar $,! ! !LASmalltalkParser methodsFor: 'creational' stamp: 'lr 9/23/2008 16:56'! createMessageSend: aCollection ^ RBMessageNode receiver: aCollection first selector: aCollection second first asSymbol arguments: aCollection second second asArray! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! digitChar #digit! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! dollarChar $$! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! dotChar $.! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! doubleQuoteChar $"! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! equalChar $=! ! !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 9/23/2008 19:54'! falseToken 'false' token! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! hashChar $#! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! hatChar $^! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/13/2008 17:08'! identifier letterChar , wordChar star! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 9/23/2008 19:53'! identifierToken identifier token! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/13/2008 17:06'! keyword identifier , colonChar! ! !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: 'token' stamp: 'lr 9/23/2008 19:53'! keywordToken keyword token! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! leftAngleBracketChar $! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! rightCurlyBracketChar $}! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! rightParenChar $)! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! rightSquareBracketChar $]! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! semicolonChar $;! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:00'! sequence temporaries , statements! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:06'! singleQuoteChar $'! ! !LASmalltalkParser methodsFor: 'accessing' stamp: 'lr 9/23/2008 21:30'! start ^ method end! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:04'! statements (return , $. flatten optional ==> [ :nodes | Array with: nodes first ]) / (expression , $. flatten , statements ==> [ :nodes | nodes third copyWithFirst: nodes first ]) / (expression , $. flatten optional ==> [ :nodes | Array with: nodes first ]) / ($. flatten optional ==> [ :node | #() ])! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/13/2008 17:09'! string singleQuoteChar , ((singleQuoteChar , singleQuoteChar) / singleQuoteChar negate) star , singleQuoteChar! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! stringLiteral stringToken! ! !LASmalltalkParser methodsFor: 'token' stamp: 'lr 9/23/2008 19:54'! stringToken string token! ! !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 9/23/2008 20:04'! temporaries ($| token , variable star , $| token ==> [ :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 9/23/2008 19:54'! trueToken 'true' token! ! !LASmalltalkParser methodsFor: 'primitives' stamp: 'lr 10/13/2008 17:09'! unary identifier , colonChar 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: 'token' stamp: 'lr 9/23/2008 21:07'! unaryToken unary token! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:02'! variable identifierToken! ! !LASmalltalkParser methodsFor: 'token-chars' stamp: 'lr 10/13/2008 17:08'! wordChar #word! ! Object subclass: #LAAspect instanceVariableNames: 'active environments concerns pointcut' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! LAAspect class instanceVariableNames: 'Default'! LAAspect class instanceVariableNames: 'Default'! !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/10/2008 15:10'! add: 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: 'scoping' stamp: 'lr 10/10/2008 15:04'! addClass: aClass ^ self add: (BrowserEnvironment new forClasses: (Array with: aClass))! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/10/2008 15:04'! addPackage: aString ^ self add: (BrowserEnvironment new forPackageNamed: aString)! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:21'! concerns "Answer a collection of concerns." ^ concerns! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:06'! environment "Answer a a composed environment." ^ environments isEmpty ifTrue: [ BrowserEnvironment new not ] ifFalse: [ environments for: [ :first :second | first | second ] ]! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/10/2008 15:05'! environments "Answer a collection of environments." ^ environments! ! !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/10/2008 15:23'! 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 subclass: #PathAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! LAAspect subclass: #RegexpAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !RegexpAspect methodsFor: 'initialization' stamp: 'lr 10/13/2008 13:42'! initialize super initialize. self pointcut name: #literal; after; choice; parser: $/ asParser , $/ asParser not , $/ asParser! ! 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: 'color' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !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! ! 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.' ] ] ] ])! ! Object subclass: #NewSpeak instanceVariableNames: '' classVariableNames: 'PredicateTokenParser UnarySelectorParser SmalltalkParser' poolDictionaries: '' category: 'LanguageAspects-Examples'! !NewSpeak methodsFor: 'as yet unclassified' stamp: 'lr 10/13/2008 16:52'! lexicalGrammar " All the lexical productions are defined in this method. This makes it rather long, but puts everything in one convenient place. " | radix fraction exponent extendedFraction extendedDigits kws commentDelimiter digit digits decimalNum radixNum num number letter specialCharacter character id identifier char characterConstant twoQuotes str string kw keyword sym symbol beginComment endComment twoDblQuotes comment binSel binarySelector assign assignment | digit := self charBetween: $0 and: $9."PredicateTokenParser new accept:[:c | c between: $0 and: $9] errorMsg: 'digit expected'." digits := self digit plus. extendedDigits := (self digit | [self letter]) plus. radix := self digits, [self char: $r] wrapper:[:ds :r | ds]. fraction := self dot, [self digits] wrapper:[:period :ds | ds]. extendedFraction := self dot, [extendedDigits] wrapper:[:period :ds | ds]. exponent := (self char: $e), [(self char: $- ) opt], [self digits] wrapper:[:e :sgn :ds | sgn isNil ifTrue:[ds] ifFalse:[sgn asString, ds]]. decimalNum := (self char: $-) opt, [self digits], [fraction opt], [exponent opt]. radixNum := radix, [(self char: $-) opt], [extendedDigits], [extendedFraction opt], [exponent opt]. num := self radixNum | [self decimalNum]. "must distinguish internal use of productions from use as tokens" number := self tokenFor: self num. letter := PredicateTokenParser new accept:[:c | SmalltalkParser isLetter: c] errorMsg: 'letter expected'. "(PredicateTokenParser new accept:[:c | c between: $A and: $Z] errorMsg: '' ) | [PredicateTokenParser new accept:[:c | c between: $a and: $z] errorMsg: 'letter expected' ]." specialCharacter := (self char: $+ ) | [self char: $/ ] | [self char: $\ ] | [self char: $* ] | [self char: $~ ] | [self char: $<] | [self char: $>] | [self char: $=] | [self char: $@ ] | [self char: $% ] | [self char: $| ] | [self char: $& ] | [self char: $? ] | [self char: $!! ] | [self char: $, ]. character := self digit | [self letter] | [self specialCharacter] | [self char: $[ ] | [self char: $] ] | [self char: ${ ] | [self char: $} ] | [self char: $( ] | [self char:$) ] | [self char: $^ ] | [self char: $; ] | [self char: $$ ] | [self char: $# ] | [self char: $: ] | [self char: $. ] | [self char: $-] | [self char: $_] | [self char: $`] "the Smalltalk grammar neglects to add - to characters, or to comments. It does add | [self char: $' ], but these are both bugs. We intend to support underscores, which Squeak insists on tirning into assignment arrows. However, we do not support these as assignments. At the moment, we do not accept them in identifiers, but this will change in time.". id := self letter, [(self letter | [self digit]) star] wrapper:[:fst :snd | fst asString, (String withAll: snd)]. identifier := self tokenFor: self id. char := (self char: $$), [self character | [self char: $' ] | [self char: $" ] | [self char:$ ]]. characterConstant := self tokenFor: self char. twoQuotes := (self char: $' ), [self char: $' ] wrapper:[:q1 : q2 | '''']. str := (self char: $' ), [self stringBody], "[(self character | [self aWhitespaceChar] | [self char: $" "] | [self twoQuotes]) star]," [self char: $'] wrapper:[:oq :es :eq | es inject:'' into:[:s : e | s, e asString]]. string := self tokenFor: self str. kw := self id, [self char: $:] wrapper:[: i :c | i, $: asString]. kws := self kw plus wrap:[:c | c inject: '' into:[:s :e | s, e]]. keyword := self tokenFor: self kw. sym := self str | [kws] | [self binSel] | [self id]. symbol := self tokenFor: self sym. commentDelimiter := self char: $". beginComment := commentDelimiter. endComment := commentDelimiter. twoDblQuotes := (self char: $" ), [self char: $" ] wrapper:[:q1 : q2 | '"']. comment := self beginComment, [self commentBody], [self endComment]. binSel := (self specialCharacter | [self char: $- ]), [self specialCharacter opt] wrapper:[:c1 :c2 | c2 isNil ifTrue:[c1 asString asSymbol] ifFalse:[(c1 asString, c2 asString) asSymbol ] "probably delay interning as symbol until later phase" ]. binarySelector := self tokenFor: self binSel. "maybe intern as symbol here" assign := (self char: $:), [self char: $=] wrapper:[:c :e | #':=']. assignment := self tokenFor: (self assign | [self char: $_]). "Temporary hack"! ! !NewSpeak methodsFor: 'as yet unclassified' stamp: 'lr 10/13/2008 16:53'! setupTokens | whitespace colon comma dollar dot equalSign hat lbracket lcurly lparen langleBracket pound rangleBracket rbracket rcurly rparen semicolon slash vbar | whitespace := self whitespace. colon := self tokenFromChar: $:. comma := self tokenFromChar: $,. dollar := self tokenFromChar: $$. dot := self tokenFromChar: $.. equalSign := self tokenFromChar:$=. hat := self tokenFromChar: $^. lbracket := self tokenFromChar: $[. lcurly := self tokenFromChar: ${. lparen := self tokenFromChar: $(. langleBracket := self tokenFromChar: $<. pound := self tokenFromChar: $#. rangleBracket := self tokenFromChar: $>. rbracket := self tokenFromChar: $]. rcurly := self tokenFromChar: $}. rparen := self tokenFromChar: $). semicolon := self tokenFromChar: $;. slash := self tokenFromChar: $/. vbar := self tokenFromChar: $|.! ! !NewSpeak methodsFor: 'as yet unclassified' stamp: 'lr 10/13/2008 16:51'! syntacticGrammar "The entire syntactic grammar for Smalltalk,with a syntax for top level classes as well" "This is a very large method, but it does allow the entire grammar to be viewed as a unit" | symbolConstant array arrayConstant tuple literal variableName unarySelector parenthesizedExpression primary unaryExpression binaryMsg binaryExpression keywordMsg keywordExpression cascadeMsg cascadedMessageExpression assignmentLHS expression returnStatement furtherStatements statementSequence statements blockParameter blockParameters varDecls temporaries codeBody block variableDecl unaryMsgPattern binaryMsgPattern keywordMsgPattern messagePattern methodBody method methodDecl category classComment classBody classSideDecl languageId classCategory classDefinition | symbolConstant := self pound, [self symbol]. array := self lparen, [(self number | [self symbol] | [self string] | [self characterConstant] | [self array]) star], [self rparen]. arrayConstant := self pound, [self array]. tuple := self lcurly, [self expression starSeparatedOrTerminatedBy: self dot], [self rcurly]. literal := self number | [self symbolConstant] | [self characterConstant] | [self string] | [self arrayConstant] | [self tuple]. variableName := self identifier. unarySelector := (UnarySelectorParser new on: self). " the one hack/flaw. See UnarySelector parser for details" parenthesizedExpression := self lparen, [self expression], [self rparen]. primary := self variableName | [self literal] | [self block] | [self parenthesizedExpression]. unaryExpression := self primary, [self unarySelector star]. binaryMsg := self binarySelector, [self unaryExpression]. binaryExpression := self unaryExpression, [self binaryMsg star]. keywordMsg := (self keyword, [self binaryExpression]) plus. keywordExpression := self binaryExpression, [self keywordMsg opt]. cascadeMsg := self semicolon, [self keywordMsg | [self binaryMsg] | [self unarySelector]]. cascadedMessageExpression := self keywordExpression, [self cascadeMsg star]. assignmentLHS := self variableName, [self assignment]. expression := self assignmentLHS star, [self cascadedMessageExpression ]. returnStatement := self hat, [self expression], [self dot opt]. furtherStatements := self dot, [self statements]. statementSequence := self expression, [self furtherStatements opt]. statements := self returnStatement | [self statementSequence] | [self empty]. blockParameter := self colon, [self variableDecl]. blockParameters := self blockParameter plus, [self vbar]. varDecls := self vbar, [self variableDecl star], [self vbar]. temporaries := self varDecls. codeBody := self temporaries opt, [self statements]. block := self lbracket, [self blockParameters opt], [self codeBody], [self rbracket]. variableDecl := self identifier. unaryMsgPattern := self unarySelector. binaryMsgPattern := self binarySelector, [self variableDecl]. keywordMsgPattern := (self keyword, [self variableDecl]) plus. messagePattern := self unaryMsgPattern | [self binaryMsgPattern] | [self keywordMsgPattern ]. methodBody := self codeBody. method := self messagePattern, [self methodBody], [self eoi]. "A method in a browser" "Top level productions for classes" methodDecl := self messagePattern, [self equalSign], [self lparen], [self methodBody], [self rparen]. category := self string, [self methodDecl star]. classComment := self whitespace, [self comment]. "A hack, to preserve comments from a complete class declaration" classBody := self lparen, [self classComment opt], [self varDecls opt], [self category star], [self rparen]. classSideDecl := self colon, [self classBody ]. languageId := self identifier. classCategory := self string opt. classDefinition := self languageId, [self classCategory], [self identifier], [self equalSign], [self identifier], [self classBody],[ self classSideDecl opt], [self eoi].! ! TestCase subclass: #LASmalltalkParserTests instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LASmalltalkParserTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:57'! parse: aString ^ self parse: aString rule: #start! ! !LASmalltalkParserTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:58'! parse: aString do: aBlock ^ aBlock value: (self parse: aString)! ! !LASmalltalkParserTests 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! ! !LASmalltalkParserTests methodsFor: 'parsing' stamp: 'lr 10/13/2008 13:58'! parse: aString rule: aSymbol do: aBlock ^ aBlock value: (self parse: aString rule: aSymbol)! ! !LASmalltalkParserTests methodsFor: 'accessing' stamp: 'lr 9/23/2008 20:44'! parser ^ parser ifNil: [ parser := LASmalltalkCompiler new ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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)) ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 = $$ ]! ! !LASmalltalkParserTests methodsFor: 'testing-world' stamp: 'lr 10/17/2008 13:38'! testCollection Collection withAllSubclasses do: [ :each | self verifyClass: each; verifyClass: each class ] displayingProgress: 'Collection Hierarchy'! ! !LASmalltalkParserTests 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 ].! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests methodsFor: 'testing-literals' stamp: 'lr 10/17/2008 12:07'! 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 ]! ! !LASmalltalkParserTests methodsFor: 'testing-world' stamp: 'lr 10/17/2008 13:36'! testReceiver self verifyClass: self class! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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' ]! ! !LASmalltalkParserTests 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' ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests 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 ]! ! !LASmalltalkParserTests methodsFor: 'private' stamp: 'lr 10/17/2008 13:37'! verifyClass: aClass aClass selectors do: [ :selector | self verifyClass: aClass selector: selector ] displayingProgress: 'Verifying ' , aClass name! ! !LASmalltalkParserTests methodsFor: 'private' stamp: 'lr 10/17/2008 13:41'! verifyClass: aClass selector: aSelector | source original other | source := aClass sourceCodeAt: aSelector. source isNil ifTrue: [ ^ self ]. original := aClass parseTreeFor: aSelector. 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 ]! ! TestCase subclass: #PathAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !PathAspectTest class methodsFor: 'initialization' stamp: 'lr 10/10/2008 15:19'! initialize PathAspect default addClass: self! ! TestCase subclass: #RegexpAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !RegexpAspectTest class methodsFor: 'initialization' stamp: 'lr 10/10/2008 15:19'! initialize RegexpAspect default addClass: self! ! !RegexpAspectTest methodsFor: 'accessing' stamp: 'lr 10/13/2008 13:43'! aspect ^ RegexpAspect default! ! PathAspectTest initialize! RegexpAspectTest initialize!