Helios-Environments.st 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209
  1. Smalltalk current createPackage: 'Helios-Environments'!
  2. Object subclass: #HLEnvironment
  3. instanceVariableNames: ''
  4. package: 'Helios-Environments'!
  5. !HLEnvironment commentStamp!
  6. Abstract class defining common behavior for local and remote environments!
  7. !HLEnvironment methodsFor: 'accessing'!
  8. availableClassNames
  9. self subclassResponsibility
  10. !
  11. availableProtocolsFor: aClass
  12. self subclassResponsibility
  13. !
  14. classBuilder
  15. ^ self subclassResponsibility
  16. !
  17. classNamed: aString
  18. self subclassResponsibility
  19. !
  20. packages
  21. ^ self subclassResponsibility
  22. ! !
  23. !HLEnvironment methodsFor: 'actions'!
  24. commitPackage: aPackage
  25. self subclassResponsibility
  26. !
  27. eval: someCode on: aReceiver
  28. ^ self subclassResponsibility
  29. !
  30. moveMethod: aMethod toClass: aClassName
  31. self subclassResponsibility
  32. !
  33. moveMethod: aMethod toProtocol: aProtocol
  34. self subclassResponsibility
  35. !
  36. removeMethod: aMethod
  37. self sublcassResponsibility
  38. ! !
  39. !HLEnvironment methodsFor: 'compiling'!
  40. addInstVarNamed: aString to: aClass
  41. self classBuilder
  42. addSubclassOf: aClass superclass
  43. named: aClass name
  44. instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  45. package: aClass package name
  46. !
  47. compileClassComment: aString for: aClass
  48. aClass comment: aString
  49. !
  50. compileClassDefinition: aString
  51. self eval: aString on: DoIt new
  52. !
  53. compileMethod: sourceCode for: class protocol: protocol
  54. class
  55. compile: sourceCode
  56. category: protocol
  57. ! !
  58. HLEnvironment subclass: #HLLocalEnvironment
  59. instanceVariableNames: ''
  60. package: 'Helios-Environments'!
  61. !HLLocalEnvironment methodsFor: 'accessing'!
  62. availableClassNames
  63. ^ Smalltalk current classes
  64. collect: [ :each | each name ]
  65. !
  66. availableProtocolsFor: aClass
  67. | protocols |
  68. protocols := aClass protocols.
  69. aClass superclass ifNotNil: [ protocols addAll: (self availableProtocolsFor: aClass superclass) ].
  70. ^ protocols asSet asArray
  71. !
  72. classBuilder
  73. ^ ClassBuilder new
  74. !
  75. classNamed: aString
  76. ^ (Smalltalk current at: aString asSymbol)
  77. ifNil: [ self error: 'Invalid class name' ]
  78. !
  79. packages
  80. ^ Smalltalk current packages
  81. ! !
  82. !HLLocalEnvironment methodsFor: 'actions'!
  83. commitPackage: aPackage
  84. aPackage heliosCommit
  85. !
  86. eval: aString on: aReceiver
  87. | compiler |
  88. compiler := Compiler new.
  89. [ compiler parseExpression: aString ] on: Error do: [ :ex |
  90. ^ window alert: ex messageText ].
  91. ^ compiler evaluateExpression: aString on: aReceiver
  92. !
  93. moveMethod: aMethod toClass: aClassName
  94. | destinationClass |
  95. destinationClass := Smalltalk current at: aClassName asSymbol.
  96. destinationClass ifNil: [ self error: 'Invalid class name' ].
  97. destinationClass == aMethod methodClass ifTrue: [ ^ self ].
  98. destinationClass adoptMethod: aMethod.
  99. aMethod methodClass forsakeMethod: aMethod.
  100. !
  101. moveMethod: aMethod toProtocol: aProtocol
  102. aMethod category: aProtocol
  103. !
  104. removeMethod: aMethod
  105. aMethod methodClass forsakeMethod: aMethod
  106. ! !
  107. HLEnvironment subclass: #HLRemoteEnvironment
  108. instanceVariableNames: ''
  109. package: 'Helios-Environments'!
  110. !HLRemoteEnvironment methodsFor: 'accessing'!
  111. packages
  112. "Answer the remote environment's packages"
  113. "to-do"
  114. "Note for future self and friends:
  115. the problem with remote stuff is that the answers shouldn't be expected to be
  116. received in a syncrhonous fashion. Everything network is asyc, so you *are going to deal with callbacks* here"
  117. ! !
  118. !HLRemoteEnvironment methodsFor: 'actions'!
  119. eval: someCode on: aReceiver
  120. "Note for future self and friends:
  121. whatever way this compilation happens on the other side,
  122. it should return a proxy to the remote resulting object"
  123. self notYetImplemented
  124. ! !
  125. Object subclass: #HLRemoteObject
  126. instanceVariableNames: ''
  127. package: 'Helios-Environments'!
  128. !HLRemoteObject commentStamp!
  129. This is a local proxy to a remote object.
  130. Tipically useful for evaluating and inspecting and interacting with instances of a remote VM.!
  131. !HLRemoteObject methodsFor: 'actions'!
  132. doesNotUnderstand: aMessage
  133. "to-do
  134. aham, blah blah
  135. super doesNotUnderstand: aMessage"
  136. !
  137. inspectOn: anInspector
  138. "to-do"
  139. "this is a source of so much fun..."
  140. !
  141. printString
  142. ^ 'this is a remote object'
  143. ! !
  144. !Behavior methodsFor: '*Helios-Environments'!
  145. adoptMethod: aMethod
  146. self
  147. compile: aMethod source
  148. category: aMethod protocol.
  149. !
  150. forsakeMethod: aMethod
  151. self removeCompiledMethod: aMethod
  152. ! !