SystemOrganization addCategory: #'LanguageAspects-Core'! SystemOrganization addCategory: #'LanguageAspects-DSL'! SystemOrganization addCategory: #'LanguageAspects-Tests'! SystemOrganization addCategory: #'LanguageAspects-Examples'! SystemOrganization addCategory: #'LanguageAspects-OmniBrowser'! !RBAssignmentNode methodsFor: '*languageaspects-override' stamp: 'lr 10/17/2008 15:10'! assignmentOperator ^ self defaultAssignmentOperator! ! CUCompositeParser subclass: #LASmalltalkGrammar instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LASmalltalkGrammar class methodsFor: 'accessing' stamp: 'lr 11/11/2008 15:14'! pragma ^ nil! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/20/2008 10:24'! array ${ small , statements , $} small! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:43'! arrayLiteral '#(' small , arrayLiteralElement star , $) small! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:43'! arrayLiteralArray ($# optional , $() small , arrayLiteralElement star , $) small! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:11'! arrayLiteralChar charToken! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:10'! arrayLiteralElement arrayLiteralTrue / arrayLiteralFalse / arrayLiteralNil / arrayLiteralNumber / arrayLiteralChar / arrayLiteralString / arrayLiteralSymbol / arrayLiteralArray! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralFalse falseToken! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralNil nilToken! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralNumber numberToken! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:12'! arrayLiteralString stringToken! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 13:50'! arrayLiteralSymbol ($# optional , symbol) small! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:11'! arrayLiteralTrue trueToken! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:27'! assignment variable , assignmentToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! assignmentToken (':=' / '_') small! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 15:07'! binary ($~ / $- / $!! / $@ / $% / $& / $* / $+ / $= / $\ / $| / $? / $/ / $> / $< / $,) , ($~ / $!! / $@ / $% / $& / $* / $+ / $= / $\ / $| / $? / $/ / $> / $< / $,) star! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 18:43'! binaryExpression unaryExpression , binaryMessage star! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 10:54'! binaryMessage (binaryToken , unaryExpression) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 10/24/2008 10:48'! binaryMethod (binaryToken , variable) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'lr 10/24/2008 11:57'! binaryPragma (binaryToken , arrayLiteralElement) ==> [ :nodes | Array with: (Array with: nodes first) with: (Array with: nodes second) ]! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! binaryToken binary small! ! !LASmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 14:43'! block $[ small , blockArguments , sequence , $] small! ! !LASmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 10/20/2008 17:15'! blockArgument $: small , variable! ! !LASmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:54'! blockArguments blockArgumentsMany / blockArgumentsNone! ! !LASmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 14:43'! blockArgumentsMany blockArgument plus , $| small! ! !LASmalltalkGrammar methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:55'! blockArgumentsNone PPEpsilonParser new! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:29'! cascadeExpression keywordExpression , cascadeMessage star! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:25'! cascadeMessage $; small , (keywordMessage / binaryMessage / unaryMessage)! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:22'! char $$ , #any! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:15'! charLiteral charToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! charToken char small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:27'! expression assignment star , cascadeExpression! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:23'! falseLiteral falseToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! falseToken 'false' small! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:22'! identifier #letter , #word star! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! identifierToken identifier small! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! keyword identifier , $:! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:11'! keywordExpression binaryExpression , keywordMessage optional! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 10:55'! keywordMessage (keywordToken , binaryExpression) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 10/24/2008 10:47'! keywordMethod (keywordToken , variable) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'lr 10/24/2008 11:57'! keywordPragma (keywordToken , arrayLiteralElement) plus ==> [ :nodes | Array with: (nodes collect: [ :each | each first ]) with: (nodes collect: [ :each | each second ]) ]! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! keywordToken keyword small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/17/2008 11:11'! literal trueLiteral / falseLiteral / nilLiteral / charLiteral / numberLiteral / stringLiteral / symbolLiteral / arrayLiteral! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/24/2008 10:40'! method methodDeclaration , methodSequence! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/24/2008 10:48'! methodDeclaration keywordMethod / unaryMethod / binaryMethod! ! !LASmalltalkGrammar 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 ]! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 9/23/2008 21:06'! multiword keyword plus! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! multiwordToken multiword small! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:16'! nilLiteral nilToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! nilToken 'nil' small! ! !LASmalltalkGrammar 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! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! numberLiteral numberToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! numberToken number small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:39'! parens $( small , expression , $) small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/20/2008 17:13'! pragma $< small , (keywordPragma / unaryPragma / binaryPragma) , $> small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/20/2008 10:31'! pragmas pragma star! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:41'! primary variable / literal / block / parens / array! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/23/2008 17:09'! return $^ small , expression! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:00'! sequence temporaries , statements! ! !LASmalltalkGrammar methodsFor: 'accessing' stamp: 'lr 10/17/2008 14:20'! start method end! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/23/2008 14:05'! statements (return , $. small optional ==> [ :nodes | Array with: nodes first ]) / (expression wrapped , $. small , statements ==> [ :nodes | nodes third copyWithFirst: nodes first ]) / (expression wrapped , $. small optional ==> [ :nodes | Array with: nodes first ]) / ($. small optional ==> [ :node | Array new ])! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! string $' , (($' , $') / $' negate) star , $'! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! stringLiteral stringToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! stringToken string small! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/23/2008 13:50'! symbol unary / binary / multiword / string! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/23/2008 13:50'! symbolLiteral ($# , symbol) small! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/23/2008 13:49'! symbolToken symbol small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 10/23/2008 13:52'! temporaries ($| small , variable star , $| small) optional ==> [ :nodes | nodes isNil ifTrue: [ Array new ] ifFalse: [ nodes ] ]! ! !LASmalltalkGrammar methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:18'! trueLiteral trueToken! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! trueToken 'true' small! ! !LASmalltalkGrammar methodsFor: 'primitives' stamp: 'lr 10/17/2008 14:23'! unary identifier , $: not! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 9/23/2008 19:07'! unaryExpression primary , unaryMessage star! ! !LASmalltalkGrammar methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 10:55'! unaryMessage (unaryToken) ==> [ :node | Array with: (Array with: node) with: (Array new) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-methods' stamp: 'lr 10/24/2008 10:55'! unaryMethod (identifierToken) ==> [ :node | Array with: (Array with: node) with: (Array new) ]! ! !LASmalltalkGrammar methodsFor: 'grammar-pragmas' stamp: 'lr 10/24/2008 11:56'! unaryPragma (identifierToken) ==> [ :node | Array with: (Array with: node) with: (Array new) ]! ! !LASmalltalkGrammar methodsFor: 'token' stamp: 'lr 10/17/2008 14:43'! unaryToken unary small! ! !LASmalltalkGrammar methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:02'! variable identifierToken! ! LASmalltalkGrammar subclass: #LASmalltalkHighlighter instanceVariableNames: '' classVariableNames: 'ThisContextVariable FalseLiteral AssignmentToken PragmaTag StringLiteral VariableTag CharLiteral SelfVariable TrueLiteral NumberLiteral SymbolLiteral NilLiteral MethodTag MethodDeclaration ReturnTag GlobalVariableTag SuperVariable' poolDictionaries: '' category: 'LanguageAspects-Core'! !LASmalltalkHighlighter class methodsFor: 'initialization' stamp: 'lr 11/11/2008 16:13'! initialize MethodTag := TextEmphasis bold. PragmaTag := Color gray muchDarker. ReturnTag := TextEmphasis bold. VariableTag := Color blue muchDarker. GlobalVariableTag := Color blue. SelfVariable := Color cyan muchDarker. SuperVariable := Color cyan muchDarker. ThisContextVariable := Color cyan muchDarker. NilLiteral := Color cyan muchDarker. FalseLiteral := Color cyan muchDarker. TrueLiteral := Color cyan muchDarker. CharLiteral := Color magenta muchDarker. StringLiteral := Color magenta muchDarker. SymbolLiteral := Color magenta muchDarker. NumberLiteral := Color magenta muchDarker. AssignmentToken := TextEmphasis bold.! ! !LASmalltalkHighlighter class methodsFor: 'accessing' stamp: 'lr 10/27/2008 16:48'! pragma ^ #highlight! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:54'! arrayLiteralChar super arrayLiteralChar ==> [ :token | token -> CharLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:53'! arrayLiteralFalse super arrayLiteralFalse ==> [ :token | token -> FalseLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:53'! arrayLiteralNil super arrayLiteralNil ==> [ :token | token -> NilLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:54'! arrayLiteralNumber super arrayLiteralNumber ==> [ :token | token -> NumberLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:54'! arrayLiteralString super arrayLiteralString ==> [ :token | token -> StringLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:54'! arrayLiteralSymbol super arrayLiteralSymbol ==> [ :token | token -> SymbolLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:54'! arrayLiteralTrue super arrayLiteralTrue ==> [ :token | token -> TrueLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'token' stamp: 'lr 11/11/2008 16:11'! assignmentToken super assignmentToken ==> [ :token | token -> AssignmentToken ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:55'! charLiteral super charLiteral ==> [ :token | token -> CharLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:55'! falseLiteral super falseLiteral ==> [ :token | token -> FalseLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'private' stamp: 'lr 11/11/2008 15:15'! mark: aCollection with: anObject ^ DSLHighlighter mark: aCollection with: anObject! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 11/11/2008 16:04'! methodDeclaration super methodDeclaration ==> [ :nodes | self paint: nodes with: MethodTag ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:56'! nilLiteral super nilLiteral ==> [ :token | token -> NilLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:56'! numberLiteral super numberLiteral ==> [ :token | token -> NumberLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'private' stamp: 'lr 10/24/2008 12:21'! paint: anObject with: aTextAttribute anObject isVariableBinding ifTrue: [ ^ anObject value isCollection ifTrue: [ anObject value: (anObject value copyWith: aTextAttribute) ] ifFalse: [ anObject value: (Array with: anObject value with: aTextAttribute) ] ]. (anObject isCollection and: [ anObject isString not ]) ifTrue: [ ^ anObject collect: [ :each | self paint: each with: aTextAttribute ] ]. ^ anObject -> aTextAttribute! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 11/11/2008 16:04'! pragma super pragma ==> [ :nodes | self paint: nodes with: PragmaTag ] ! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 11/11/2008 16:05'! return super return ==> [ :nodes | nodes at: 1 put: nodes first -> ReturnTag; yourself ]! ! !LASmalltalkHighlighter methodsFor: 'accessing' stamp: 'lr 10/24/2008 10:37'! start "The highlighter should be as firendly as possible, don't expect to parser everything." method! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:56'! stringLiteral super stringLiteral ==> [ :token | token -> StringLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:56'! symbolLiteral super symbolLiteral ==> [ :token | token -> SymbolLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 11/11/2008 15:56'! trueLiteral super trueLiteral ==> [ :token | token -> TrueLiteral ]! ! !LASmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 11/11/2008 16:14'! variable super variable ==> [ :token | token value = 'self' ifTrue: [ token -> SelfVariable ] ifFalse: [ token value = 'super' ifTrue: [ token -> SuperVariable ] ifFalse: [ token value = 'thisContext' ifTrue: [ token -> ThisContextVariable ] ifFalse: [ (Smalltalk hasClassNamed: token value) ifTrue: [ token -> GlobalVariableTag ] ifFalse: [ token -> VariableTag ] ] ] ] ]! ! LASmalltalkGrammar subclass: #LASmalltalkParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LASmalltalkParser class methodsFor: 'accessing' stamp: 'lr 10/27/2008 16:48'! pragma ^ #compile! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:47'! array super array ==> [ :nodes | RBArrayNode leftBrace: nodes first rightBrace: nodes last statements: nodes second ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:06'! arrayLiteral super arrayLiteral ==> [ :nodes | RBLiteralNode value: nodes second asArray ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 14:21'! arrayLiteralArray super arrayLiteralArray ==> [ :nodes | nodes second asArray ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:19'! arrayLiteralChar super arrayLiteralChar ==> [ :token | token value second ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:15'! arrayLiteralFalse super arrayLiteralFalse ==> [ :token | false ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:14'! arrayLiteralNil super arrayLiteralNil ==> [ :token | nil ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:14'! arrayLiteralNumber super arrayLiteralNumber ==> [ :token | Number readFrom: token value ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/24/2008 11:50'! arrayLiteralString super arrayLiteralString ==> [ :token | self buildString: token value ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/24/2008 11:51'! arrayLiteralSymbol super arrayLiteralSymbol ==> [ :token | (self buildString: token value) asSymbol ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:15'! arrayLiteralTrue super arrayLiteralTrue ==> [ :token | true ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/26/2008 11:33'! assignment super assignment ==> #first! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:00'! binaryExpression super binaryExpression map: [ :receiver :messages | self build: receiver messages: messages ]! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 11:59'! block super block ==> [ :nodes | RBBlockNode arguments: nodes second body: nodes third ]! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:00'! blockArgument super blockArgument ==> #second! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:07'! blockArgumentsMany super blockArgumentsMany ==> #first! ! !LASmalltalkParser methodsFor: 'grammar-blocks' stamp: 'lr 10/17/2008 12:05'! blockArgumentsNone super blockArgumentsNone ==> [ :token | Array new ]! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 11:54'! build: aNode assignment: anArray ^ anArray isEmpty ifTrue: [ aNode ] ifFalse: [ anArray reverse inject: aNode into: [ :result :each | RBAssignmentNode variable: each value: result ] ]! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 11:36'! build: aNode cascade: anArray | messages | ^ (anArray isNil or: [ anArray isEmpty ]) ifTrue: [ aNode ] ifFalse: [ messages := OrderedCollection new: anArray size + 1. messages addLast: aNode. anArray do: [ :each | messages addLast: (self build: aNode receiver messages: (Array with: each second)) ]. RBCascadeNode messages: messages ]! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 11:28'! build: aNode messages: anArray ^ (anArray isNil or: [ anArray isEmpty ]) ifTrue: [ aNode ] ifFalse: [ anArray inject: aNode into: [ :receiver :message | message isNil ifTrue: [ receiver ] ifFalse: [ RBMessageNode receiver: receiver selectorParts: message first arguments: message second ] ] ]! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 11:37'! build: aTempCollection sequence: aStatementCollection ^ (aTempCollection isEmpty ifTrue: [ RBSequenceNode new ] ifFalse: [ RBSequenceNode leftBar: aTempCollection first temporaries: aTempCollection second rightBar: aTempCollection last ]) statements: aStatementCollection; yourself ! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 12:12'! buildPragma: anArray ^ Pragma keyword: (anArray first inject: String new into: [ :result :each | result , each value ]) asSymbol arguments: anArray second! ! !LASmalltalkParser methodsFor: 'private' stamp: 'lr 10/24/2008 11:51'! buildString: aString (aString isEmpty not and: [ aString first = $# ]) ifTrue: [ ^ (self buildString: aString allButFirst) asSymbol ]. (aString isEmpty or: [ aString first ~= $' or: [ aString last ~= $' ] ]) ifTrue: [ ^ aString ]. ^ (aString copyFrom: 2 to: aString size - 1) copyReplaceAll: '''''' with: ''''! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:51'! cascadeExpression super cascadeExpression map: [ :receiver :messages | self build: receiver cascade: messages ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:16'! charLiteral super charLiteral ==> [ :token | RBLiteralNode literalToken: token value: token value second ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/24/2008 11:55'! expression super expression map: [ :variables :expression | self build: expression assignment: variables ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/17/2008 11:16'! falseLiteral super falseLiteral ==> [ :token | RBLiteralNode literalToken: token value: false ]! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:23'! keywordExpression super keywordExpression map: [ :receiver :message | self build: receiver messages: (Array with: message) ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/24/2008 11:38'! method super method map: [ :declaration :body | declaration pragmas: body first. declaration body: (self build: body second sequence: body third). declaration ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/24/2008 10:50'! methodDeclaration super methodDeclaration ==> [ :nodes | RBMethodNode selectorParts: nodes first arguments: nodes second ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:16'! nilLiteral super nilLiteral ==> [ :token | RBLiteralNode literalToken: token value: nil ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:17'! numberLiteral super numberLiteral ==> [ :token | RBLiteralNode literalToken: token value: (Number readFrom: token value) ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/17/2008 15:40'! parens super parens ==> #second! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/24/2008 12:12'! pragma super pragma ==> [ :nodes | | pragma | pragma := self buildPragma: nodes second. RBPragmaNode pragma: pragma spec: pragma keyword start: nodes first start stop: nodes last stop firstToken: nodes first lastToken: nodes last ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/23/2008 17:09'! return super return map: [ :token :expression | RBReturnNode value: expression ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 10/24/2008 11:38'! sequence super sequence map: [ :temporaries :statements | self build: temporaries sequence: statements ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/24/2008 11:50'! stringLiteral super stringLiteral ==> [ :token | RBLiteralNode literalToken: token value: (self buildString: token value) ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/24/2008 11:50'! symbolLiteral super symbolLiteral ==> [ :node | RBLiteralNode literalToken: node value: (self buildString: node value) ]! ! !LASmalltalkParser methodsFor: 'grammar-literals' stamp: 'lr 10/13/2008 17:28'! trueLiteral super trueLiteral ==> [ :token | RBLiteralNode literalToken: token value: true ]! ! !LASmalltalkParser methodsFor: 'grammar-messages' stamp: 'lr 10/24/2008 11:01'! unaryExpression super unaryExpression map: [ :receiver :messages | self build: receiver messages: messages ]! ! !LASmalltalkParser methodsFor: 'grammar' stamp: 'lr 9/23/2008 20:02'! variable super variable ==> [ :token | RBVariableNode identifierToken: token ]! ! !ProtoObject methodsFor: '*languageaspects' stamp: 'lr 12/2/2008 11:01'! languageAspectsHighlight ^ Array with: LAHighlightAction new with: (DSLRangePattern new begin: '"'; end: '"'; outer: Color green muchDarker)! ! !ProtoObject methodsFor: '*languageaspects' stamp: 'lr 12/2/2008 11:01'! languageAspectsParser ^ LAParseAction new! ! PPTokenParser subclass: #LATokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LATokenParser methodsFor: 'hooks' stamp: 'lr 10/23/2008 16:33'! consumeSpaces: aStream [ super consumeSpaces: aStream. aStream peek == $" ] whileTrue: [ aStream next. [ aStream atEnd not and: [ aStream next = $" ] ] whileFalse ]! ! DSLRule subclass: #LAHighlightAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-DSL'! !LAHighlightAction methodsFor: 'visiting' stamp: 'lr 12/2/2008 10:55'! acceptDsl: aVisitor | parser offset tokens | parser := self highlighterClass new. LAAspect activeForSelector: aVisitor selector in: aVisitor theClass do: [ :aspect | aspect weave: parser ]. aVisitor text removeAttributesFrom: aVisitor scopeStart to: aVisitor scopeStop. offset := aVisitor scopeStart - 1. tokens := parser parse: aVisitor scopedText readStream ifError: [ :err | #() ]. tokens flattenedDo: [ :each | (each isVariableBinding and: [ each key class = PPToken ]) ifTrue: [ aVisitor scopeFrom: offset + each key start to: offset + each key stop with: nil visit: each value ] ]! ! !LAHighlightAction methodsFor: 'accessing' stamp: 'lr 11/21/2008 09:42'! highlighterClass ^ LASmalltalkHighlighter! ! DSLRule subclass: #LAParseAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-DSL'! !LAParseAction methodsFor: 'visiting' stamp: 'lr 12/2/2008 10:53'! acceptDsl: aVisitor | parser weaved | aVisitor doIt ifTrue: [ ^ nil ]. weaved := false. parser := self parserClass new. LAAspect activeForSelector: aVisitor selector in: aVisitor theClass do: [ :aspect | aspect weave: parser. weaved := true ]. weaved ifFalse: [ ^ nil ]. ^ parser parse: aVisitor stream ifError: [ :err | DSLParserError signal: err reason at: err position ]! ! !LAParseAction methodsFor: 'accessing' stamp: 'lr 11/21/2008 09:42'! parserClass ^ LASmalltalkParser! ! TestCase subclass: #LACrosscuttingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LACrosscuttingTest class methodsFor: 'initialization' stamp: 'lr 11/6/2008 14:34'! initialize LARegexpAspect default addClass: self. LAPathAspect default addClass: self! ! !LACrosscuttingTest methodsFor: 'testing' stamp: 'lr 11/11/2008 12:04'! testCrosscutting | input output | input := #(('aaaa') ('aaab' 'aaba' 'abaa' 'baaa') ('aabb' 'abba' 'bbaa' 'abab' 'baba' 'baab') ('abbb' 'babb' 'bbab' 'bbba') ('bbbb')). output := input : yourself [ :each | /a*b*/ matches: each ]. self assert: output = #('aaaa' 'aaab' 'aabb' 'abbb' 'bbbb')! ! TestCase subclass: #LAGrammarTests instanceVariableNames: 'parser result' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! LAGrammarTests subclass: #LACompilerTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LACompilerTests methodsFor: 'accessing' stamp: 'lr 10/24/2008 13:24'! parserClass ^ LASmalltalkParser! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock1 super testArgumentsBlock1. self assert: result isBlock. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock2 super testArgumentsBlock2. self assert: result isBlock. self assert: result arguments size = 2. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock3 super testArgumentsBlock3. self assert: result isBlock. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral1 super testArrayLiteral1. self assert: result isLiteral. self assert: result value = #()! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral10 super testArrayLiteral10. self assert: result isLiteral. self assert: result value = #(#(1 2 ) #(1 2 3 ) )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral2 super testArrayLiteral2. self assert: result isLiteral. self assert: result value = #(1 )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral3 super testArrayLiteral3. self assert: result isLiteral. self assert: result value = #(1 2 )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral4 super testArrayLiteral4. self assert: result isLiteral. self assert: result value = #(true false nil )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral5 super testArrayLiteral5. self assert: result isLiteral. self assert: result value = #($a )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral6 super testArrayLiteral6. self assert: result isLiteral. self assert: result value = #(1.2 )! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 16:03'! testArrayLiteral7 super testArrayLiteral7. self assert: result isLiteral. self assert: result value = #(size #at: at:put: #'=='). result value do: [ :each | self assert: each isSymbol ]! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 16:01'! testArrayLiteral8 super testArrayLiteral8. self assert: result isLiteral. self assert: result value = #('baz'). self assert: result value first isString. self assert: result value first isSymbol not! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 16:02'! testArrayLiteral9 super testArrayLiteral9. self assert: result isLiteral. self assert: result value = #((1) 2)! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment1 super testAssignment1. self assert: result isLiteral. self assert: result value = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment2 super testAssignment2. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isLiteral. self assert: result value value = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment3 super testAssignment3. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isAssignment. self assert: result value variable isVariable. self assert: result value variable name = 'b'. self assert: result value value isLiteral. self assert: result value value value = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment4 super testAssignment4. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isLiteral. self assert: result value value = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment5 super testAssignment5. self assert: result isAssignment. self assert: result variable isVariable. self assert: result variable name = 'a'. self assert: result value isAssignment. self assert: result value variable isVariable. self assert: result value variable name = 'b'. self assert: result value value isLiteral. self assert: result value value value = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryExpression1 super testBinaryExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 2! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryExpression2 super testBinaryExpression2. self assert: result isMessage. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver arguments size = 1. self assert: result receiver arguments first isLiteral. self assert: result receiver arguments first value = 2. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 3! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod1 super testBinaryMethod1. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod2 super testBinaryMethod2. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod3 super testBinaryMethod3. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod4 super testBinaryMethod4. self assert: result isMethod. self assert: result selector = #+. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression1 super testCascadeExpression1. self assert: result isCascade. self assert: result receiver isLiteral. self assert: result messages size = 2. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #abs. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #negated! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression2 super testCascadeExpression2. self assert: result isCascade. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver selector = #abs. self assert: result messages size = 3. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #negated. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #raisedTo:. self assert: result messages third receiver = result receiver. self assert: result messages third selector = #negated! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression3 super testCascadeExpression3. self assert: result isCascade. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result messages size = 2. self assert: result messages first receiver = result receiver. self assert: result messages first selector = #+. self assert: result messages first arguments size = 1. self assert: result messages second receiver = result receiver. self assert: result messages second selector = #-. self assert: result messages second arguments size = 1! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral1 super testCharLiteral1. self assert: result isLiteral. self assert: result value = $a! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral2 super testCharLiteral2. self assert: result isLiteral. self assert: result value = Character space! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral3 super testCharLiteral3. self assert: result isLiteral. self assert: result value = $$! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testComplexBlock1 super testComplexBlock1. self assert: result isBlock. self assert: result arguments size = 1. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testComplexBlock2 super testComplexBlock2. self assert: result isBlock. self assert: result arguments size = 1. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression1 super testKeywordExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result receiver value = 1. self assert: result selector = #to:. self assert: result arguments size = 1. self assert: result arguments first isLiteral. self assert: result arguments first value = 2! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression2 super testKeywordExpression2. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #to:by:. self assert: result arguments size = 2. self assert: result arguments first isLiteral. self assert: result arguments first value = 2. self assert: result arguments second isLiteral. self assert: result arguments second value = 3! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression3 super testKeywordExpression3. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #to:by:do:. self assert: result arguments size = 3. self assert: result arguments first isLiteral. self assert: result arguments first value = 2. self assert: result arguments second isLiteral. self assert: result arguments second value = 3. self assert: result arguments third isLiteral. self assert: result arguments third value = 4! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod1 super testKeywordMethod1. self assert: result isMethod. self assert: result selector = #to:. self assert: result arguments size = 1. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod2 super testKeywordMethod2. self assert: result isMethod. self assert: result selector = #to:do:. self assert: result arguments size = 2. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod3 super testKeywordMethod3. self assert: result isMethod. self assert: result selector = #to:do:by:. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod4 super testKeywordMethod4. self assert: result isMethod. self assert: result selector = #to:do:by:. self assert: result arguments size = 3. self assert: result arguments first isVariable. self assert: result arguments first name = 'a'. self assert: result arguments second isVariable. self assert: result arguments second name = 'b'. self assert: result arguments third isVariable. self assert: result arguments third name = 'c'. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral1 super testNumberLiteral1. self assert: result isLiteral. self assert: result value = 0! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral10 super testNumberLiteral10. self assert: result isLiteral. self assert: result value = 10! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral11 super testNumberLiteral11. self assert: result isLiteral. self assert: result value = 511! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral12 super testNumberLiteral12. self assert: result isLiteral. self assert: result value = 175! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral13 super testNumberLiteral13. self assert: result isLiteral. self assert: result value = 202.9921875! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral14 super testNumberLiteral14. self assert: result isLiteral. self assert: result value floor = -9! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral2 super testNumberLiteral2. self assert: result isLiteral. self assert: result value = 0.1! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral3 super testNumberLiteral3. self assert: result isLiteral. self assert: result value = 123! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral4 super testNumberLiteral4. self assert: result isLiteral. self assert: result value = 123.456! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral5 super testNumberLiteral5. self assert: result isLiteral. self assert: result value = 0! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral6 super testNumberLiteral6. self assert: result isLiteral. self assert: result value = -0.1! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral7 super testNumberLiteral7. self assert: result isLiteral. self assert: result value = -123! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral8 super testNumberLiteral8. self assert: result isLiteral. self assert: result value = -123! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral9 super testNumberLiteral9. self assert: result isLiteral. self assert: result value = -123.456! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma1 super testPragma1. self assert: result pragmas size = 1. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma2 super testPragma2. self assert: result pragmas size = 2. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma3 super testPragma3. self assert: result pragmas size = 1. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma4 super testPragma4. self assert: result pragmas size = 1. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma5 super testPragma5. self assert: result pragmas size = 2. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testSequence1 super testSequence1. self assert: result isSequence. self assert: result temporaries size = 1. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result statements size = 2. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testSimpleBlock1 super testSimpleBlock1. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testSimpleBlock2 super testSimpleBlock2. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral1 super testSpecialLiteral1. self assert: result isLiteral. self assert: result value = true! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral2 super testSpecialLiteral2. self assert: result isLiteral. self assert: result value = false! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral3 super testSpecialLiteral3. self assert: result isLiteral. self assert: result value = nil! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock1 super testStatementBlock1. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock2 super testStatementBlock2. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock3 super testStatementBlock3. self assert: result isBlock. self assert: result arguments isEmpty. self assert: result body temporaries size = 2. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements1 super testStatements1. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 1. self assert: result statements first isLiteral. self assert: result statements first value = 1! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements2 super testStatements2. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 2. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements3 super testStatements3. self assert: result isSequence. self assert: result temporaries isEmpty. self assert: result statements size = 3. self assert: result statements first isLiteral. self assert: result statements first value = 1. self assert: result statements second isLiteral. self assert: result statements second value = 2. self assert: result statements third isLiteral. self assert: result statements third value = 3! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral1 super testStringLiteral1. self assert: result isLiteral. self assert: result value = ''! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral2 super testStringLiteral2. self assert: result isLiteral. self assert: result value = 'ab'! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral3 super testStringLiteral3. self assert: result isLiteral. self assert: result value = 'ab''cd'! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral1 super testSymbolLiteral1. self assert: result isLiteral. self assert: result value = #foo! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral2 super testSymbolLiteral2. self assert: result isLiteral. self assert: result value = #+! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral3 super testSymbolLiteral3. self assert: result isLiteral. self assert: result value = #key:! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral4 super testSymbolLiteral4. self assert: result isLiteral. self assert: result value = #key:value:! ! !LACompilerTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral5 super testSymbolLiteral5. self assert: result isLiteral. self assert: result value = #'testing-result'! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries1 super testTemporaries1. self assert: result isSequence. self assert: result temporaries size = 1. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries2 super testTemporaries2. self assert: result isSequence. self assert: result temporaries size = 2. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result temporaries second isVariable. self assert: result temporaries second name = 'b'. self assert: result statements isEmpty! ! !LACompilerTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries3 super testTemporaries3. self assert: result isSequence. self assert: result temporaries size = 3. self assert: result temporaries first isVariable. self assert: result temporaries first name = 'a'. self assert: result temporaries second isVariable. self assert: result temporaries second name = 'b'. self assert: result temporaries third isVariable. self assert: result temporaries third name = 'c'. self assert: result statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryExpression1 super testUnaryExpression1. self assert: result isMessage. self assert: result receiver isLiteral. self assert: result selector = #abs. self assert: result arguments isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryExpression2 super testUnaryExpression2. self assert: result isMessage. self assert: result receiver isMessage. self assert: result receiver receiver isLiteral. self assert: result receiver receiver value = 1. self assert: result receiver selector = #abs. self assert: result receiver arguments isEmpty. self assert: result selector = #negated. self assert: result arguments isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod1 super testUnaryMethod1. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod2 super testUnaryMethod2. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod3 super testUnaryMethod3. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries isEmpty. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod4 super testUnaryMethod4. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements size = 1! ! !LACompilerTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod5 super testUnaryMethod5. self assert: result isMethod. self assert: result selector = #abs. self assert: result arguments isEmpty. self assert: result body temporaries size = 1. self assert: result body statements isEmpty! ! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/23/2008 15:53'! parse: aString self parse: aString rule: #start! ! !LAGrammarTests methodsFor: 'parsing' stamp: 'lr 10/23/2008 15:53'! parse: aString rule: aSymbol | production | production := self parser productionAt: aSymbol definition: [ self error: 'Invalid production ' , aSymbol printString ]. result := production parse: aString asParserStream! ! !LAGrammarTests methodsFor: 'accessing' stamp: 'lr 10/23/2008 15:53'! parser ^ parser ifNil: [ parser := self parserClass new ]! ! !LAGrammarTests methodsFor: 'accessing' stamp: 'lr 10/24/2008 13:24'! parserClass ^ LASmalltalkGrammar! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock1 self parse: '[ :a | ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock2 self parse: '[ :a :b | ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testArgumentsBlock3 self parse: '[ :a :b :c | ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral1 self parse: '#()' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral10 self parse: '#((1 2) #(1 2 3))' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral2 self parse: '#(1)' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral3 self parse: '#(1 2)' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral4 self parse: '#(true false nil)' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral5 self parse: '#($a)' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral6 self parse: '#(1.2)' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 16:03'! testArrayLiteral7 self parse: '#(size #at: at:put: #''=='')' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral8 self parse: '#(''baz'')' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testArrayLiteral9 self parse: '#((1) 2))' rule: #arrayLiteral! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment1 self parse: '1' rule: #expression! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment2 self parse: 'a := 1' rule: #expression! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment3 self parse: 'a := b := 1' rule: #expression! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment4 self parse: 'a _ 1' rule: #expression! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testAssignment5 self parse: 'a _ b _ 1' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryExpression1 self parse: '1 + 2' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryExpression2 self parse: '1 + 2 + 3' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod1 self parse: '+ a' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod2 self parse: '+ a | b |' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod3 self parse: '+ a b' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testBinaryMethod4 self parse: '+ a | b | c' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression1 self parse: '1 abs; negated' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression2 self parse: '1 abs negated; raisedTo: 12; negated' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testCascadeExpression3 self parse: '1 + 2; - 3' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral1 self parse: '$a' rule: #charLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral2 self parse: '$ ' rule: #charLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testCharLiteral3 self parse: '$$' rule: #charLiteral! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testComplexBlock1 self parse: '[ :a | | b | c ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testComplexBlock2 self parse: '[:a||b|c]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression1 self parse: '1 to: 2' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression2 self parse: '1 to: 2 by: 3' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordExpression3 self parse: '1 to: 2 by: 3 do: 4' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod1 self parse: 'to: a' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod2 self parse: 'to: a do: b | c |' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod3 self parse: 'to: a do: b by: c d' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testKeywordMethod4 self parse: 'to: a do: b by: c | d | e' rule: #method! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral1 self parse: '0' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral10 self parse: '10r10' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral11 self parse: '8r777' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral12 self parse: '16rAF' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral13 self parse: '16rCA.FE' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral14 self parse: '3r-22.2' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral2 self parse: '0.1' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral3 self parse: '123' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral4 self parse: '123.456' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral5 self parse: '-0' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral6 self parse: '-0.1' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral7 self parse: '-123' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral8 self parse: '-123' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testNumberLiteral9 self parse: '-123.456' rule: #numberLiteral! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma1 self parse: 'method ' rule: #method! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma2 self parse: 'method ' rule: #method! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma3 self parse: 'method | a | ' rule: #method! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma4 self parse: 'method | a |' rule: #method! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testPragma5 self parse: 'method | a | ' rule: #method! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testSequence1 self parse: '| a | 1 . 2' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testSimpleBlock1 self parse: '[ ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testSimpleBlock2 self parse: '[ nil ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral1 self parse: 'true' rule: #trueLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral2 self parse: 'false' rule: #falseLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSpecialLiteral3 self parse: 'nil' rule: #nilLiteral! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock1 self parse: '[ nil ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock2 self parse: '[ | a | nil ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing-blocks' stamp: 'lr 10/23/2008 15:53'! testStatementBlock3 self parse: '[ | a b | nil ]' rule: #block! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements1 self parse: '1' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements2 self parse: '1 . 2' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testStatements3 self parse: '1 . 2 . 3' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral1 self parse: '''''' rule: #stringLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral2 self parse: '''ab''' rule: #stringLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testStringLiteral3 self parse: '''ab''''cd''' rule: #stringLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral1 self parse: '#foo' rule: #symbolLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral2 self parse: '#+' rule: #symbolLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral3 self parse: '#key:' rule: #symbolLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral4 self parse: '#key:value:' rule: #symbolLiteral! ! !LAGrammarTests methodsFor: 'testing-literals' stamp: 'lr 10/23/2008 15:53'! testSymbolLiteral5 self parse: '#''testing-result''' rule: #symbolLiteral! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries1 self parse: '| a |' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries2 self parse: '| a b |' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing' stamp: 'lr 10/23/2008 15:53'! testTemporaries3 self parse: '| a b c |' rule: #sequence! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryExpression1 self parse: '1 abs' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryExpression2 self parse: '1 abs negated' rule: #expression! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod1 self parse: 'abs' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod2 self parse: 'abs | a |' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod3 self parse: 'abs a' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod4 self parse: 'abs | a | b' rule: #method! ! !LAGrammarTests methodsFor: 'testing-messages' stamp: 'lr 10/23/2008 15:53'! testUnaryMethod5 self parse: 'abs | a |' rule: #method! ! LAGrammarTests subclass: #LAHighlighterTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LAHighlighterTests methodsFor: 'accessing' stamp: 'lr 10/23/2008 15:53'! parserClass ^ LASmalltalkHighlighter! ! TestCase subclass: #LAPackagesTests instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Tests'! !LAPackagesTests methodsFor: 'accessing' stamp: 'lr 10/24/2008 13:24'! parser ^ parser ifNil: [ parser := LASmalltalkParser 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'! !LAPathAspectTest class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:58'! initialize LAPathAspect default addClass: self! ! !LAPathAspectTest methodsFor: 'testing' stamp: 'lr 12/2/2008 10:57'! testSimpleFilter | input output | input := #((1 2 3) (4 5) (6)). output := input : yourself[ :each | each odd ]. self assert: output = #(1 3 5)! ! !LAPathAspectTest methodsFor: 'testing' stamp: 'lr 12/2/2008 10:57'! testSimplePath | input output | input := #((1 2 3) (4 5) (6)). output := input : yourself. self assert: output = #(1 2 3 4 5 6)! ! TestCase subclass: #LARegexpAspectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LARegexpAspectTest class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:58'! initialize LARegexpAspect default addClass: self! ! !LARegexpAspectTest methodsFor: 'accessing' stamp: 'lr 12/2/2008 10:56'! testRegexp self assert: (/[01]+/ matches: '10010100'). self assert: (/a*b/ matches: 'aaaaab'). self assert: (/ab+c/ matches:'abbbbbbc'). self assert: (/ab*/ matches: 'abbb')! ! !PPParser methodsFor: '*languageaspects' stamp: 'lr 10/20/2008 13:38'! small ^ LATokenParser on: self! ! !CompiledMethod methodsFor: '*languageaspects' stamp: 'lr 10/30/2008 15:11'! isBroken ^ false! ! Object subclass: #LAAspect instanceVariableNames: 'active environments' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! LAAspect class instanceVariableNames: 'Default'! LAAspect class instanceVariableNames: 'Default'! !LAAspect class methodsFor: 'querying' stamp: 'lr 10/28/2008 15:31'! activeForSelector: aSymbol in: aClass do: aBlock aClass isNil ifTrue: [ ^ self ]. self all do: [ :aspect | (aspect isActive and: [ aspect includesSelector: aSymbol in: aClass ]) ifTrue: [ aBlock value: aspect ] ]! ! !LAAspect class methodsFor: 'accessing' stamp: 'lr 10/28/2008 15:30'! all "Answer all aspects of the system." ^ self allSubclasses collect: [ :each | each default ]! ! !LAAspect class methodsFor: 'accessing' stamp: 'lr 10/28/2008 15:30'! default "Answer the aspect instance of the receiver." ^ Default ifNil: [ Default := self new ]! ! !LAAspect class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:30'! recompile self all do: [ :each | each recompile ]! ! !LAAspect class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:30'! unload self all do: [ :each | each disable ]! ! !LAAspect methodsFor: 'private' 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/28/2008 15:25'! add: anEnvironment "Add anEnvironment 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/28/2008 15:10'! addClass: aClass ^ self add: (BrowserEnvironment new forClasses: (Array with: aClass))! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:10'! addPackage: aString ^ self add: (BrowserEnvironment new forPackageNamed: aString)! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:10'! addPragma: aKeyword ^ self add: (BrowserEnvironment new forPragmas: (Array with: aKeyword))! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/28/2008 15:13'! disable "Disable the receiving aspect." self active: false! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/28/2008 15:13'! enable "Enable the receiving aspect." self active: true! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 11/11/2008 16:10'! environment "Answer the users of environment of the receiver." | environment | environment := self environments inject: BrowserEnvironment new not into: [ :result :each | result | each ]. environment label: 'Users of ' , self name. ^ environment! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/28/2008 15:24'! environments "Answer the environments of the receiver." ^ environments! ! !LAAspect methodsFor: 'testing' stamp: 'lr 10/28/2008 15:11'! includesSelector: aSelector in: aClass "Answer wether the receiving aspect is active in the given context or not." ^ self environments anySatisfy: [ :each | each includesSelector: aSelector in: aClass ]! ! !LAAspect methodsFor: 'initialization' stamp: 'lr 11/6/2008 14:09'! initialize active := true. 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/23/2008 17:25'! name "A human readable name of the aspect." ^ self class name! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 11/11/2008 11:18'! parser: aParser "Answer the parser of the receiver." ^ PPEpsilonParser new! ! !LAAspect methodsFor: 'accessing' stamp: 'lr 10/28/2008 15:19'! pointcut "Answer a default pointcut for the receiver." ^ LAPointcut new! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/28/2008 15:11'! recompile "Recompile all the affected methods in the selected enviornments." self environments do: [ :each | self recompile: each]! ! !LAAspect methodsFor: 'actions' stamp: 'lr 10/30/2008 15:09'! recompile: anEnvironment "Recompile all the affected methods in anEnvironment." | environment | environment := SelectorEnvironment new. environment label: 'Broken methods'. anEnvironment classesAndSelectorsDo: [ :class :selector | [ self recompileClass: class selector: selector ] on: SmaCCParserError do: [ :err | class methodDictionary at: selector ifPresent: [ :method | environment addClass: class selector: selector. class methodDictAddSelectorSilently: selector withMethod: (LABroken class: class selector: selector source: method getSource) ] ] ]. ^ environment! ! !LAAspect methodsFor: 'private' stamp: 'lr 10/30/2008 15:14'! recompileClass: aClass selector: aSelector | method | method := aClass methodDictionary at: aSelector ifAbsent: [ ^ self ]. method isBroken ifTrue: [ aClass compile: method getSource ] ifFalse: [ aClass recompile: aSelector ]! ! !LAAspect methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:25'! remove: anEnvironment "Removes anEnvironment from the scope of the receiver and incrementally update all code." environments := environments copyWithout: anEnvironment. self isActive ifTrue: [ self recompile: anEnvironment ]. ^ anEnvironment! ! !LAAspect methodsFor: 'public' stamp: 'lr 11/6/2008 14:16'! weave: aParser "Weave aParser with all the applicable concerns." | parser | parser := self parser: aParser. (Pragma allNamed: #concern: from: self class to: LAAspect) do: [ :pragma | aParser class pragma = pragma arguments first ifTrue: [ self pointcut weave: parser into: aParser aspect: self selector: pragma selector ] ]! ! LAAspect subclass: #LAPathAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LAPathAspect class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'! initialize self default recompile! ! !LAPathAspect methodsFor: 'concerns' stamp: 'lr 12/2/2008 10:56'! compile: aCollection ^ (aCollection second collect: [ :each | each flatten ]) inject: aCollection first into: [ :receiver :array | | result | result := ``(`,(receiver) gather: `,(array second value asSymbol)). array third isNil ifFalse: [ result := ``(`,(result) select: `,(array third)) ]. result ]! ! !LAPathAspect methodsFor: 'concerns' stamp: 'lr 12/2/2008 10:57'! highlight: aCollection ^ DSLHighlighter mark: aCollection with: TextEmphasis italic! ! !LAPathAspect methodsFor: 'accessing' stamp: 'lr 12/2/2008 10:51'! parser: aParser ^ aParser primary , ($: asParser small , aParser unaryToken , aParser block optional) plus! ! !LAPathAspect methodsFor: 'accessing' stamp: 'lr 12/2/2008 10:52'! pointcut ^ super pointcut before; choice; name: #cascadeExpression! ! LAAspect subclass: #LARegexpAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Examples'! !LARegexpAspect class methodsFor: 'initialization' stamp: 'lr 11/6/2008 12:09'! initialize self default recompile! ! !LARegexpAspect methodsFor: 'concerns' stamp: 'lr 12/2/2008 10:56'! compile: aToken ^ QQObjectNode literalToken: aToken value: (aToken value copyFrom: 2 to: aToken size - 1) asRegex! ! !LARegexpAspect methodsFor: 'concerns' stamp: 'lr 12/2/2008 10:56'! highlight: aToken ^ aToken -> Color orange! ! !LARegexpAspect methodsFor: 'accessing' stamp: 'lr 12/2/2008 10:53'! parser: aParser ^ ($/ asParser , $/ asParser negate star , $/ asParser) small! ! !LARegexpAspect methodsFor: 'accessing' stamp: 'lr 12/2/2008 10:53'! pointcut ^ super pointcut after; choice; name: #literal! ! Object subclass: #LABroken instanceVariableNames: 'theClass selector source' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-Core'! !LABroken class methodsFor: 'instance-creation' stamp: 'lr 10/30/2008 14:42'! class: aClass selector: aSelector source: aString ^ self new initializeClass: aClass selector: aSelector source: aString! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:53'! compiledMethod ^ self! ! !LABroken methodsFor: 'source' stamp: 'lr 10/30/2008 14:48'! flushCache! ! !LABroken methodsFor: 'source' stamp: 'lr 10/30/2008 14:38'! getSource ^ source! ! !LABroken methodsFor: 'source' stamp: 'lr 10/30/2008 14:49'! getSourceFor: aSelector in: aClass ^ source! ! !LABroken methodsFor: 'source' stamp: 'lr 10/30/2008 15:07'! getSourceFromFile ^ source! ! !LABroken methodsFor: 'literals' stamp: 'lr 10/30/2008 14:37'! hasLiteral: anObject ^ false! ! !LABroken methodsFor: 'initialization' stamp: 'lr 10/30/2008 14:28'! initializeClass: aClass selector: aSelector source: aString theClass := aClass. selector := aSelector. source := aString! ! !LABroken methodsFor: 'testing' stamp: 'lr 10/30/2008 15:08'! isBroken ^ true! ! !LABroken methodsFor: 'testing' stamp: 'lr 10/30/2008 14:55'! isRequired ^ false! ! !LABroken methodsFor: 'testing' stamp: 'lr 10/30/2008 14:53'! isSubclassResponsibility ^ false! ! !LABroken methodsFor: 'literals' stamp: 'lr 10/30/2008 14:36'! literals ^ #()! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:38'! methodClass ^ theClass! ! !LABroken methodsFor: 'protocol' stamp: 'lr 10/30/2008 15:13'! methodClass: aClass! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:35'! pragmas ^ #()! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:36'! properties ^ MethodProperties new! ! !LABroken methodsFor: 'literals' stamp: 'lr 10/30/2008 14:37'! refersToLiteral: anObject ^ false! ! !LABroken methodsFor: 'evaluating' stamp: 'lr 10/30/2008 14:26'! run: aSelector with: anArray in: anObject self error: 'Unable to compile ' , aSelector printString! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:38'! selector ^ selector! ! !LABroken methodsFor: 'protocol' stamp: 'lr 10/30/2008 15:13'! selector: aSelector! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:53'! sendsToSuper ^ false! ! !LABroken methodsFor: 'source' stamp: 'lr 10/30/2008 15:16'! sourcePointer ^ 0! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:57'! timeStamp ^ nil! ! !LABroken methodsFor: 'accessing' stamp: 'lr 10/30/2008 15:01'! trailer ^ #(0 0 0 0)! ! Object subclass: #LAPointcut instanceVariableNames: 'name 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: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/27/2008 11:21'! initialize self after. self choice. self name: #start! ! !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-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: 'public' stamp: 'lr 10/28/2008 15:56'! weave: aParser into: aCompositeParser aspect: anAspect selector: aSymbol | original copied wraped | original := aCompositeParser perform: name. copied := original copy. wraped := aParser ==> [ :nodes | anAspect perform: aSymbol with: nodes ]. original def: (action = #replace ifTrue: [ wraped ] ifFalse: [ action = #before ifTrue: [ class with: wraped with: copied ] ifFalse: [ action = #after ifTrue: [ class with: copied with: wraped ] ifFalse: [ self error: 'Invalid pointcut action.' ] ] ])! ! OBCommand subclass: #LACmdAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! LACmdAspect subclass: #LACmdActivateAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdActivateAspect methodsFor: 'execution' stamp: 'lr 10/30/2008 13:40'! execute self aspect active: self aspect isActive not! ! !LACmdActivateAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:45'! label ^ self aspect isActive ifTrue: [ 'disable aspect' ] ifFalse: [ 'enable aspect' ]! ! !LACmdAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:19'! aspect ^ target theNonMetaClass default! ! !LACmdAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:42'! cluster ^ #'language aspects'! ! !LACmdAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:42'! group ^ #aspect! ! !LACmdAspect methodsFor: 'testing' stamp: 'lr 10/30/2008 13:43'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OBClassAwareNode) and: [ target theNonMetaClass includesBehavior: LAAspect ] ]! ! LACmdAspect subclass: #LACmdInspectAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdInspectAspect methodsFor: 'execution' stamp: 'lr 10/30/2008 13:34'! execute self aspect explore! ! !LACmdInspectAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:36'! icon ^ #inspectItIcon! ! !LACmdInspectAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:45'! label ^ 'inspect aspect'! ! LACmdAspect subclass: #LACmdRecompileAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdRecompileAspect methodsFor: 'execution' stamp: 'lr 10/30/2008 13:21'! execute self aspect recompile! ! !LACmdRecompileAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:45'! label ^ 'recompile users'! ! LACmdAspect subclass: #LACmdScopeAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdScopeAspect methodsFor: 'execution' stamp: 'lr 10/30/2008 13:23'! execute self aspect environment browserInstance open ! ! !LACmdScopeAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:44'! label ^ 'browse scope'! ! OBCommand subclass: #LACmdObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! LACmdObject subclass: #LACmdAddAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdAddAspect methodsFor: 'execution' stamp: 'lr 11/11/2008 12:02'! execute | environment aspect | environment := target browserEnvironment. aspect := self chooseAspect: 'Add Language Aspect' select: [ :each | (each environment & environment) isEmpty ]. aspect isNil ifTrue: [ ^ self ]. aspect add: environment! ! !LACmdAddAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:11'! group ^ #scope! ! !LACmdAddAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:11'! label ^ 'add aspect...'! ! LACmdObject subclass: #LACmdBrowseAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdBrowseAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:16'! environment | environment | environment := self aspects inject: ClassEnvironment new into: [ :result :aspect | (target withinBrowserEnvironment: aspect environment) ifTrue: [ result addClass: aspect class ]. result ]. environment label: 'Language Aspects for ' , target name. ^ environment! ! !LACmdBrowseAspect methodsFor: 'execution' stamp: 'lr 10/30/2008 14:04'! execute | aspects | aspects := self aspects select: [ :each | target withinBrowserEnvironment: each environment ]. aspects isEmpty ifTrue: [ ^ self ]. aspects size = 1 ifTrue: [ ^ requestor browser jumpTo: aspects anyOne class asNode ]. self environment browserInstance open! ! !LACmdBrowseAspect methodsFor: 'testing' stamp: 'lr 10/30/2008 13:52'! isEnabled ^ self environment isEmpty not! ! !LACmdBrowseAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:16'! label ^ 'browse aspect'! ! !LACmdObject methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:42'! aspect ^ target theNonMetaClass default! ! !LACmdObject methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:43'! aspects ^ LAAspect all! ! !LACmdObject methodsFor: 'utilities' stamp: 'lr 10/30/2008 14:06'! chooseAspect: aString ^ self chooseAspect: aString select: [ :each | true ]! ! !LACmdObject methodsFor: 'utilities' stamp: 'lr 10/30/2008 14:06'! chooseAspect: aString select: aBlock | aspects labels | aspects := self aspects asArray select: aBlock. aspects isEmpty ifTrue: [ ^ nil ]. aspects sort: [ :a :b | a name < b name ]. labels := aspects collect: [ :each | each name ]. ^ OBChoiceRequest prompt: aString labels: labels values: aspects! ! !LACmdObject methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:42'! cluster ^ #'language aspects'! ! !LACmdObject methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:42'! group ^ #object! ! !LACmdObject methodsFor: 'testing' stamp: 'lr 10/30/2008 13:43'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OBClassAwareNode ]! ! LACmdObject subclass: #LACmdRemoveAspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageAspects-OmniBrowser'! !LACmdRemoveAspect methodsFor: 'execution' stamp: 'lr 11/11/2008 12:03'! execute | environment aspect | environment := target browserEnvironment. aspect := self chooseAspect: 'Remove Language Aspect' select: [ :each | (each environment & environment) isEmpty not ]. aspect isNil ifTrue: [ ^ self ]. aspect environments do: [ :each | (each & environment) isEmpty ifFalse: [ aspect remove: each ] ]! ! !LACmdRemoveAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:11'! group ^ #scope! ! !LACmdRemoveAspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:12'! label ^ 'remove aspect...'! ! LASmalltalkHighlighter initialize! LACrosscuttingTest initialize! LAPathAspectTest initialize! LARegexpAspectTest initialize! LAPathAspect initialize! LARegexpAspect initialize!