Commits

Ryan Macnak  committed 8c3f6da

Filling in various functionality of the Behavior heirarchy that existing Newspeak code depends on

  • Participants
  • Parent commits 0c60eea

Comments (0)

Files changed (3)

File BootstrapRuntimeForSqueak.ns3

-Newspeak3
+Newspeak3
+'NewspeakRuntime'
+class BootstrapRuntimeForSqueak packageUsing: namespace = NewspeakObject (
+"Bundles enough module definitions to create a subset of the platform object that can compile NS3.
+
+Copyright (c) 2011 Ryan Macnak.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the ''Software''), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE."|
+	Collections = namespace NSCollections Collections.
+	Kernel = namespace NSKernel Kernel.
+	Mirrors = namespace Mirrors Mirrors4.
+		LowLevelMirrors = namespace Mirrors LowLevelMirrorsForSqueak.
+		AtomicInstaller = namespace Mirrors AtomicInstaller4.
+		SqueakVmMirror = namespace VmMirror SqueakVmMirror.
+		MirrorGroups = namespace Mirrors MirrorGroups.
+	Streams = namespace NSStreams NSStreams.
+	
+	CP = namespace NS2CombinatorialParsing CombinatorialParsing.
+	BCP = namespace NS2CombinatorialParsing BlocklessCombinatorialParsing.
+	BlocklessCombinatorialParsing = BCP mixin apply: CP.
+	Newspeak3Grammar = namespace Newspeak3 Newspeak3Grammar.
+	Newspeak3AST = namespace Newspeak3 Newspeak3AST.
+	Newspeak3Parsing = namespace Newspeak3 Newspeak3Parsing.
+	Newspeak3Compilation = namespace Newspeak3 Newspeak3Compilation.
+	
+	Newspeak3CompilerAdaptor = namespace Newspeak3CompilerAdaptor Newspeak3CompilerAdaptor.
+|)
+(
+class Platform usingVMMirror: vmm = (
+"Just enought to get NS3 compiler going"|
+	blackMarket = vmm blackMarket.
+
+	namespace = ooter.
+
+	public collections = Delay computation: [Collections usingPlatform: self].
+	public kernel = Delay computation: [Kernel usingPlatform: self vmMirror: vmm].
+	public mirrors = Delay computation: [Mirrors usingLib: self].
+	public streams = Delay computation: [Streams usingPlatform: self].
+|self resetForNewImageSession)
+('as yet unclassified'
+AtomicInstaller4 = (
+	^namespace AtomicInstaller
+)
+bootstrap = (
+	| time repoDir |
+	Transcript open.
+	repoDir:: (FileDirectory default containingDirectory containingDirectory / 'newspeak').
+	time:: [
+		repoDir fileNames collect: [:ea | (ea endsWith: '.ns2') | (ea endsWith: '.ns3') ifTrue: [
+			| src klass |
+			Transcript cr; show: ea.
+			klass:: LanguageFileReader new compileFile: (repoDir fullNameFor: ea).
+			(Smalltalk at: #PackageInfo) named: (klass basicCategory findTokens: '-') first. 
+			Transcript show: '...done'.
+		]].
+	] timeToRun.
+
+	('***Overall in ', (time/1000/60) floor printString , ' minutes') out.
+)
+doesNotUnderstand: aMsg = (
+	"An interim measure so that NsPlatform can be used instead of Platform"
+	#BOGUS yourself.
+	^blackMarket perform: aMsg selector withArguments: aMsg arguments
+)
+resetForNewImageSession = (
+	
+))'as yet unclassified'
+ooter = (
+	^self
+)
+using: vmm <VMMirror> ^<Platform>= (
+	^Platform usingVMMirror: vmm
+))
 allSubclassesDoGently: block = (
 	self allSubclassesDo: block
 )
+canUnderstand: selector = (
+	"Answer whether the receiver can respond to the message whose selector 
+	is the argument. The selector can be in the method dictionary of the 
+	receiver's class or any of its superclasses."
+
+	(self includesSelector: selector) ifTrue: [^true].
+	superclass == nil ifTrue: [^false].
+	^superclass canUnderstand: selector
+)
+includesBehavior: aClass = (
+	^self == aClass or:[self inheritsFrom: aClass]
+)
 includesSelector: sel <Symbol> ^<Boolean> = (
 	"Answer whether the message whose selector is the argument is in the 
 	method dictionary of the receiver's class."
 
 The slot 'subclasses' is a redundant structure.  It is never used during execution, but is used by the development system to simplify or speed certain operations."|
 	subclassesSlot <WeakSet>
-	name <Symbol>
+	nameSlot <Symbol> "N.B.: This must not be called name.  Otherwise its setter will conflict classes such as CLibrary that have #name: as their primary factory."
 	"classPool
 	sharedPools
 	environment -- global namespace crap"
 	
 	subclassesSlot add: subclass.
 )
+basicCategory = (
+	^mixin category
+)
 category = (
 	^mixin category
 )
+category: newCategory = (
+	#BOGUS.
+	#WARN.
+)
 isMeta = (
 	^false
 )
 mixin = (
 	^self mixinSlot
 )
+mixinApply: superklass = (
+	| application |
+	application:: self mixin apply: superklass.
+	"application instVarAt:  5 put: (self instVarAt: 5).
+	application class instVarAt:  5 put: (self class instVarAt: 5)."
+	application setEnclosingObjectSlot: self enclosingObjectSlot.
+	^application
+)
+name = (
+	^self nameSlot
+)
 setEnclosingObjectSlot: e = (
 	enclosingObjectSlot: e.
 	self class setEnclosingObjectSlot: e.
 )
 setName: n = (
-	name: n
+	self nameSlot: n
 )
 subclasses= (
 	^subclassesSlot ifNil: [{}]
 		ifFalse: [vars:: superclass allInstVarNames , self instVarNames].
 	^vars
 )
+instVarIndexFor: instVarName = (
+	"Answer the index of the named instance variable."
+
+	| index |
+	index:: mixin instVarNames == nil
+		ifTrue: [0]
+		ifFalse: [mixin instVarNames indexOf: instVarName].
+	index == 0 ifTrue: 
+		[^superclass == nil 
+			ifTrue: [0]
+			ifFalse: [superclass instVarIndexFor: instVarName]].
+	^superclass == nil 	
+		ifTrue: [index]
+		ifFalse: [index + superclass instSize]
+)
 instVarNames = (
 	^mixin == nil
 		ifTrue: [{} "Top"] 
 definingClass = (
 	^self
 )
+enclosingClass = (
+	#BOGUS. "Used by syntax highlighter, at least"
+	^self enclosingMixin
+)
 instVarNames = (
 	^Array new
 )
 definingModule = (
 	^enclosingMixin isNil ifTrue: [self] ifFalse: [enclosingMixin definingModule]
 )
+enclosingClass = (
+	#BOGUS. "Used by syntax highlighter, at least"
+	^self enclosingMixin
+)
 format: nInstVars <Integer> variable: isVar <Boolean> words: isWords <Boolean> pointers: isPointers <Boolean> weak: isWeak <Boolean> ^ <Integer> = (
 	"This method was derived from the same method in ClassBuilder, and
 	somwewhat cleaned up

File Mirrors4.ns3

 
 Error = platform Exceptions Error.
 Metaclass = platform Metaclass.
-zSystemMetadata = platform NewsqueakMixins SystemMetadata.
+SystemMetadata = platform NewsqueakMixins SystemMetadata.
 Language = platform NsMultilanguage Language.
 SystemChangeNotifier = platform SystemChangeNotifier.