From 1c61e8ca080b1556270e4599b084ee78a8a2eead Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio Date: Thu, 22 Sep 2011 19:59:34 +0200 Subject: add unused namespace --- kernel/AbstNamespc.st | 38 +++++++++++++++++++++++++++++ kernel/Makefile.frag | 2 +- kernel/Namespace.st | 2 +- kernel/ObjMemory.st | 3 +- kernel/RootNamespc.st | 9 ++++-- kernel/UnusedNamespace.st | 42 ++++++++++++++++++++++++++++++++ kernel/VarBinding.st | 8 ++++++ libgst/dict.c | 5 ++++ libgst/dict.h | 1 + libgst/files.c | 1 + packages.xml | 1 + tests/Makefile.am | 2 +- tests/testsuite.at | 1 + tests/unusedNamespace.ok | 6 ++++ tests/unusedNamespace.st | 58 +++++++++++++++++++++++++++++++++++++++++++++ 15 files changed, 172 insertions(+), 7 deletions(-) create mode 100644 kernel/UnusedNamespace.st create mode 100644 tests/unusedNamespace.ok create mode 100644 tests/unusedNamespace.st diff --git a/kernel/AbstNamespc.st b/kernel/AbstNamespc.st index 9b1fd7b..daa5ad3 100644 --- a/kernel/AbstNamespc.st +++ b/kernel/AbstNamespc.st @@ -510,5 +510,43 @@ an instance of me; it is called their `environment''. '> ^false ] + + bindingFor: aSymbol [ + + + ^ self bindingFor: aSymbol ifAbsent: [ SystemExceptions.NotFound signalOn: aSymbol what: 'key' ] + ] + + bindingFor: aSymbol ifAbsent: aBlock [ + + + | index | + index := self findIndexOrNil: aSymbol. + index isNil ifTrue: [ ^ aBlock value ]. + ^ self primAt: index. + ] + + remove: anAssociation ifAbsent: aBlock [ + + + | assoc | + assoc := super remove: anAssociation ifAbsent: aBlock. + (KernelInitialized and: [ assoc isUsed and: [ self ~= Undeclared ] ]) ifTrue: [ UnusedGlobals add: assoc ]. + ^ assoc + ] + + removeKey: key ifAbsent: aBlock [ + + + | index assoc | + index := self findIndexOrNil: key. + index isNil ifTrue: [ ^ aBlock value ]. + assoc := self primAt: index. + self primAt: index put: nil. + self decrementTally. + self rehashObjectsAfter: index. + (KernelInitialized and: [ assoc isUsed and: [ self ~= Undeclared ] ]) ifTrue: [ UnusedGlobals add: assoc ]. + ^ assoc value + ] ] diff --git a/kernel/Makefile.frag b/kernel/Makefile.frag index 03e848d..e0d2795 100644 --- a/kernel/Makefile.frag +++ b/kernel/Makefile.frag @@ -1,3 +1,3 @@ $(srcdir)/kernel/stamp-classes: \ -kernel/Array.st kernel/CompildMeth.st kernel/LookupTable.st kernel/RunArray.st kernel/Iterable.st kernel/ArrayColl.st kernel/CompiledBlk.st kernel/Magnitude.st kernel/Semaphore.st kernel/DeferBinding.st kernel/Association.st kernel/HomedAssoc.st kernel/ContextPart.st kernel/MappedColl.st kernel/SeqCollect.st kernel/Autoload.st kernel/DLD.st kernel/Memory.st kernel/Set.st kernel/Bag.st kernel/Date.st kernel/Message.st kernel/SharedQueue.st kernel/Behavior.st kernel/Delay.st kernel/Metaclass.st kernel/SmallInt.st kernel/BlkClosure.st kernel/Continuation.st kernel/Generator.st kernel/Dictionary.st kernel/MethodDict.st kernel/SortCollect.st kernel/BlkContext.st kernel/DirMessage.st kernel/MethodInfo.st kernel/Stream.st kernel/Boolean.st kernel/Directory.st kernel/MthContext.st kernel/String.st kernel/UniString.st kernel/ExcHandling.st kernel/Namespace.st kernel/SymLink.st kernel/VFS.st kernel/VFSZip.st kernel/Builtins.st kernel/False.st kernel/Number.st kernel/Symbol.st kernel/ByteArray.st kernel/FilePath.st kernel/File.st kernel/SysDict.st kernel/ScaledDec.st kernel/FileSegment.st kernel/Object.st kernel/Time.st kernel/FileStream.st kernel/Security.st kernel/OrderColl.st kernel/CCallable.st kernel/CCallback.st kernel/CFuncs.st kernel/Float.st kernel/PkgLoader.st kernel/Transcript.st kernel/CObject.st kernel/Fraction.st kernel/Point.st kernel/True.st kernel/CStruct.st kernel/IdentDict.st kernel/PosStream.st kernel/UndefObject.st kernel/CType.st kernel/IdentitySet.st kernel/ProcSched.st kernel/ProcEnv.st kernel/ValueAdapt.st kernel/CharArray.st kernel/Integer.st kernel/Process.st kernel/CallinProcess.st kernel/WeakObjects.st kernel/Character.st kernel/UniChar.st kernel/Interval.st kernel/RWStream.st kernel/OtherArrays.st kernel/Class.st kernel/LargeInt.st kernel/Random.st kernel/WriteStream.st kernel/ClassDesc.st kernel/Link.st kernel/ReadStream.st kernel/ObjMemory.st kernel/Collection.st kernel/LinkedList.st kernel/Rectangle.st kernel/AnsiDates.st kernel/CompildCode.st kernel/LookupKey.st kernel/BindingDict.st kernel/AbstNamespc.st kernel/RootNamespc.st kernel/SysExcept.st kernel/DynVariable.st kernel/HashedColl.st kernel/FileDescr.st kernel/FloatD.st kernel/FloatE.st kernel/FloatQ.st kernel/URL.st kernel/VarBinding.st kernel/RecursionLock.st kernel/Getopt.st kernel/Regex.st kernel/StreamOps.st +kernel/Array.st kernel/CompildMeth.st kernel/LookupTable.st kernel/RunArray.st kernel/Iterable.st kernel/ArrayColl.st kernel/CompiledBlk.st kernel/Magnitude.st kernel/Semaphore.st kernel/DeferBinding.st kernel/Association.st kernel/HomedAssoc.st kernel/ContextPart.st kernel/MappedColl.st kernel/SeqCollect.st kernel/Autoload.st kernel/DLD.st kernel/Memory.st kernel/Set.st kernel/Bag.st kernel/Date.st kernel/Message.st kernel/SharedQueue.st kernel/Behavior.st kernel/Delay.st kernel/Metaclass.st kernel/SmallInt.st kernel/BlkClosure.st kernel/Continuation.st kernel/Generator.st kernel/Dictionary.st kernel/MethodDict.st kernel/SortCollect.st kernel/BlkContext.st kernel/DirMessage.st kernel/MethodInfo.st kernel/Stream.st kernel/Boolean.st kernel/Directory.st kernel/MthContext.st kernel/String.st kernel/UniString.st kernel/ExcHandling.st kernel/Namespace.st kernel/SymLink.st kernel/VFS.st kernel/VFSZip.st kernel/Builtins.st kernel/False.st kernel/Number.st kernel/Symbol.st kernel/ByteArray.st kernel/FilePath.st kernel/File.st kernel/SysDict.st kernel/ScaledDec.st kernel/FileSegment.st kernel/Object.st kernel/Time.st kernel/FileStream.st kernel/Security.st kernel/OrderColl.st kernel/CCallable.st kernel/CCallback.st kernel/CFuncs.st kernel/Float.st kernel/PkgLoader.st kernel/Transcript.st kernel/CObject.st kernel/Fraction.st kernel/Point.st kernel/True.st kernel/CStruct.st kernel/IdentDict.st kernel/PosStream.st kernel/UndefObject.st kernel/CType.st kernel/IdentitySet.st kernel/ProcSched.st kernel/ProcEnv.st kernel/ValueAdapt.st kernel/CharArray.st kernel/Integer.st kernel/Process.st kernel/CallinProcess.st kernel/WeakObjects.st kernel/Character.st kernel/UniChar.st kernel/Interval.st kernel/RWStream.st kernel/OtherArrays.st kernel/Class.st kernel/LargeInt.st kernel/Random.st kernel/WriteStream.st kernel/ClassDesc.st kernel/Link.st kernel/ReadStream.st kernel/ObjMemory.st kernel/Collection.st kernel/LinkedList.st kernel/Rectangle.st kernel/AnsiDates.st kernel/CompildCode.st kernel/LookupKey.st kernel/BindingDict.st kernel/AbstNamespc.st kernel/RootNamespc.st kernel/UnusedNamespace.st kernel/SysExcept.st kernel/DynVariable.st kernel/HashedColl.st kernel/FileDescr.st kernel/FloatD.st kernel/FloatE.st kernel/FloatQ.st kernel/URL.st kernel/VarBinding.st kernel/RecursionLock.st kernel/Getopt.st kernel/Regex.st kernel/StreamOps.st touch $(srcdir)/kernel/stamp-classes diff --git a/kernel/Namespace.st b/kernel/Namespace.st index c99e658..ccdafe8 100644 --- a/kernel/Namespace.st +++ b/kernel/Namespace.st @@ -46,7 +46,7 @@ AbstractNamespace subclass: Namespace [ self allInstancesDo: - [:each | + [:each | each superspace isNil ifTrue: [each setSuperspace: Smalltalk]. each superspace subspaces add: each] ] diff --git a/kernel/ObjMemory.st b/kernel/ObjMemory.st index fc08834..ce7c902 100644 --- a/kernel/ObjMemory.st +++ b/kernel/ObjMemory.st @@ -91,6 +91,7 @@ state.'> Time initialize. FileDescriptor initialize. Namespace initialize. + UnusedNamespace initialize. Processor initialize. SystemDictionary initialize. self changed: #returnFromSnapshot @@ -646,6 +647,6 @@ state.'> Eval [ - ObjectMemory initialize + ObjectMemory initialize. ] diff --git a/kernel/RootNamespc.st b/kernel/RootNamespc.st index 0f31ccf..2460c83 100644 --- a/kernel/RootNamespc.st +++ b/kernel/RootNamespc.st @@ -43,9 +43,12 @@ an instance of me; it is called their `environment''. '> "Create a new root namespace with the given name, and add to Smalltalk a key that references it." - - ^Smalltalk at: spaceName asGlobalKey - put: ((super new: 24) setSuperspace: nil) + + + ^ Smalltalk at: spaceName asGlobalKey + put: ((super new: 24) + name: spaceName asSymbol; + yourself) ] inheritedKeys [ diff --git a/kernel/UnusedNamespace.st b/kernel/UnusedNamespace.st new file mode 100644 index 0000000..cdc0377 --- /dev/null +++ b/kernel/UnusedNamespace.st @@ -0,0 +1,42 @@ +RootNamespace subclass: UnusedNamespace [ + + + + UnusedNamespace class >> initialize [ + + + self new: #UnusedGlobals + ] + + unusedBindings [ + + + | set | + set := Set new. + self primDo: [ :pos :each | + each isUsed ifFalse: [ set add: each ] ]. + ^ set + ] + + removeUnusedBindings [ + + + | set | + set := Set new. + self primDo: [ :pos :each | + each isUsed ifFalse: [ + set add: each. + self primAt: pos put: nil ] ]. + ^ set + ] + + primDo: aTwoArgsBlock [ + + + | assoc | + 1 to: self basicSize do: [ :i | + assoc := self primAt: i. + assoc isNil ifFalse: [ aTwoArgsBlock value: i value: assoc ] ] + ] +] + diff --git a/kernel/VarBinding.st b/kernel/VarBinding.st index 243ad92..00c9c6f 100644 --- a/kernel/VarBinding.st +++ b/kernel/VarBinding.st @@ -38,6 +38,14 @@ HomedAssociation subclass: VariableBinding [ its value. I print different than a normal Association, and know about my parent namespace, otherwise my behavior is the same.'> + isUsed [ + + + CompiledMethod allInstancesDo: [ :each | + (each literals includes: self) ifTrue: [ ^ true ] ]. + ^ false + ] + isDefined [ "Answer true if this VariableBinding lives outside the Undeclared dictionary" diff --git a/libgst/dict.c b/libgst/dict.c index bfd2515..bb2bc50 100644 --- a/libgst/dict.c +++ b/libgst/dict.c @@ -161,6 +161,7 @@ OOP _gst_string_class = NULL; OOP _gst_sym_link_class = NULL; OOP _gst_symbol_class = NULL; OOP _gst_system_dictionary_class = NULL; +OOP _gst_unused_namespace_class = NULL; OOP _gst_time_class = NULL; OOP _gst_true_class = NULL; OOP _gst_undefined_object_class = NULL; @@ -605,6 +606,10 @@ static const class_definition class_info[] = { GST_ISP_POINTER, false, 0, "SystemDictionary", NULL, NULL, NULL }, + {&_gst_unused_namespace_class, &_gst_root_namespace_class, + GST_ISP_POINTER, false, 0, + "UnusedNamespace", NULL, NULL, NULL }, + {&_gst_stream_class, &_gst_iterable_class, GST_ISP_FIXED, false, 0, "Stream", NULL, NULL, NULL }, diff --git a/libgst/dict.h b/libgst/dict.h index de79926..394065b 100644 --- a/libgst/dict.h +++ b/libgst/dict.h @@ -423,6 +423,7 @@ extern OOP _gst_string_class ATTRIBUTE_HIDDEN; extern OOP _gst_sym_link_class ATTRIBUTE_HIDDEN; extern OOP _gst_symbol_class ATTRIBUTE_HIDDEN; extern OOP _gst_system_dictionary_class ATTRIBUTE_HIDDEN; +extern OOP _gst_unused_namespace_class ATTRIBUTE_HIDDEN; extern OOP _gst_time_class ATTRIBUTE_HIDDEN; extern OOP _gst_true_class ATTRIBUTE_HIDDEN; extern OOP _gst_undefined_object_class ATTRIBUTE_HIDDEN; diff --git a/libgst/files.c b/libgst/files.c index 2ec0fe8..40a2508 100644 --- a/libgst/files.c +++ b/libgst/files.c @@ -240,6 +240,7 @@ static const char standard_files[] = { "SymLink.st\0" "Security.st\0" "WeakObjects.st\0" + "UnusedNamespace.st\0" "ObjMemory.st\0" /* More core classes */ diff --git a/packages.xml b/packages.xml index 2fbcaa3..249e7cc 100644 --- a/packages.xml +++ b/packages.xml @@ -193,6 +193,7 @@ BindingDict.st AbstNamespc.st RootNamespc.st + UnusedNamespace.st SysExcept.st DynVariable.st HashedColl.st diff --git a/tests/Makefile.am b/tests/Makefile.am index f227386..2ede5aa 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -18,7 +18,7 @@ objinst.st processes.ok processes.st prodcons.ok prodcons.st quit.ok \ quit.st random-bench.ok random-bench.st untrusted.ok untrusted.st sets.ok \ sets.st sieve.ok sieve.st strcat.ok strcat.st strings.ok strings.st \ pools.ok pools.st Ansi.st AnsiDB.st AnsiInit.st AnsiLoad.st AnsiRun.st \ -stcompiler.st stcompiler.ok shape.st shape.ok +stcompiler.st stcompiler.ok shape.st shape.ok unusedNamespace.st unusedNamespace.ok CLEANFILES = gst.im DISTCLEANFILES = atconfig diff --git a/tests/testsuite.at b/tests/testsuite.at index 4be63b6..4e026f1 100644 --- a/tests/testsuite.at +++ b/tests/testsuite.at @@ -51,6 +51,7 @@ AT_DIFF_TEST([getopt.st]) AT_DIFF_TEST([quit.st]) AT_DIFF_TEST([pools.st]) AT_DIFF_TEST([shape.st]) +AT_DIFF_TEST([unusedNamespace.st]) AT_BANNER([Other simple tests.]) AT_DIFF_TEST([ackermann.st]) diff --git a/tests/unusedNamespace.ok b/tests/unusedNamespace.ok new file mode 100644 index 0000000..f2ed781 --- /dev/null +++ b/tests/unusedNamespace.ok @@ -0,0 +1,6 @@ + +Execution begins... +returned value is Bar + +Execution begins... +returned value is UnusedNamespace diff --git a/tests/unusedNamespace.st b/tests/unusedNamespace.st new file mode 100644 index 0000000..11a8a9d --- /dev/null +++ b/tests/unusedNamespace.st @@ -0,0 +1,58 @@ +"====================================================================== +| +| Test UnusedNamespace operations +| +| + ======================================================================" + + +"====================================================================== +| +| Copyright (C) 2011 Free Software Foundation. +| Written by Gwenael Casaccio +| +| This file is part of GNU Smalltalk. +| +| GNU Smalltalk is free software; you can redistribute it and/or modify it +| under the terms of the GNU General Public License as published by the Free +| Software Foundation; either version 2, or (at your option) any later version. +| +| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT +| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +| details. +| +| You should have received a copy of the GNU General Public License along with +| GNU Smalltalk; see the file COPYING. If not, write to the Free Software +| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +| + ======================================================================" + +Eval [ + Object subclass: #Foo. + Object compile: 'foo [ ^ Foo ]'. + Object subclass: #Bar. +] + +UnusedNamespace class extend [ + + assert: aBoolean [ + + + aBoolean ifFalse: [ self halt ] + ] + + test [ + + + Smalltalk removeKey: #Foo. + self assert: (UnusedGlobals includesKey: #Foo). + Smalltalk removeKey: #Bar. + self assert: (UnusedGlobals includesKey: #Bar) not. + self assert: UnusedGlobals unusedBindings isEmpty. + ] +] + +Eval [ + UnusedNamespace test +] -- 1.7.4.1