Helios-Environments.st 4.1 KB

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