Parser.st
changeset 20 f8dd8ba75205
parent 19 84a1ddf215a5
child 21 338c3cfeffbf
--- a/Parser.st	Wed Mar 30 12:10:24 1994 +0200
+++ b/Parser.st	Thu Jun 02 22:26:28 1994 +0200
@@ -34,15 +34,32 @@
 !
 
 Parser comment:'
-
 COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved
-
-$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.10 1994-03-30 10:10:24 claus Exp $
 '!
 
 !Parser class methodsFor:'documentation'!
 
+copyright
+"
+ COPYRIGHT (c) 1989 by Claus Gittinger
+              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
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.11 1994-06-02 20:26:08 claus Exp $
+"
+!
+
 documentation
 "
     Parser is used for both parsing and evaluating smalltalk expressions;
@@ -66,8 +83,8 @@
     You can also use parsers for all kinds of other things (ChangesBrowser for
     example analyzes the expressions in the changelist ...) by looking at the
     parsers tree. (Although this is somewhat dangerous, since it exports the
-    compilers internals ... better style would be to add specialized query
-     methods here.)
+    compilers internals ... better style is to add specialized query methods here,
+    which will be done incrementally.)
 
     One instance of Parser is created to parse one method or expression - i.e.
     its not suggested to reuse parsers.
@@ -150,6 +167,7 @@
         in:nil 
         receiver:nil 
         notifying:nil 
+        logged:false
         ifFail:nil 
 
     "
@@ -159,6 +177,36 @@
     "
 !
 
+evaluate:aStringOrStream ifFail:failBlock
+    "return the result of evaluating an expression in aStringOrStream.
+     In case of any syntax errors, return the value of failBlock."
+
+    ^ self 
+        evaluate:aStringOrStream 
+        in:nil 
+        receiver:nil 
+        notifying:nil 
+        logged:false
+        ifFail:failBlock 
+
+    "
+     Compiler evaluate:'1 +' ifFail:['oops']   
+
+    "
+!
+
+evaluate:aStringOrStream logged:logged
+    "return the result of evaluating an expression in aStringOrStream"
+
+    ^ self 
+        evaluate:aStringOrStream 
+        in:nil 
+        receiver:nil 
+        notifying:nil 
+        logged:logged
+        ifFail:nil 
+!
+
 evaluate:aStringOrStream notifying:requestor
     "return the result of evaluating aString, 
      errors are reported to requestor"
@@ -168,26 +216,45 @@
         in:nil 
         receiver:nil 
         notifying:requestor
+        logged:false
         ifFail:nil 
 
 !
 
-evaluate:aString receiver:anObject notifying:requestor
+evaluate:aStringOrStream receiver:anObject notifying:requestor
     "return the result of evaluating aString, 
      errors are reported to requestor. Allow access to
      anObject as self and to its instVars (used in the inspector)"
 
     ^ self 
-        evaluate:aString
+        evaluate:aStringOrStream
         in:nil
         receiver:anObject
         notifying:requestor
+        logged:false
         ifFail:nil
 !
 
 evaluate:aStringOrStream in:aContext receiver:anObject 
                                     notifying:requestor
                                        ifFail:failBlock
+    ^ self 
+        evaluate:aStringOrStream
+        in:nil
+        receiver:anObject
+        notifying:requestor
+        logged:false
+        ifFail:nil
+!
+
+evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock
+    "return the result of evaluating aStringOrStream, errors are reported to requestor. 
+     Allow access to anObject as self and to its instVars (used in the inspector).
+     If logged is true, an entry is added to the change-file. If the failBlock argument
+     is non-nil, it is evaluated if an error occurs."
+
+    "XXX: logging is not yet implemented"
+
     |parser tree mustBackup|
 
     aStringOrStream isNil ifTrue:[^ nil].
@@ -238,7 +305,7 @@
 
 selectorInExpression:aString
     "parse an expression - return the selector. Used for
-     SystemBrowsers implementors/senders query-box initial text"
+     SystemBrowsers implementors/senders query-box initial text."
 
     |tree parser|
 
@@ -265,12 +332,12 @@
     ^ parser degeneratedKeywordExpressionForSelector
 
 "
-    Parser selectorInExpression:'foo at:1 put:(5 * bar)'
-    Parser selectorInExpression:'(foo at:1) at:1'
-    Parser selectorInExpression:'1 + 4'
-    Parser selectorInExpression:'1 negated'
-    Parser selectorInExpression:'at:1 put:5'
-    Parser selectorInExpression:'a := foo at:1 put:5'
+    Parser selectorInExpression:'foo at:1 put:(5 * bar)'     
+    Parser selectorInExpression:'(foo at:1) at:1'           
+    Parser selectorInExpression:'1 + 4'                     
+    Parser selectorInExpression:'1 negated'                 
+    Parser selectorInExpression:'at:1 put:5'            
+    Parser selectorInExpression:'a := foo at:1 put:5'    
 "
 !
 
@@ -309,6 +376,15 @@
      return the parser, nil or #error"
 
     ^ self parseMethodSpecification:aString in:nil
+
+    "
+     |p|
+
+     p := Parser parseMethodSpecification:'foo:arg1 bar:arg2 baz:arg3'.
+     'nArgs: ' print. p numberOfMethodArgs printNL.
+     'args:  ' print. p methodArgs printNL.
+     'sel:   ' print. p selector printNL
+    "
 !
 
 parseMethodSpecification:aString in:aClass
@@ -330,6 +406,17 @@
      return the parser, nil or #error"
 
     ^ self parseMethodArgAndVarSpecification:aString in:nil
+
+    "
+     |p|
+
+     p := Parser parseMethodArgAndVarSpecification:'foo:arg1 bar:arg2 baz:arg3 |l1 l2|'.
+     'nArgs:  ' print. p numberOfMethodArgs printNL.
+     'args:   ' print. p methodArgs printNL.
+     'sel:    ' print. p selector printNL.
+     'nLocal: ' print. p numberOfMethodVars printNL.
+     'locals: ' print. p methodVars printNL.
+    "
 !
 
 parseMethodArgAndVarSpecification:aString in:aClass
@@ -351,6 +438,18 @@
     "parse a method; return parser, nil or #error"
 
     ^ self parseMethod:aString in:nil
+
+    "
+     |p|
+
+     p := Parser parseMethod:'foo:arg1 bar:arg2 baz:arg3 |l1 l2| l1 := 0. l2 := arg1. ^ self'.
+     'nArgs:  ' print. p numberOfMethodArgs printNL.
+     'args:   ' print. p methodArgs printNL.
+     'sel:    ' print. p selector printNL.
+     'nLocal: ' print. p numberOfMethodVars printNL.
+     'locals: ' print. p methodVars printNL.
+     'tree:   ' printNL. p tree printAllOn:Stdout. Stdout cr.
+    "
 !
 
 parseMethod:aString in:aClass
@@ -365,6 +464,51 @@
     ^ parser
 ! !
 
+!Parser class methodsFor:'unparsing'!
+
+methodSpecificationForSelector:aSelector
+    "given a selector such as #foo:bar:, return a string that could
+     serve as a methods specification source code.
+     To be used for code generators"
+
+    ^ self methodSpecificationForSelector:aSelector 
+                                 argNames:#('arg1' 'arg2' 'arg3' 'arg4' 'arg5' 'arg6'
+                                            'arg7' 'arg8' 'arg9' 'arg10' 'arg11' 'arg12'
+                                            'arg13' 'arg14' 'arg15')
+    "
+     Parser methodSpecificationForSelector:#foo:bar:   
+     Parser methodSpecificationForSelector:#+   
+     Parser methodSpecificationForSelector:#negated   
+    "
+!
+
+methodSpecificationForSelector:aSelector argNames:argNames
+    "given a selector such as #foo:bar:, return a string that could
+     serve as a methods specification source code.
+     To be used for code generators"
+
+    |s nargs parts|
+
+    s := WriteStream on:String new.
+    nargs := aSelector nArgsIfSelector.
+    nargs == 0 ifTrue:[
+        s nextPutAll:aSelector
+    ] ifFalse:[
+        parts := aSelector partsIfSelector.
+        1 to:nargs do:[:i |
+            s nextPutAll:(parts at:i); space;
+              nextPutAll:(argNames at:i); space.
+        ]
+    ].
+    ^ s contents
+
+    "
+     Parser methodSpecificationForSelector:#foo:bar: argNames:#('one' 'two' 'three')  
+     Parser methodSpecificationForSelector:#+ argNames:#('one')  
+     Parser methodSpecificationForSelector:#negated   
+    "
+! !
+
 !Parser class methodsFor:'controlling compilation'!
 
 compileLazy:aBoolean
@@ -1099,15 +1243,15 @@
         try := MessageNode receiver:receiver selector:sel args:args.
         (try isMemberOf:String) ifTrue:[
             self parseError:try position:pos1 to:pos2.
-            receiver := MessageNode receiver:receiver selector:sel args:args fold:false
+            receiver := MessageNode receiver:receiver selector:sel args:args fold:false.
+            note := receiver plausibilityCheck.
+            note notNil ifTrue:[
+                self warning:note position:pos1 to:pos2
+            ].
+            receiver lineNumber:lno
         ] ifFalse:[
             receiver := try
         ].
-        note := receiver plausibilityCheck.
-        note notNil ifTrue:[
-            self warning:note position:pos1 to:pos2
-        ].
-        receiver lineNumber:lno
     ].
     ^ receiver
 !
@@ -1169,15 +1313,15 @@
         try := BinaryNode receiver:receiver selector:sel arg:arg.
         (try isMemberOf:String) ifTrue:[
             self parseError:try position:pos to:tokenPosition.
-            receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:false
+            receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:false.
+            note := receiver plausibilityCheck.
+            note notNil ifTrue:[
+                self warning:note position:pos to:tokenPosition
+            ].
+            receiver lineNumber:lno
         ] ifFalse:[
             receiver := try
         ].
-        note := receiver plausibilityCheck.
-        note notNil ifTrue:[
-            self warning:note position:pos to:tokenPosition
-        ].
-        receiver lineNumber:lno
     ].
     ^ receiver
 !
@@ -1196,11 +1340,11 @@
         try := UnaryNode receiver:receiver selector:sel.
         (try isMemberOf:String) ifTrue:[
             self warning:try position:pos to:pos2.
-            receiver := UnaryNode receiver:receiver selector:sel fold:false
+            receiver := UnaryNode receiver:receiver selector:sel fold:false.
+            receiver lineNumber:tokenLineNr.
         ] ifFalse:[
             receiver := try
         ].
-        receiver lineNumber:tokenLineNr.
         self nextToken.
     ].
     ^ receiver
@@ -1728,7 +1872,7 @@
     |arr elem pos1|
 
     pos1 := tokenPosition.
-    arr := OrderedCollection new:200.
+    arr := OrderedCollection new:20.
     [tokenType ~~ $) ] whileTrue:[
         elem := self arrayConstant.
         (elem == #Error) ifTrue:[
@@ -1750,7 +1894,7 @@
     |arr elem pos1 pos2|
 
     pos1 := tokenPosition.
-    arr := OrderedCollection new.
+    arr := OrderedCollection new:50.
     [tokenType ~~ $] ] whileTrue:[
         pos2 := tokenPosition.
         elem := self arrayConstant.
@@ -1969,7 +2113,34 @@
         dists := dists reverse.             
         names := names reverse.
         n := names size min:10.
-        ^ names copyTo:n
+        names := names copyTo:n.
+
+        "if it starts with a lower case character, add all local & instvar names"
+        (aString at:1) isLowercase ifTrue:[
+            methodVarNames size > 0 ifTrue:[
+                names add:'---- method locals ----'.
+                methodVarNames do:[:methodVarName |
+                    names add:methodVarName.
+                ].
+            ].
+
+
+            methodArgs notNil ifTrue:[
+                names add:'---- method arguments ----'.
+                methodArgNames do:[:methodArgName |
+                    names add:methodArgName.
+                ]
+            ].
+
+            names add:'---- instance variables ----'.
+            PrevInstVarNames do:[:instVarName |
+                (names includes:instVarName) ifFalse:[
+                    names add:instVarName.
+                ]
+            ]
+        ].
+
+        ^ names
     ].
     ^ nil
 !