Helios-Debugger.st 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544
  1. Smalltalk createPackage: 'Helios-Debugger'!
  2. (Smalltalk packageAt: 'Helios-Debugger') imports: {'amber_core/Compiler-Interpreter'}!
  3. Object subclass: #HLContextInspectorDecorator
  4. instanceVariableNames: 'context'
  5. package: 'Helios-Debugger'!
  6. !HLContextInspectorDecorator methodsFor: 'accessing'!
  7. context
  8. ^ context
  9. ! !
  10. !HLContextInspectorDecorator methodsFor: 'evaluating'!
  11. evaluate: aString on: anEvaluator
  12. ^ self context evaluate: aString on: anEvaluator
  13. ! !
  14. !HLContextInspectorDecorator methodsFor: 'initialization'!
  15. initializeFromContext: aContext
  16. context := aContext
  17. ! !
  18. !HLContextInspectorDecorator methodsFor: 'inspecting'!
  19. inspectOn: anInspector
  20. | variables inspectedContext |
  21. variables := Dictionary new.
  22. inspectedContext := self context.
  23. variables addAll: inspectedContext locals.
  24. [ inspectedContext notNil and: [ inspectedContext isBlockContext ] ] whileTrue: [
  25. inspectedContext := inspectedContext outerContext.
  26. inspectedContext ifNotNil: [
  27. variables addAll: inspectedContext locals ] ].
  28. anInspector
  29. setLabel: 'Context';
  30. setVariables: variables
  31. ! !
  32. !HLContextInspectorDecorator class methodsFor: 'instance creation'!
  33. on: aContext
  34. ^ self new
  35. initializeFromContext: aContext;
  36. yourself
  37. ! !
  38. HLFocusableWidget subclass: #HLDebugger
  39. instanceVariableNames: 'model stackListWidget codeWidget inspectorWidget'
  40. package: 'Helios-Debugger'!
  41. !HLDebugger commentStamp!
  42. I am the main widget for the Helios debugger.!
  43. !HLDebugger methodsFor: 'accessing'!
  44. cssClass
  45. ^ super cssClass, ' hl_debugger'
  46. !
  47. model
  48. ^ model ifNil: [ model := HLDebuggerModel new ]
  49. ! !
  50. !HLDebugger methodsFor: 'actions'!
  51. focus
  52. self stackListWidget focus
  53. !
  54. observeModel
  55. self model announcer
  56. on: HLDebuggerContextSelected
  57. send: #onContextSelected:
  58. to: self;
  59. on: HLDebuggerStepped
  60. send: #onDebuggerStepped:
  61. to: self;
  62. on: HLDebuggerProceeded
  63. send: #onDebuggerProceeded
  64. to: self
  65. !
  66. unregister
  67. super unregister.
  68. self inspectorWidget unregister
  69. ! !
  70. !HLDebugger methodsFor: 'initialization'!
  71. initializeFromError: anError
  72. model := HLDebuggerModel on: anError.
  73. self observeModel
  74. ! !
  75. !HLDebugger methodsFor: 'keybindings'!
  76. registerBindingsOn: aBindingGroup
  77. HLToolCommand
  78. registerConcreteClassesOn: aBindingGroup
  79. for: self model
  80. ! !
  81. !HLDebugger methodsFor: 'reactions'!
  82. onContextSelected: anAnnouncement
  83. self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context)
  84. !
  85. onDebuggerProceeded
  86. self removeTab
  87. !
  88. onDebuggerStepped: anAnnouncement
  89. self model atEnd ifTrue: [ self removeTab ].
  90. self inspectorWidget inspect: (HLContextInspectorDecorator on: anAnnouncement context).
  91. self stackListWidget refresh
  92. ! !
  93. !HLDebugger methodsFor: 'rendering'!
  94. renderContentOn: html
  95. self renderHeadOn: html.
  96. html with: (HLContainer with: (HLVerticalSplitter
  97. with: self codeWidget
  98. with: (HLHorizontalSplitter
  99. with: self stackListWidget
  100. with: self inspectorWidget)))
  101. !
  102. renderHeadOn: html
  103. html div
  104. class: 'head';
  105. with: [ html h2 with: self model error messageText ]
  106. ! !
  107. !HLDebugger methodsFor: 'widgets'!
  108. codeWidget
  109. ^ codeWidget ifNil: [ codeWidget := HLDebuggerCodeWidget new
  110. model: (HLDebuggerCodeModel new
  111. debuggerModel: self model;
  112. yourself);
  113. browserModel: self model;
  114. yourself ]
  115. !
  116. inspectorWidget
  117. ^ inspectorWidget ifNil: [
  118. inspectorWidget := HLInspectorWidget new ]
  119. !
  120. stackListWidget
  121. ^ stackListWidget ifNil: [
  122. stackListWidget := (HLStackListWidget on: self model)
  123. next: self codeWidget;
  124. yourself ]
  125. ! !
  126. !HLDebugger class methodsFor: 'accessing'!
  127. tabClass
  128. ^ 'debugger'
  129. !
  130. tabLabel
  131. ^ 'Debugger'
  132. ! !
  133. !HLDebugger class methodsFor: 'instance creation'!
  134. on: anError
  135. ^ self new
  136. initializeFromError: anError;
  137. yourself
  138. ! !
  139. HLCodeModel subclass: #HLDebuggerCodeModel
  140. instanceVariableNames: 'debuggerModel'
  141. package: 'Helios-Debugger'!
  142. !HLDebuggerCodeModel methodsFor: 'accessing'!
  143. debuggerModel
  144. ^ debuggerModel
  145. !
  146. debuggerModel: anObject
  147. debuggerModel := anObject
  148. ! !
  149. !HLDebuggerCodeModel methodsFor: 'actions'!
  150. doIt: aString
  151. ^ [ self debuggerModel evaluate: aString ]
  152. tryCatch: [ :e |
  153. ErrorHandler handleError: e.
  154. nil ]
  155. ! !
  156. HLBrowserCodeWidget subclass: #HLDebuggerCodeWidget
  157. instanceVariableNames: ''
  158. package: 'Helios-Debugger'!
  159. !HLDebuggerCodeWidget methodsFor: 'accessing'!
  160. contents: aString
  161. self clearHighlight.
  162. super contents: aString
  163. !
  164. editorOptions
  165. ^ super editorOptions
  166. at: 'gutters' put: #('CodeMirror-linenumbers' 'stops');
  167. yourself
  168. ! !
  169. !HLDebuggerCodeWidget methodsFor: 'actions'!
  170. addStopAt: anInteger
  171. editor
  172. setGutterMarker: anInteger
  173. gutter: 'stops'
  174. value: '<div class="stop"></div>' asJQuery toArray first
  175. !
  176. clearHighlight
  177. self editor clearGutter: 'stops'
  178. !
  179. highlight
  180. self browserModel nextNode ifNotNil: [ :node |
  181. self highlightNode: node ]
  182. !
  183. highlightNode: aNode
  184. | token |
  185. aNode ifNotNil: [
  186. self
  187. clearHighlight;
  188. addStopAt: aNode positionStart x - 1.
  189. self editor
  190. setSelection: #{ 'line' -> (aNode positionStart x - 1). 'ch' -> (aNode positionStart y - 1) }
  191. to: #{ 'line' -> (aNode positionEnd x - 1). 'ch' -> (aNode positionEnd y) } ]
  192. !
  193. observeBrowserModel
  194. super observeBrowserModel.
  195. self browserModel announcer
  196. on: HLDebuggerContextSelected
  197. send: #onContextSelected
  198. to: self.
  199. self browserModel announcer
  200. on: HLDebuggerStepped
  201. send: #onContextSelected
  202. to: self.
  203. self browserModel announcer
  204. on: HLDebuggerWhere
  205. send: #onContextSelected
  206. to: self
  207. ! !
  208. !HLDebuggerCodeWidget methodsFor: 'reactions'!
  209. onContextSelected
  210. self highlight
  211. ! !
  212. !HLDebuggerCodeWidget methodsFor: 'rendering'!
  213. renderOn: html
  214. super renderOn: html.
  215. self contents: self browserModel selectedMethod source
  216. ! !
  217. HLToolModel subclass: #HLDebuggerModel
  218. instanceVariableNames: 'rootContext debugger error'
  219. package: 'Helios-Debugger'!
  220. !HLDebuggerModel commentStamp!
  221. I am a model for debugging Amber code in Helios.
  222. My instances hold a reference to an `ASTDebugger` instance, itself referencing the current `context`. The context should be the root of the context stack.!
  223. !HLDebuggerModel methodsFor: 'accessing'!
  224. contexts
  225. | contexts context |
  226. contexts := OrderedCollection new.
  227. context := self rootContext.
  228. [ context notNil ] whileTrue: [
  229. contexts add: context.
  230. context := context outerContext ].
  231. ^ contexts
  232. !
  233. currentContext
  234. ^ self debugger context
  235. !
  236. currentContext: aContext
  237. self withChangesDo: [
  238. self selectedMethod: aContext method.
  239. self debugger context: aContext.
  240. self announcer announce: (HLDebuggerContextSelected new
  241. context: aContext;
  242. yourself) ]
  243. !
  244. debugger
  245. ^ debugger ifNil: [ debugger := ASTDebugger new ]
  246. !
  247. error
  248. ^ error
  249. !
  250. nextNode
  251. ^ self debugger node
  252. !
  253. rootContext
  254. ^ rootContext
  255. ! !
  256. !HLDebuggerModel methodsFor: 'actions'!
  257. proceed
  258. self debugger proceed.
  259. self announcer announce: HLDebuggerProceeded new
  260. !
  261. restart
  262. self debugger restart.
  263. self onStep.
  264. self announcer announce: (HLDebuggerStepped new
  265. context: self currentContext;
  266. yourself)
  267. !
  268. stepOver
  269. self debugger stepOver.
  270. self onStep.
  271. self announcer announce: (HLDebuggerStepped new
  272. context: self currentContext;
  273. yourself)
  274. !
  275. where
  276. self announcer announce: HLDebuggerWhere new
  277. ! !
  278. !HLDebuggerModel methodsFor: 'evaluating'!
  279. evaluate: aString
  280. ^ self environment
  281. evaluate: aString
  282. for: self currentContext
  283. ! !
  284. !HLDebuggerModel methodsFor: 'initialization'!
  285. initializeFromError: anError
  286. | errorContext |
  287. error := anError.
  288. errorContext := (AIContext fromMethodContext: error context).
  289. rootContext := error signalerContextFrom: errorContext.
  290. self selectedMethod: rootContext method
  291. ! !
  292. !HLDebuggerModel methodsFor: 'private'!
  293. flushInnerContexts
  294. "When stepping, the inner contexts are not relevent anymore,
  295. and can be flushed"
  296. self currentContext innerContext: nil.
  297. rootContext := self currentContext.
  298. self initializeContexts
  299. ! !
  300. !HLDebuggerModel methodsFor: 'reactions'!
  301. onStep
  302. rootContext := self currentContext.
  303. "Force a refresh of the context list and code widget"
  304. self selectedMethod: self currentContext method.
  305. self announcer announce: (HLDebuggerContextSelected new
  306. context: self currentContext;
  307. yourself)
  308. ! !
  309. !HLDebuggerModel methodsFor: 'testing'!
  310. atEnd
  311. ^ self debugger atEnd
  312. ! !
  313. !HLDebuggerModel class methodsFor: 'instance creation'!
  314. on: anError
  315. ^ self new
  316. initializeFromError: anError;
  317. yourself
  318. ! !
  319. Object subclass: #HLErrorHandler
  320. instanceVariableNames: ''
  321. package: 'Helios-Debugger'!
  322. !HLErrorHandler methodsFor: 'error handling'!
  323. confirmDebugError: anError
  324. HLConfirmationWidget new
  325. confirmationString: anError messageText;
  326. actionBlock: [ self debugError: anError ];
  327. cancelButtonLabel: 'Abandon';
  328. confirmButtonLabel: 'Debug';
  329. show
  330. !
  331. debugError: anError
  332. [
  333. (HLDebugger on: anError) openAsTab
  334. ]
  335. on: Error
  336. do: [ :error | ConsoleErrorHandler new handleError: error ]
  337. !
  338. handleError: anError
  339. self confirmDebugError: anError
  340. !
  341. onErrorHandled
  342. "when an error is handled, we need to make sure that
  343. any progress bar widget gets removed. Because HLProgressBarWidget is asynchronous,
  344. it has to be done here."
  345. HLProgressWidget default
  346. flush;
  347. remove
  348. ! !
  349. HLToolListWidget subclass: #HLStackListWidget
  350. instanceVariableNames: ''
  351. package: 'Helios-Debugger'!
  352. !HLStackListWidget methodsFor: 'accessing'!
  353. items
  354. ^ self model contexts
  355. !
  356. label
  357. ^ 'Call stack'
  358. ! !
  359. !HLStackListWidget methodsFor: 'actions'!
  360. observeModel
  361. super observeModel.
  362. self model announcer
  363. on: HLDebuggerStepped
  364. send: #onDebuggerStepped:
  365. to: self
  366. !
  367. proceed
  368. self model proceed
  369. !
  370. restart
  371. self model restart
  372. !
  373. selectItem: aContext
  374. self model currentContext: aContext.
  375. super selectItem: aContext
  376. !
  377. selectedItem
  378. ^ self model currentContext
  379. !
  380. stepOver
  381. self model stepOver
  382. !
  383. where
  384. self model where
  385. ! !
  386. !HLStackListWidget methodsFor: 'reactions'!
  387. onDebuggerStepped: anAnnouncement
  388. items := nil.
  389. self refresh
  390. ! !
  391. !HLStackListWidget methodsFor: 'rendering'!
  392. renderButtonsOn: html
  393. html div
  394. class: 'debugger_bar';
  395. with: [
  396. html button
  397. class: 'btn btn-default restart';
  398. with: 'Restart';
  399. onClick: [ self restart ].
  400. html button
  401. class: 'btn btn-default where';
  402. with: 'Where';
  403. onClick: [ self where ].
  404. html button
  405. class: 'btn btn-default stepOver';
  406. with: 'Step over';
  407. onClick: [ self stepOver ].
  408. html button
  409. class: 'btn btn-default proceed';
  410. with: 'Proceed';
  411. onClick: [ self proceed ] ]
  412. ! !