Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Reflecting on Source Code
Last updated at 9:54 pm UTC on 28 July 2007
This example from squeak-dev email:
Date: Tue, 11 May 2004 14:10:53 +0200
From: "Boris Gaertner"

Question: I want to write a method that will count the SLOC (software lines of code) in each version of squeak. My question is what object am I seeking to enumerate? It doesn't seem to be Message.

Answer: Most of the methods that you need to enumerate methods can be found in the protocol of Behavior. Together with its subclasses, this class implements the capablity of Smalltalk to describe itself. Behavior is typically left unexplained in introductory presentations of Smalltalk.

First a technical hint: Iteration over all classes is time consuming. To quickly test a new idea, you may prefer to iterate over one small branch of the class tree. Good candidates are Set and Number:

 Set withAllSubclasses size    16
 Number withAllSubclasses size    8

These are branches with 16 resp. 8 classes. You can quickly count the methods:

  | instanceMethods classMethods |
  instanceMethods := classMethods := 0.
  Number withAllSubclasses do:
      [:class |
       class isMeta
         ifFalse:
          [instanceMethods := class methodDictionary size
                                            + instanceMethods.
          classMethods  := class class methodDictionary size
                                            + classMethods].
      ].
  { instanceMethods. classMethods }

The 'class isMeta ifFalse:' is not really necessary in this example, it becomes necessary as soon as we iterate over a class tree that contains class Class. The subclasses of Class are the metaclasses (the entities that describe the class proctocol of classes) and in our code we access the metaclasses with "class class"

Now let us take a closer look at the methods. Have you seen ClassDescription>>linesOfCode? This is a good point to start with. Try (with 'print it')

 Number linesOfCode
 Number class linesOfCode

Then try (with 'print it')

  | instanceLoc classLoc |
  instanceLoc := classLoc := 0.
  Number withAllSubclasses do:
    [:class |
      class isMeta
        ifFalse:
          [instanceLoc := class linesOfCode + instanceLoc.
           classLoc := class class linesOfCode + classLoc].
   ].
  { instanceLoc. classLoc }

What is that?
Here we count for Number and all its subclasses the number of codelines. We do that separately for the instance methods and for the class methods.

Keep in mind that the Smalltalk compiler is always at your service. This simple fact gives you the possibility to try metrics that are difficult to use in other languages. So see how you can use the parser, please try this with 'inspect':

  | methodNode |
  methodNode:= Collection  compilerClass new
       parse: (Collection sourceCodeAt: #size)
       in: Collection
       notifying: nil.
  methodNode block

The inspector show you an instance of BlockNode. This is a structure that the parser creates for use by the compiler. The block node has an instance variable 'statements' and when you follow it, you see that it references an OrderedCollection with three elements. Look at: Collection>size This method has three statements!

The expression

  | methodNode |
  methodNode:= Collection  compilerClass new
       parse: (Collection sourceCodeAt: #size)
       in: Collection
       notifying: nil.
  methodNode block statements size

answers the number of statements in Collection>size. We can do this for all methods in our image:

 | stmts methodNode |
 stmts := 0.
 ProtoObject withAllSubclasses do:
 [:cl |
  cl isMeta
   ifFalse:
     [(Array with: cl with: cl class)
     do:
      [:classOrMetaClass |
       classOrMetaClass selectorsDo:
          [:sel |
             methodNode:= classOrMetaClass compilerClass new
                                 parse: (classOrMetaClass sourceCodeAt: sel)
                                 in: classOrMetaClass
                                 notifying: nil.
             stmts := stmts + methodNode block statements size
        ].
    ].
 ]].

This is already quite nice, but it has the following peculiarity: A structured statement like

  rec isFoo
    ifTrue: [rec doThis. rec doThat]
    ifFalse: [rec doSomethingDifferent]

is counted as one statement. Often you would prefer to say that these are four statements. Attached (see below) you find a change set that adds the instance nroOfStatements to six kinds of ParseNodes. With that addition you can count

  |  stmts methodNode |
 stmts := 0.
 ProtoObject withAllSubclasses do:
  [:cl |
 cl isMeta
   ifFalse:
     [(Array with: cl with: cl class)
     do:
      [:classOrMetaClass |
    classOrMetaClass selectorsDo:
          [:sel |
                methodNode:= classOrMetaClass compilerClass new
                            parse: (classOrMetaClass sourceCodeAt: sel)
                             in: classOrMetaClass
                             notifying: nil.
               stmts := stmts + methodNode nroOfStatements
        ].
    ].
 ]].
  stmts

For a quite up-to-date 3.7beta image I get 273286 statements. When I compare with the number of lines computed by Markus
I conclude that we care for readability: The rule "one statement per line" is obviously followed.
You can download the attachment from: SqueakMetrics