Method.st
changeset 13422 b43a8a47037c
parent 13390 3bee59036719
child 13463 7c98583d98c8
--- a/Method.st	Tue Jun 28 16:00:53 2011 +0200
+++ b/Method.st	Tue Jun 28 20:09:51 2011 +0200
@@ -12,10 +12,11 @@
 "{ Package: 'stx:libbasic' }"
 
 CompiledCode variableSubclass:#Method
-	instanceVariableNames:'source sourcePosition category package mclass'
+	instanceVariableNames:'source sourcePosition category package mclass lookupObject
+		annotations'
 	classVariableNames:'PrivateMethodSignal LastFileReference LastSourceFileName
 		LastWhoClass LastFileLock LastMethodSources LastMethodSourcesLock
-		CompilationLock'
+		CompilationLock Overrides'
 	poolDictionaries:''
 	category:'Kernel-Methods'
 !
@@ -299,6 +300,7 @@
     "Created: 9.2.1996 / 19:05:28 / cg"
 ! !
 
+
 !Method methodsFor:'Compatibility-VW'!
 
 classIsMeta
@@ -317,6 +319,123 @@
 
 !Method methodsFor:'accessing'!
 
+annotateWith: annotation
+
+    | index |
+    index := self annotationIndexOf: annotation key.
+    index 
+        ifNil:
+            [annotations := annotations
+                                ifNil:[Array with: annotation]
+                                ifNotNil:[annotations copyWith:annotation]]
+        ifNotNil:
+            [annotations at: index put: annotation].
+"/    annotation annotatesMethod: self.
+
+    "
+        (Object >> #yourself) annotateWith: (Annotation namespace: 'Fictious').  
+        (Object >> #yourself) annotations.
+        (Object >> #yourself) annotationAt: #namespace: 
+    "
+
+    "Created: / 19-05-2010 / 16:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 20-05-2010 / 11:22:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationAt: key
+
+    | index |
+
+    index := self annotationIndexOf: key.
+    index ifNil:[^nil].        
+    ^self annotationAtIndex: index.
+
+    "
+        (Object >> #yourself) annotationAt: #namespace:
+    "
+
+    "Created: / 19-05-2010 / 16:16:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 02-07-2010 / 22:35:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotations
+    "Returns annotations"
+
+    annotations ifNil:[^#()].
+    "iterate over annotation array to 
+     trigger lazy-loading"
+    self annotationsDo:[:ignored].
+    ^ annotations
+
+    "Modified: / 11-07-2010 / 19:25:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotations: anObject
+    "set the annotations"
+
+    self setAnnotations: anObject.
+"/    "iterate over annotations just to invoke
+"/     annotationAtIndex: which lazyliyinitialize annotations
+"/     and send #annotatesMethod:"
+"/    self annotationsDo:[:annotation|]
+
+    "Created: / 02-07-2010 / 22:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationsAt: key
+
+    ^OrderedCollection streamContents:
+        [:annotStream|
+        self annotationsAt: key do:
+            [:annot|annotStream nextPut: annot]]
+
+    "Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationsAt: key do: block
+
+    | annots |
+    annots := OrderedCollection new: 1.
+    self annotationsDo:
+        [:annot|
+        annot key == key ifTrue:
+            [block value: annot]]
+
+    "Created: / 16-07-2010 / 11:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationsAt: key1 orAt: key2
+
+    ^OrderedCollection streamContents:
+        [:annotStream|
+        self annotationsAt: key1 orAt: key2 do:
+            [:annot|annotStream nextPut: annot]]
+
+    "Created: / 16-07-2010 / 11:41:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationsAt: key1 orAt: key2 do: block
+
+    | annots |
+    annots := OrderedCollection new: 1.
+    self annotationsDo:
+        [:annot|
+        (annot key == key1 or:[annot key == key2]) ifTrue:
+            [block value: annot]]
+
+    "Created: / 16-07-2010 / 11:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationsDo: aBlock
+
+    annotations ifNil:[^nil].
+    1 to: annotations size do:
+        [:i|aBlock value: (self annotationAtIndex: i)].
+
+    "Created: / 02-07-2010 / 22:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2010 / 19:38:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 category
     "return the methods category or nil"
 
@@ -399,6 +518,21 @@
     "Created: 16.1.1997 / 01:25:52 / cg"
 !
 
+lookupObject
+
+    ^lookupObject ifNil:[Lookup builtin].
+
+    "Created: / 28-04-2010 / 18:36:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lookupObject: anObject
+
+    self setLookupObject: anObject.
+
+    "Created: / 28-04-2010 / 18:36:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2010 / 19:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 makeLocalStringSource
     "assure that the methods source code is stored locally as a string
      within the method (as opposed to an external string, which is accessed
@@ -429,6 +563,48 @@
     "Modified: / 28-11-2006 / 12:12:27 / cg"
 !
 
+nameSpace
+
+    "Returns my namespace or nil. If no explicit method namespace
+     is set, my programmming language is used as default namespace
+     (for compatibility reasons, for smalltalk methods nil is returned,
+     which means that the method is not namespaced).
+    "
+
+    | nsA lang |    
+    nsA := self annotationAt: #namespace:.
+    nsA ifNotNil:[^nsA nameSpace].
+
+    ^(lang := self programmingLanguage) isSmalltalk
+        ifTrue:[nil]
+        ifFalse:[lang].
+
+    "
+        (Method >> #nameSpace) nameSpace
+        (Object >> #yourself) nameSpace
+    
+    "
+
+    "Created: / 26-04-2010 / 16:30:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 20-05-2010 / 09:38:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameSpace: aNameSpace
+
+    self annotateWith: (Annotation namespace: aNameSpace name)
+
+    "Created: / 20-05-2010 / 10:05:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 20-05-2010 / 11:30:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameSpaceName
+
+    | ns |
+    ^(ns := self nameSpace)
+        ifNotNil:[ns name]
+        ifNil:['']
+!
+
 originalMethodIfWrapped
     "return the method the receiver is wrapping - none here"
 
@@ -437,6 +613,29 @@
     "Created: / 22-10-2010 / 11:46:07 / cg"
 !
 
+overriddenMethod
+
+    "Answers overridden method or nil."
+
+    Overrides ifNil:[^nil].
+    ^(Overrides includesKey: self)
+        ifTrue:[Overrides at: self]
+
+    "Created: / 17-06-2009 / 19:09:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+overriddenMethod: aMethod
+
+    "Set overridden method to aMethod"
+
+    Overrides ifNil:[Overrides := WeakIdentityDictionary new:10].
+    aMethod ifNotNil:[aMethod makeLocalStringSource].
+    Overrides at: self put: aMethod
+
+    "Created: / 17-06-2009 / 19:09:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 22-08-2009 / 10:47:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
 package
     "return the package-ID of the method (nil is translated to noProject here)"
 
@@ -486,6 +685,14 @@
     "Modified: / 23-11-2006 / 17:01:02 / cg"
 !
 
+setAnnotations: anObject
+    "set the annotations (low level - use do not use)"
+
+    annotations :=  anObject
+
+    "Created: / 20-05-2010 / 11:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 setCategory:aStringOrSymbol
     "set the methods category (without change notification)"
 
@@ -1593,6 +1800,52 @@
 
 !Method methodsFor:'private'!
 
+annotationAtIndex: index
+
+    "return annotation at given index.
+     any raw annotation array is lazily
+     initialized"
+
+    | annotation args |
+    annotations ifNil:[^nil].
+    annotation := annotations at: index.
+    annotation isArray ifTrue:[        
+        args := annotation size == 2 
+                    ifTrue:[annotation second] 
+                    ifFalse:[#()].
+        args isArray ifFalse:[args := Array with: args].
+        annotation := Annotation 
+                        key: annotation first 
+                        arguments: args.
+        annotation isUnknown ifFalse:[
+            annotations at: index put: annotation.
+"/            annotation annotatesMethod: self
+        ].
+    ].
+    ^annotation
+
+    "Created: / 02-07-2010 / 22:30:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2010 / 19:39:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+annotationIndexOf: key
+
+    "Returns index of annotation with given key
+     or nil if there is no such annotation"
+
+    annotations ifNil:[^nil].
+    
+    annotations keysAndValuesDo:
+        [:index :annotationOrArray|
+        annotationOrArray isArray 
+            ifTrue: [annotationOrArray first == key ifTrue:[^index]]
+            ifFalse:[annotationOrArray key   == key ifTrue:[^index]]].
+    ^nil.
+
+    "Created: / 19-05-2010 / 16:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2010 / 19:23:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 cacheSourceStream:aStream
     "remember a (raw) source stream for later use"
 
@@ -1610,6 +1863,21 @@
     ].
 !
 
+getAnnotations
+
+    ^annotations
+
+    "Created: / 10-07-2010 / 21:55:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2010 / 19:30:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getLookupObject
+
+    ^lookupObject
+
+    "Created: / 10-07-2010 / 21:55:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 localSourceStream
     "try to open a stream from a local source file,
      searching in standard places."
@@ -1817,6 +2085,15 @@
     "Modified: / 26-11-2006 / 22:33:38 / cg"
 !
 
+setLookupObject: lookup
+    "set the lookupObject (low level - use lookupObject:)"
+
+    lookupObject := lookup.
+    ObjectMemory flushCaches.
+
+    "Created: / 11-07-2010 / 19:31:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 sourceChunkFromStream:aStream
     PositionError handle:[:ex |
         ^ nil
@@ -1997,6 +2274,25 @@
     "
 !
 
+hasAnnotation
+
+    "Return true iff method has any annotation"
+
+    ^annotations notNil
+
+    "Created: / 11-07-2010 / 19:27:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasAnnotation: key
+
+    "Return true iff method is annotated with
+     given key"
+
+    ^(self annotationIndexOf: key) notNil
+
+    "Created: / 11-07-2010 / 19:28:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 hasAnyResource:aCollectionOfSymbols
     "return true if the method has a <resource> definition for any symbol in aCollectionOfSymbols"
 
@@ -2198,6 +2494,11 @@
     ^ (res := self resources) notNil and:[res includesKey:#obsolete]
 !
 
+isSynthetic
+
+    ^false
+!
+
 isVersionMethod
     "Return true, if this is a CVS, SVN or other version method.
      Stupid: need to know all of them here; better add a pragma or
@@ -2420,6 +2721,18 @@
     "Created: / 9.11.1998 / 06:15:08 / cg"
 !
 
+overrides: aMethod
+
+    | mth |
+    mth := self overriddenMethod.
+    [ mth notNil ] whileTrue:
+        [mth == aMethod ifTrue:[^true].
+        mth := mth overriddenMethod].
+    ^false
+
+    "Modified: / 18-06-2009 / 12:15:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
 parse:parseSelector return:accessSelector or:valueIfNoSource
     "helper for methodArgNames, methodVarNames etc.
      Get the source, let parser parse it using parseSelector,
@@ -2459,6 +2772,29 @@
     "
 !
 
+parseAnnotations
+
+    "return the methods annotations."
+
+    |src parser|
+
+    src := self source.
+    src isNil ifTrue:[
+        ^ nil "/ actually: dont know
+    ].
+
+    self parserClass isNil ifTrue:[
+        ^ nil
+    ].
+    parser := self parserClass parseMethod: src.
+    (parser isNil or: [parser == #Error]) ifTrue:[
+        ^ nil "/ actually error
+    ].
+    ^ annotations := parser annotations.
+
+    "Created: / 10-07-2010 / 21:16:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 parseResources
     "return the methods resource spec; either nil or a collection of symbols."
 
@@ -2608,10 +2944,17 @@
 resources
     "return the methods resource spec; either nil or a collection of symbols."
 
+    | resources |
     self hasResource ifFalse:[^ nil].
-    ^ self parseResources.
-
-    "Modified: / 01-12-2010 / 13:59:48 / cg"
+    annotations ifNil:[^ self parseResources].
+
+    resources := IdentityDictionary new.
+    self annotationsAt: #resource: orAt: #resource:value: do:
+        [:annot|
+        resources at: annot type put: annot value ? true].
+    ^resources
+
+    "Modified: / 16-07-2010 / 11:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 selector
@@ -3044,12 +3387,12 @@
 
 !Method class methodsFor:'documentation'!
 
-version
-    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.357 2011-06-21 10:08:53 stefan Exp $'
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.358 2011-06-28 18:09:51 vrany Exp $'
 !
 
-version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.357 2011-06-21 10:08:53 stefan Exp $'
+version_SVN
+    ^ ' Id: Method.st 10648 2011-06-23 15:55:10Z vranyj1  '
 ! !
 
 Method initialize!