--- a/Explainer.st Sat Nov 05 01:03:31 1994 +0100
+++ b/Explainer.st Thu Nov 17 15:23:23 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -19,9 +19,9 @@
Explainer comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.5 1994-08-05 03:37:32 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.6 1994-11-17 14:23:23 claus Exp $
'!
!Explainer class methodsFor:'documentation'!
@@ -29,7 +29,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.5 1994-08-05 03:37:32 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Explainer.st,v 1.6 1994-11-17 14:23:23 claus Exp $
"
!
@@ -59,115 +59,79 @@
explain:someText in:source forClass:aClass
"Given a source and a substring of it, return a string containing
an explanation.
- this is just a q&d implementation - there could be much more."
+ This is just a q&d implementation - to be correct, it should use the parser,
+ and explain from the parsetree (instead of doing string matches).
+ This leads to some wrong explanations, for example if some string is
+ used as selector within a string.
+ Also, there could be much more detailed explanations."
|parser variables v c string sym list count tmp
commonSuperClass|
string := someText withoutSeparators.
+
+ "
+ ask parser for variable names
+ "
parser := self parseMethod:source in:aClass.
parser notNil ifTrue:[
- "look for variables"
+ "look for variables"
- variables := parser methodVars.
- (variables notNil and:[variables includes:string]) ifTrue:[
- ^ string , ' is a method variable'
- ].
- variables := parser methodArgs.
- (variables notNil and:[variables includes:string]) ifTrue:[
- ^ string , ' is a method argument'
- ]
+ variables := parser methodVars.
+ (variables notNil and:[variables includes:string]) ifTrue:[
+ ^ string , ' is a method variable'
+ ].
+ variables := parser methodArgs.
+ (variables notNil and:[variables includes:string]) ifTrue:[
+ ^ string , ' is a method argument'
+ ]
].
+
parser isNil ifTrue:[
- parser := self for:(ReadStream on:source) in:aClass
+ parser := self for:(ReadStream on:source) in:aClass
].
"instvars"
variables := aClass allInstVarNames.
(variables notNil and:[variables includes:string]) ifTrue:[
- "where is it"
- c := aClass.
- [c notNil] whileTrue:[
- v := c instVarNames.
- (v notNil and:[v includes:string]) ifTrue:[
- ^ string , ' is an instance variable in ' , c name
- ].
- c := c superclass
- ].
- self error:'oops'
+ "where is it"
+ c := aClass.
+ [c notNil] whileTrue:[
+ v := c instVarNames.
+ (v notNil and:[v includes:string]) ifTrue:[
+ ^ string , ' is an instance variable in ' , c name
+ ].
+ c := c superclass
+ ].
+ self error:'oops'
].
"class instvars"
variables := aClass class allInstVarNames.
(variables notNil and:[variables includes:string]) ifTrue:[
- "where is it"
- c := aClass.
- [c notNil] whileTrue:[
- v := c class instVarNames.
- (v notNil and:[v includes:string]) ifTrue:[
- ^ string , ' is a class instance variable in ' , c name
- ].
- c := c superclass
- ].
- self error:'oops'
+ "where is it"
+ c := aClass.
+ [c notNil] whileTrue:[
+ v := c class instVarNames.
+ (v notNil and:[v includes:string]) ifTrue:[
+ ^ string , ' is a class instance variable in ' , c name
+ ].
+ c := c superclass
+ ].
+ self error:'oops'
].
"classvars"
c := parser inWhichClassIsClassVar:string.
c notNil ifTrue:[
- ^ string , ' is a class variable in ' , c name
+ ^ string , ' is a class variable in ' , c name
].
string knownAsSymbol ifTrue:[
- "globals"
- sym := string asSymbol.
- (Smalltalk includesKey:sym) ifTrue:[
- (Smalltalk at:sym) isBehavior ifTrue:[
- ^ string , ' is a global variable.
-
-' , string , ' is a class in category ' , (Smalltalk at:sym) category , '.'
- ] ifFalse:[
- ^ string , ' is a global variable.
-
-Its current value is ' , (Smalltalk at:sym) classNameWithArticle , '.'
- ]
- ].
+ "globals & symbols"
- list := OrderedCollection new.
- "selectors"
- Smalltalk allBehaviorsDo:[:c|
- (c implements:sym) ifTrue:[
- list add:(c name)
- ].
- (c class implements:sym) ifTrue:[
- list add:(c name , 'class')
- ]
- ].
- count := list size.
- (count ~~ 0) ifTrue:[
- tmp := ' is a selector implemented in '.
- (count == 1) ifTrue:[
- ^ string , tmp , (list at:1) , '.'
- ].
- (count == 2) ifTrue:[
- ^ string , tmp , (list at:1) , ' and ' , (list at:2) , '.'
- ].
- (count == 3) ifTrue:[
- ^ string , tmp , '
-' , (list at:1) , ', ' , (list at:2) , ' and ' , (list at:3) , '.'
- ].
- (count == 4) ifTrue:[
- ^ string , tmp , '
-' , (list at:1) , ', ' , (list at:2) , ', ' , (list at:3), ' and ' , (list at:4) , '.'
- ].
-
- commonSuperClass := self commonSuperClassOf:list.
- commonSuperClass ~~ Object ifTrue:[
- ^ string , tmp, count printString , ' subclasses of ' , commonSuperClass name
- ].
-
- ^ string , tmp , count printString , ' classes.'
- ]
+ tmp := self explainKnownSymbol:string.
+ tmp notNil ifTrue:[ ^ tmp].
].
"try for some obvious things"
@@ -176,127 +140,11 @@
"try syntax ..."
- ((string = ':=') or:[string = '_']) ifTrue:[
- ^ '<variable> := <expression>
-
-:= and _ (which is left-arrow in some fonts) mean assignment.
-The variable is bound to (i.e. points to) the value of <expression>.'
- ].
-
- (string = '^') ifTrue:[
- ^ '^ <expression>
-
-return the value of <expression> as value from the method.
-A return from within a block exits the method where the block is defined.'
- ].
-
- (string = ';') ifTrue:[
- ^ '<expression> ; selector1 ; .... ; selectorN
-
-a cascade expression; evaluate expression, and send messages
-<selector1> ... <selectorN> to the first expressions receiver.
-Returns the value of the last send. The cascade sends may also have arguments.'
- ].
-
- (string = '|') ifTrue:[
- ^ '| locals | or: [:arg | statements]
-
-| is used to mark a local variable declaration or separates arguments
-from the statements in a block. Notice, that in a block-argument declaration
-these must be prefixed by a colon character.
-| is also a selector understood by Booleans.'
- ].
-
- ((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
- ^ '(<expression>)
-
-expression grouping.'
- ].
-
- ((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
- ^ '[arguments | statements]
-
-defines a block.
-Blocks represent pieces of executable code. Definition of a block does
-not evaluate it. The block is evaluated by sending it a value/value:
-message.
-Blocks are often passed as arguments to Booleans (i.e. ifTrue:[...]) or
-collections (i.e. do:[...]).'
- ].
-
- (string = ':') ifTrue:[
- ^ 'colons have different meaning depending on context:
-
-1) they separate keyword-parts in symbols and keyword-messages as in:
-
- #at:put: a constant keyword symbol
-
- rec at:index put:value sends the #at:put: message to rec,
- passing index and value as arguments.
-
-2) within block-argument declarations as in:
-
- [:arg1 :arg2 | statements]
-'
- ].
-
- (string = '.') ifTrue:[
- ^ 'statement. "<- period here"
-statement
-
-within a method or block, individual statements are separated by periods.
-'
- ].
-
- (string startsWith:'#' ) ifTrue:[
- (string startsWith:'#(' ) ifTrue:[
- ^ 'is a constant Array.
-
-The elements of a constant Array must be Number-constants, nil, true or false.
-(notice, that not all Smalltalk implementations allow true, false and nil as
- constant-Array elements).'
- ].
-
- (string startsWith:'#[') ifTrue:[
- ^ 'is a constant ByteArray.
-
-The elements of a constant ByteArray must be Integer constants in the range
-0 .. 255.
-(notice, that not all Smalltalk implementations support constant ByteArrays).'
- ].
-
- (string startsWith:'#''') ifTrue:[
- ^ 'is a constant symbol containing non-alphanumeric characters.
-
-Symbols are unique strings, meaning that there exists
-exactly one instance of a given symbol. Therefore symbols can
-be compared using == (identity compare) in addition to = (contents compare).
-Beside this, Symbols behave mostly like Strings.
-
-Notice, that not all Smalltalk implementations support this kind of symbols.'
- ].
-
- ^ 'is a symbol.
-
-Symbols are unique strings, meaning that there exists
-exactly one instance of a given symbol. Therefore symbols can
-be compared using == (identity compare) in addition to = (contents compare).
-Beside this, Symbols behave mostly like Strings.'
- ].
-
- "/ is it a symbol without hash-character ?
- "/
- string knownAsSymbol ifTrue:[
- ^ 'is nothing, but #' , string , ' is known as a symbol.
-
-Symbols are unique strings, meaning that there exists
-exactly one instance of a given symbol. Therefore symbols can
-be compared using == (identity compare) in addition to = (contents compare).
-Beside this, Symbols behave mostly like Strings.'
- ].
+ tmp := self explainSyntax:string.
+ tmp notNil ifTrue:[ ^ tmp].
parser isNil ifTrue:[
- ^ 'parse error -no explanation'
+ ^ 'parse error - no explanation'
].
^ 'cannot explain this - select individual tokens for an explanation.'
!
@@ -305,35 +153,35 @@
"return explanation for the pseudoVariables self, super etc."
(string = 'self') ifTrue:[
- ^ self explainSelfIn:aClass
+ ^ self explainSelfIn:aClass
].
(string = 'super') ifTrue:[
- ^ self explainSuperIn:aClass
+ ^ self explainSuperIn:aClass
].
(string = 'thisContext') ifTrue:[
- ^ 'thisContext is a pseudo variable (i.e. it is built in).
+ ^ 'thisContext is a pseudo variable (i.e. it is built in).
-ThisContext always refers to the context object for the currently executed Method or
-Block (an instance of Context or BlockContext respectively). The calling chain and calling
+ThisContext always refers to the context object for the currently executed method or
+block (an instance of Context or BlockContext respectively). The calling chain and calling
receivers/selectors can be accessed via thisContext.'
].
(string = 'true') ifTrue:[
- ^ 'true is a pseudo variable (i.e. it is built in).
+ ^ 'true is a pseudo variable (i.e. it is built in).
True represents logical truth. It is the one and only instance of class True.'
].
(string = 'false') ifTrue:[
- ^ 'false is a pseudo variable (i.e. it is built in).
+ ^ 'false is a pseudo variable (i.e. it is built in).
False represents logical falseness. It is the one and only instance of class False.'
].
(string = 'nil') ifTrue:[
- ^ 'nil is a pseudo variable (i.e. it is built in).
+ ^ 'nil is a pseudo variable (i.e. it is built in).
Nil is used for unitialized variables (among other uses).
Nil is the one and only instance of class UndefinedObject.'
@@ -346,13 +194,13 @@
sub := aClass allSubclasses collect:[:c | c name].
sub size == 0 ifTrue:[
- ^ 'self refers to the object which received the message.
+ ^ 'self refers to the object which received the message.
In this case, it will be an instance of ' , aClass name , '.'
].
sub size <= 5 ifTrue:[
- ^ 'self refers to the object which received the message.
+ ^ 'self refers to the object which received the message.
In this case, it will be an instance of ' , aClass name , '
or one of its subclasses:
@@ -371,47 +219,235 @@
However, when sending a message to super the search for methods
implementing this message will start in the superclass (' , aClass superclass name , ')
-instead of selfs class (' , aClass name , ').'
+instead of selfs class (' , aClass name , ').
+Thus, using super, a redefined method can call the original method in its superclass.'
!
commonSuperClassOf:listOfClassNames
|common found|
listOfClassNames do:[:className |
- |class|
+ |class|
- ((className endsWith:'class') and:[className ~= 'Metaclass']) ifTrue:[
- class := Smalltalk at:(className copyTo:(className size - 5)) asSymbol class
- ] ifFalse:[
- class := Smalltalk at:(className asSymbol).
- ].
- common isNil ifTrue:[
- common := class
- ] ifFalse:[
- (class isSubclassOf:common) ifTrue:[
- "keep common"
- ] ifFalse:[
- (common isSubclassOf:class) ifTrue:[
- common := class
- ] ifFalse:[
- "walk up, checking"
- found := false.
- common allSuperclassesDo:[:sup |
- (class isSubclassOf:sup) ifTrue:[
- common := sup
- ]
- ].
- found ifFalse:[
- class allSuperclassesDo:[:sup |
- (common isSubclassOf:sup) ifTrue:[
- common := sup
- ]
- ].
- ].
- ]
- ].
- ].
- common == Object ifTrue:[^ common]
+ ((className endsWith:'class') and:[className ~= 'Metaclass']) ifTrue:[
+ class := Smalltalk at:(className copyTo:(className size - 5)) asSymbol class
+ ] ifFalse:[
+ class := Smalltalk at:(className asSymbol).
+ ].
+ common isNil ifTrue:[
+ common := class
+ ] ifFalse:[
+ (class isSubclassOf:common) ifTrue:[
+ "keep common"
+ ] ifFalse:[
+ (common isSubclassOf:class) ifTrue:[
+ common := class
+ ] ifFalse:[
+ "walk up, checking"
+ found := false.
+ common allSuperclassesDo:[:sup |
+ (class isSubclassOf:sup) ifTrue:[
+ common := sup
+ ]
+ ].
+ found ifFalse:[
+ class allSuperclassesDo:[:sup |
+ (common isSubclassOf:sup) ifTrue:[
+ common := sup
+ ]
+ ].
+ ].
+ ]
+ ].
+ ].
+ common == Object ifTrue:[^ common]
].
^ common
+!
+
+explainSyntax:string
+ "try syntax ...; return explanation or nil"
+
+ ((string = ':=') or:[string = '_']) ifTrue:[
+ ^ '<variable> := <expression>
+
+:= and _ (which is left-arrow in some fonts) mean assignment.
+The variable is bound to (i.e. points to) the value of <expression>.'
+ ].
+
+ (string = '^') ifTrue:[
+ ^ '^ <expression>
+
+return the value of <expression> as value from the method.
+A return from within a block exits the method where the block is defined.'
+ ].
+
+ (string = ';') ifTrue:[
+ ^ '<expression> ; selector1 ; .... ; selectorN
+
+a cascade expression; evaluate expression, and send messages
+<selector1> ... <selectorN> to the first expressions receiver.
+Returns the value of the last send. The cascade sends may also have arguments.'
+ ].
+
+ (string = '|') ifTrue:[
+ ^ '| locals | or: [:arg | statements]
+
+| is used to mark a local variable declaration or separates arguments
+from the statements in a block. Notice, that in a block-argument declaration
+these must be prefixed by a colon character.
+| is also a selector understood by Booleans.'
+ ].
+
+ ((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
+ ^ '(<expression>)
+
+expression grouping.'
+ ].
+
+ ((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
+ ^ '[arguments | statements]
+
+defines a block.
+Blocks represent pieces of executable code. Definition of a block does
+not evaluate it. The block is evaluated by sending it a value/value:
+message.
+Blocks are often passed as arguments to Booleans (i.e. ifTrue:[...]) or
+collections (i.e. do:[...]).'
+ ].
+
+ (string = ':') ifTrue:[
+ ^ 'colons have different meaning depending on context:
+
+1) they separate keyword-parts in symbols and keyword-messages as in:
+
+ #at:put: a constant keyword symbol
+
+ rec at:index put:value sends the #at:put: message to rec,
+ passing index and value as arguments.
+
+2) within block-argument declarations as in:
+
+ [:arg1 :arg2 | statements]
+'
+ ].
+
+ (string = '.') ifTrue:[
+ ^ 'statement. "<- period here"
+statement
+
+within a method or block, individual statements are separated by periods.
+'
+ ].
+
+ (string startsWith:'#' ) ifTrue:[
+ (string startsWith:'#(' ) ifTrue:[
+ ^ 'is a constant Array.
+
+The elements of a constant Array must be Number-constants, nil, true or false.
+(notice, that not all Smalltalk implementations allow true, false and nil as
+ constant-Array elements).'
+ ].
+
+ (string startsWith:'#[') ifTrue:[
+ ^ 'is a constant ByteArray.
+
+The elements of a constant ByteArray must be Integer constants in the range
+0 .. 255.
+(notice, that not all Smalltalk implementations support constant ByteArrays).'
+ ].
+
+ (string startsWith:'#''') ifTrue:[
+ ^ 'is a constant symbol containing non-alphanumeric characters.
+
+Symbols are unique strings, meaning that there exists
+exactly one instance of a given symbol. Therefore symbols can
+be compared using == (identity compare) in addition to = (contents compare).
+Beside this, Symbols behave mostly like Strings.
+
+Notice, that not all Smalltalk implementations support this kind of symbols.'
+ ].
+
+ ^ 'is a symbol.
+
+Symbols are unique strings, meaning that there exists
+exactly one instance of a given symbol. Therefore symbols can
+be compared using == (identity compare) in addition to = (contents compare).
+Beside this, Symbols behave mostly like Strings.'
+ ].
+
+ "/ is it a symbol without hash-character ?
+ "/
+ string knownAsSymbol ifTrue:[
+ ^ 'is nothing, but #' , string , ' is known as a symbol.
+
+Symbols are unique strings, meaning that there exists
+exactly one instance of a given symbol. Therefore symbols can
+be compared using == (identity compare) in addition to = (contents compare).
+Beside this, Symbols behave mostly like Strings.'
+ ].
+
+ ^ nil
+!
+
+explainKnownSymbol:string
+ "return explanation or nil"
+
+ |sym list count tmp commonSuperClass|
+
+ sym := string asSymbol.
+
+ "try globals"
+
+ (Smalltalk includesKey:sym) ifTrue:[
+ (Smalltalk at:sym) isBehavior ifTrue:[
+ ^ string , ' is a global variable.
+
+' , string , ' is a class in category ' , (Smalltalk at:sym) category , '.'
+ ] ifFalse:[
+ ^ string , ' is a global variable.
+
+Its current value is ' , (Smalltalk at:sym) classNameWithArticle , '.'
+ ]
+ ].
+
+ "try selectors"
+ list := Set new.
+ Smalltalk allBehaviorsDo:[:c|
+ (c implements:sym) ifTrue:[
+ list add:(c name)
+ ].
+ (c class implements:sym) ifTrue:[
+ list add:(c name , 'class')
+ ]
+ ].
+
+ count := list size.
+ (count ~~ 0) ifTrue:[
+ list := list asOrderedCollection sort.
+ tmp := ' is a selector implemented in '.
+ (count == 1) ifTrue:[
+ ^ string , tmp , (list at:1) , '.'
+ ].
+ (count == 2) ifTrue:[
+ ^ string , tmp , (list at:1) , ' and ' , (list at:2) , '.'
+ ].
+ (count == 3) ifTrue:[
+ ^ string , tmp , '
+' , (list at:1) , ', ' , (list at:2) , ' and ' , (list at:3) , '.'
+ ].
+ (count == 4) ifTrue:[
+ ^ string , tmp , '
+' , (list at:1) , ', ' , (list at:2) , ', ' , (list at:3), ' and ' , (list at:4) , '.'
+ ].
+
+ commonSuperClass := self commonSuperClassOf:list.
+ commonSuperClass ~~ Object ifTrue:[
+ ^ string , tmp, count printString , ' subclasses of ' , commonSuperClass name
+ ].
+
+ ^ string , tmp , count printString , ' classes.'
+ ].
+
+ ^ nil
! !