Parser.st
changeset 2511 5ee5e40e1d7a
parent 2493 c9645b7f3986
child 2522 98d9b2d23ca5
--- a/Parser.st	Tue Jun 28 22:17:56 2011 +0200
+++ b/Parser.st	Tue Jun 28 22:18:55 2011 +0200
@@ -31,7 +31,7 @@
 		didWarnAboutSTXNameSpaceUse didWarnAboutSTXHereExtensionUsed
 		parenthesisLevel didWarnAboutBadSupersend
 		didWarnAboutSqueakExtensions allowUndeclaredVariables
-		interactiveMode variableCorrectActionForAll
+		interactiveMode variableCorrectActionForAll annotations
 		variableTypeOfLastCorrectAction'
 	classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
 		PrevClassInstVarNames LazyCompilation FoldConstants
@@ -5022,7 +5022,8 @@
     self checkForEndOfInput.
     ^ parseTree
 
-    "Modified: 20.4.1996 / 20:09:26 / cg"
+    "Modified: / 20-04-1996 / 20:09:26 / cg"
+    "Modified: / 12-07-2010 / 10:08:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parseMethod:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
@@ -5262,6 +5263,7 @@
 
     |arg pos2|
 
+
     tokenType isNil ifTrue:[
         self nextToken.
     ].
@@ -5333,6 +5335,7 @@
             position:tokenPosition to:pos2.
     ].
 
+
     (tokenType == #BinaryOperator) ifTrue:[
         self markMethodSelectorFrom:tokenPosition to:(tokenPosition+tokenName size-1).
         selector := tokenName asSymbol.
@@ -5359,6 +5362,7 @@
     ^ self parseExtendedMethodSpec
 
     "Modified: / 17-07-2006 / 00:44:26 / cg"
+    "Modified: / 12-07-2010 / 09:57:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 statement
@@ -7928,41 +7932,84 @@
     "Created: / 21-06-2006 / 09:58:43 / cg"
 !
 
+parseAnotationLiteral
+    |value|
+
+    (((tokenType == #String) or: [(tokenType == #Integer)] or: [(tokenType == #True)] or: [(tokenType == #False)] or: [(tokenType == #Nil)])
+            or: [(tokenType == #Symbol)] or:[(tokenType == #Character)]) ifTrue: [
+        value := tokenValue.
+        self nextToken.
+        ^ value.
+    ].
+
+    (tokenType == #Identifier) ifTrue:[
+        value := tokenName asSymbol.
+        self nextToken.
+        ^ value.
+    ].
+
+    "
+    (tokenType == #Keyword) ifTrue: [
+        value := '#', tokenName.
+        self nextToken.
+        ^ value.
+    ].
+    "
+
+    ((tokenType == $() or:[tokenType == #HashLeftParen]) ifTrue:[
+        self nextToken.
+        value := self array.
+        self nextToken.
+        ^ value.
+    ].
+
+    ((tokenType == $[) or:[tokenType == #HashLeftBrack]) ifTrue:[
+        self nextToken.
+        value := self byteArray.
+        self nextToken.
+        ^value.
+    ].
+    ^ #Error
+
+    "Created: / 12-11-2009 / 14:08:29 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 15-12-2009 / 14:01:42 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 12-07-2010 / 10:07:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 parseExceptionOrContextPragma
     "parse 
-        <exception: #handle|raise|unwind>, 
+        <exception: #handle|raise|unwind>,
         <context: #return>
      context flagging pragmas."
-
+    
     |pragmaType|
 
     "/ notice: '<' has already been parsed.
-
     pragmaType := tokenName.
-
     self nextToken.
     (tokenType ~~ #Symbol) ifTrue:[
         self parseError:'symbol expected'.
         ^ #Error
     ].
-
-    ((pragmaType = 'exception:'
-        and:[tokenValue == #'handle'
-             or:[tokenValue == #'raise'
-             or:[tokenValue == #'unwind']]])
-    or:[
-        pragmaType = 'context:'
-        and:[(tokenValue == #'return')]])
-
-    ifTrue:[
-        primitiveContextInfo isNil ifTrue:[
-            primitiveContextInfo := Set new.
-        ].
-        primitiveContextInfo add:(pragmaType->tokenValue).
-    ] ifFalse:[
-        self parseError:'unrecognized exception pragma: ' , tokenValue.
-    ].
+    ((pragmaType = 'exception:' 
+        and:[
+            tokenValue == #handle 
+                or:[ tokenValue == #raise or:[ tokenValue == #unwind ] ]
+        ]) 
+            or:[ pragmaType = 'context:' and:[ (tokenValue == #return) ] ]) 
+            ifTrue:[
+                primitiveContextInfo isNil ifTrue:[
+                    primitiveContextInfo := Set new.
+                ].
+                primitiveContextInfo add:(pragmaType -> tokenValue).
+            ]
+            ifFalse:[ self parseError:'unrecognized exception pragma: ' , tokenValue. ].
+    annotations := annotations 
+                copyWith:(Array with:pragmaType asSymbol with:(Array with:tokenValue)).
     self nextToken.
+
+    "Modified: / 19-11-2009 / 11:10:04 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 01-07-2010 / 12:33:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parseExternalFunctionCallDeclaration
@@ -7970,72 +8017,121 @@
 
     "callType is one of c: / cdecl: / api: / apicall: ..."
     callType := tokenName asLowercase.
-
     lineNr := tokenLineNr.
     cString := source upTo:$>.
     self nextToken.
-
-    parseForCode ifFalse:[^ -1].
-
+    parseForCode ifFalse:[
+        ^ -1
+    ].
     CParser notNil ifTrue:[
         dictionaryOfKnownTypes := Dictionary new.
-
+        
         "/ a few wellknown types
+        
         self defineWellknownCTypesIn:dictionaryOfKnownTypes.
-
+        
         "/ collect existing types...
-        classToCompileFor methodsDo:[:m |
-            m literalsDo:[:lit |
-                (lit isKindOf:CType) ifTrue:[
-                    self assert:lit name notNil.
-                    dictionaryOfKnownTypes at:lit name put:lit.
-                ].
-            ].
-        ].
-    ].
-
+        
+        classToCompileFor 
+            methodsDo:[:m | 
+                m 
+                    literalsDo:[:lit | 
+                        (lit isKindOf:CType) ifTrue:[
+                            self assert:lit name notNil.
+                            dictionaryOfKnownTypes at:lit name put:lit.
+                        ].
+                    ].
+            ].
+    ].
     cStream := cString readStream.
-
-    (#('apicall:' 'cdecl:' 'stdcall:' 'virtual') includes:callType ) ifTrue:[
-        "/ squeak/dolphin/stx external function definition
-        self
-            parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream 
+    (#( 'apicall:' 'cdecl:' 'stdcall:' 'virtual' ) includes:callType) ifTrue:[
+        "/ squeak/dolphin/stx external function definition   
+        annotations := annotations 
+                    copyWith:(Array with:callType asSymbol with:cString).
+        self 
+            parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
             definitionType:callType
             knownDefinitions:dictionaryOfKnownTypes
             lineNr:lineNr.
         ^ -1
     ].
-
     callType = 'c:' ifTrue:[
         "/ VW external function definition
-        self
-            parseVWTypeOrExternalFunctionDeclarationFrom:cStream 
+        annotations := annotations 
+                    copyWith:(Array with:callType asSymbol with:cString).
+        self 
+            parseVWTypeOrExternalFunctionDeclarationFrom:cStream
             definitionType:callType
             knownDefinitions:dictionaryOfKnownTypes
             lineNr:lineNr.
         ^ -1
     ].
-
     (callType = 'api:' or:[ callType = 'ole:' ]) ifTrue:[
         "/ ST/V external function definition
-        self
-            parseSTVExternalFunctionDeclarationFrom:cStream 
+        annotations := annotations 
+                    copyWith:(Array with:callType asSymbol with:cString).
+        self 
+            parseSTVExternalFunctionDeclarationFrom:cStream
             definitionType:callType
             knownDefinitions:dictionaryOfKnownTypes
             lineNr:lineNr.
         ^ -1
     ].
-
-    self ignorableParseError:'unsupported external function call type: ' , callType.
+    self 
+        ignorableParseError:'unsupported external function call type: ' , callType.
     ^ -1
 
     "
      (Parser for:'foo <cdecl: void ''glFlush'' (void) module: ''GL''>')
         nextToken;
-        parseMethod
-    "
-
+        parseMethod"
     "Modified: / 25-10-2006 / 12:03:33 / cg"
+    "Modified: / 19-11-2009 / 11:09:51 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 01-07-2010 / 12:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parseOtherPrimitives
+    |key value values|
+
+    key := tokenName.
+    value := true.
+    self nextToken.
+    ((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
+        annotations := annotations copyWith:(Array with:key asSymbol with:value).
+        self nextToken.
+        ^ nil.
+    ].
+    value := self parseAnotationLiteral.
+    (value == #Error) ifTrue:[
+        ^ #Error.
+    ].
+    ((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
+        annotations := annotations 
+                    copyWith:(Array with:key asSymbol with:(Array with:value)).
+        self nextToken.
+        ^ nil.
+    ].
+    values := OrderedCollection new:4.
+    values add:value.
+    [
+        (tokenType == #Keyword or:[ tokenType == #Identifier ])
+    ] whileTrue:[
+        key := key , tokenName.
+        self nextToken.
+        value := self parseAnotationLiteral.
+        (value == #Error) ifTrue:[
+            ^ #Error.
+        ].
+        values add:value.
+    ].
+    annotations := annotations 
+                copyWith:(Array with:key asSymbol with:(values asArray)).
+    self checkForClosingAngle.
+    ^ nil.
+
+    "Created: / 04-11-2009 / 08:51:48 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 19-11-2009 / 11:48:24 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 01-07-2010 / 12:10:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parsePrimitive
@@ -8046,12 +8142,12 @@
      or a V'Age-style primitive, as '< primitive: identifier >';
         (return primitive name or #Error)
 
-     Also, resource specs are parsed; the result is left (as side effect) in primitiveResource. 
+     Also, resource specs are parsed; the result is left (as side effect) in primitiveResource.
      It is used to flag methods, for faster finding of used keyboard accelerators,
      and to mark resource methods (image, menu or canvas resources).
 
      prim ::= st80Primitive | st80Pragma | stxPragma
-              | squeakPrimitive | vAgePrimitive | newSTXPrimitive 
+              | squeakPrimitive | vAgePrimitive | newSTXPrimitive
               | externalFuncDecl
               | resourceDecl
 
@@ -8086,58 +8182,88 @@
                     | 'pragma:'    SYMBOL       - same as resource; alternative syntax
                     | 'pragma:'    SYMBOL (...) - same as resource; alternative syntax
                     | 'attribute:' SYMBOL       - same as resource; alternative syntax
-                    | 'attribute:' SYMBOL (...) - same as resource; alternative syntax
-    "
-
-    |lcTokenName|
-
-    (tokenType == #Keyword or:[tokenType == #Identifier]) ifFalse:[
+                    | 'attribute:' SYMBOL (...) - same as resource; alternative syntax"
+    
+    |lcTokenName tmp|
+
+    (tokenType == #Keyword or:[ tokenType == #Identifier ]) ifFalse:[
         self parseError:'bad primitive definition (keyword expected)'.
         ^ #Error
     ].
-
     (tokenName = 'primitive:') ifTrue:[
-        ^ self parseTraditionalPrimitive.
+        tmp := self parseTraditionalPrimitive.
+        annotations := annotations 
+                    copyWith:(Array with:'primitive:' asSymbol with:tmp).
+        ^ tmp.
     ].
     (tokenName = 'sysprim:') ifTrue:[
         parserFlags allowVisualAgePrimitives ifTrue:[
-            ^ self parseTraditionalPrimitive.
-        ].
-    ].
-
+            tmp := self parseTraditionalPrimitive.
+            annotations := annotations 
+                        copyWith:(Array with:'sysprim:' asSymbol with:tmp).
+            ^ tmp.
+        ].
+    ].
     (tokenName = 'primitive') ifTrue:[
         self nextToken.
         self checkForClosingAngle.
-        ^ 0.    "/ no primitive number
-    ].
-    ((tokenName = 'resource:') 
-    or:[tokenName = 'pragma:'
-    or:[tokenName = 'attribute:' ]]) ifTrue:[
+        annotations := annotations 
+                    copyWith:(Array with:'primitive' asSymbol with:0).
+        ^ 0
+        "/ no primitive number
+        .
+    ].
+    (tokenName = 'resource:') ifTrue:[
         self parseResourcePragma.
-        ^ nil.    "/ no primitive number
-    ].
-    (tokenName = 'exception:' 
-    or:[tokenName = 'context:']) ifTrue:[
-        self parseExceptionOrContextPragma.    
+        ^ nil
+        "/ no primitive number
+        .
+    ].
+    (tokenName = 'exception:' or:[ tokenName = 'context:' ]) ifTrue:[
+        (self parseExceptionOrContextPragma) == #Error ifTrue:[
+            ^ #Error
+        ].
         self checkForClosingAngle.
-        ^ nil   "/ no primitive number
-    ].
-
+        ^ nil
+        "/ no primitive number
+    ].
     lcTokenName := tokenName asLowercase.
-    ((lcTokenName = 'c:')                 "/ vw external function definition
-    or:[ lcTokenName = 'api:'             "/ st/v external function definition
-    or:[ lcTokenName = 'ole:'             "/ st/v external function definition
-    or:[ lcTokenName = 'apicall:'         "/ squeak external function definition
-    or:[ lcTokenName = 'cdecl:'           "/ squeak external function definition
-    or:[ lcTokenName = 'stdcall:'         "/ dolphin external function definition
-    ]]]]]) ifTrue:[
-        self parseExternalFunctionCallDeclaration.
-        ^ nil   "/ no primitive number
-    ].
-
-    self ignorableParseError:'unrecognized pragma: ' , tokenName.
-    self skipForClosingAngle.
-    ^ nil  "/ no primitive number
+    ((lcTokenName = 'c:'
+            "/ vw external function definition
+            ) 
+        or:[
+            lcTokenName = 'api:'
+            "/ st/v external function definition
+             
+                    or:[
+                        lcTokenName = 'ole:'
+                        "/ st/v external function definition
+                         
+                                or:[
+                                    lcTokenName = 'apicall:'
+                                    "/ squeak external function definition
+                                     
+                                            or:[
+                                                lcTokenName = 'cdecl:'
+                                                "/ squeak external function definition
+                                                 
+                                                        or:[
+                                                            lcTokenName = 'stdcall:'
+                                                            "/ dolphin external function definition
+                                                        ]
+                                            ]
+                                ]
+                    ]
+        ]) 
+            ifTrue:[
+                self parseExternalFunctionCallDeclaration.
+                ^ nil
+                "/ no primitive number
+            ].
+    ^ self parseOtherPrimitives.
+
+    "Modified: / 10-01-2010 / 17:10:11 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 01-07-2010 / 18:12:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parsePrimitiveOrResourceSpecOrEmpty
@@ -8183,7 +8309,7 @@
 
 parseResourcePragma
     " '< resource:' has already been parsed."
-
+    
     |type keys resource resourceValue flagValue|
 
     type := token.
@@ -8208,16 +8334,15 @@
         self parseError:'symbol expected'.
         ^ #Error
     ].
-
     resource := tokenValue.
     resourceValue := true.
-
     self nextToken.
-
     tokenType == $( ifTrue:[
         self nextToken.
         keys := OrderedCollection new.
-        [(tokenType == $)) or:[tokenType == #EOF] ] whileFalse:[
+        [
+            (tokenType == $)) or:[ tokenType == #EOF ]
+        ] whileFalse:[
             keys add:tokenValue.
             self nextToken.
         ].
@@ -8227,14 +8352,22 @@
         ].
         self nextToken.
     ].
-
     primitiveResource isNil ifTrue:[
         primitiveResource := IdentityDictionary new.
     ].
     primitiveResource at:(resource asSymbol) put:resourceValue.
     self checkForClosingAngle.
-
-    "Modified: / 21-03-2011 / 13:59:15 / cg"
+    (resourceValue isBoolean and:[ resourceValue ]) ifTrue:[
+        annotations := annotations 
+                    copyWith:(Array with:#resource: asSymbol with:(Array with:resource)).
+    ] ifFalse:[
+        annotations := annotations 
+                    copyWith:(Array with:#resource:values: asSymbol
+                            with:(Array with:resource with:resourceValue)).
+    ]
+
+    "Modified: / 19-11-2009 / 11:11:26 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 01-07-2010 / 12:23:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
@@ -8341,6 +8474,8 @@
 
     self checkForClosingAngle.
     ^ primNumber
+
+    "Modified: / 03-11-2009 / 17:14:48 / Jan Travnicek <travnja3@fel.cvut.cz>"
 !
 
 parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
@@ -8819,6 +8954,13 @@
 
 !Parser methodsFor:'queries'!
 
+annotations
+    ^ annotations
+
+    "Created: / 03-11-2009 / 17:09:45 / Jan Travnicek <travnja3@fel.cvut.cz>"
+    "Modified: / 15-12-2009 / 14:07:24 / Jan Travnicek <travnja3@fel.cvut.cz>"
+!
+
 classToLookForClassVars
     "helper - return the class to look for classVars.
      If there is a context in which we evaluate, the
@@ -9163,7 +9305,10 @@
     didWarnAboutSTXHereExtensionUsed := false.
     didWarnAboutBadSupersend := false.
 
-    "Modified: 7.9.1997 / 02:04:34 / cg"
+    annotations := Array new.
+
+    "Modified: / 07-09-1997 / 02:04:34 / cg"
+    "Modified: / 01-07-2010 / 12:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 parseForCode
@@ -10186,12 +10331,12 @@
 
 !Parser class methodsFor:'documentation'!
 
-version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.665 2011-05-18 14:46:40 mb Exp $'
-!
-
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.665 2011-05-18 14:46:40 mb Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.666 2011-06-28 20:18:55 vrany Exp $'
+!
+
+version_SVN
+    ^ ' Id '
 ! !
 
 Parser initialize!