1
0

Kernel-Methods.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672
  1. Smalltalk current createPackage: 'Kernel-Methods'!
  2. Object subclass: #BlockClosure
  3. instanceVariableNames: ''
  4. package: 'Kernel-Methods'!
  5. !BlockClosure commentStamp!
  6. I represent a lexical closure.
  7. I am is directly mapped to JavaScript Function.
  8. ## API
  9. 1. Evaluation
  10. My instances get evaluated with the `#value*` methods in the 'evaluating' protocol.
  11. Example: ` [ :x | x + 1 ] value: 3 "Answers 4" `
  12. 2. Control structures
  13. Blocks are used (together with `Boolean`) for control structures (methods in the `controlling` protocol).
  14. Example: `aBlock whileTrue: [ ... ]`
  15. 3. Error handling
  16. I provide the `#on:do:` method for handling exceptions.
  17. Example: ` aBlock on: MessageNotUnderstood do: [ :ex | ... ] `!
  18. !BlockClosure methodsFor: 'accessing'!
  19. compiledSource
  20. <return self.toString()>
  21. !
  22. numArgs
  23. <return self.length>
  24. !
  25. receiver
  26. ^ nil
  27. ! !
  28. !BlockClosure methodsFor: 'controlling'!
  29. whileFalse
  30. "inlined in the Compiler"
  31. self whileFalse: []
  32. !
  33. whileFalse: aBlock
  34. "inlined in the Compiler"
  35. <while(!!self()) {aBlock()}>
  36. !
  37. whileTrue
  38. "inlined in the Compiler"
  39. self whileTrue: []
  40. !
  41. whileTrue: aBlock
  42. "inlined in the Compiler"
  43. <while(self()) {aBlock()}>
  44. ! !
  45. !BlockClosure methodsFor: 'converting'!
  46. asCompiledMethod: aString
  47. <return smalltalk.method({selector:aString, fn:self});>
  48. !
  49. currySelf
  50. "Transforms [ :selfarg :x :y | stcode ] block
  51. which represents JS function (selfarg, x, y, ...) {jscode}
  52. into function (x, y, ...) {jscode} that takes selfarg from 'this'.
  53. IOW, it is usable as JS method and first arg takes the receiver."
  54. <
  55. return function () {
  56. var args = [ this ];
  57. args.push.apply(args, arguments);
  58. return self.apply(null, args);
  59. }
  60. >
  61. ! !
  62. !BlockClosure methodsFor: 'error handling'!
  63. on: anErrorClass do: aBlock
  64. "All exceptions thrown in the Smalltalk stack are cought.
  65. Convert all JS exceptions to JavaScriptException instances."
  66. ^self try: self catch: [ :error | | smalltalkError |
  67. smalltalkError := Smalltalk current asSmalltalkException: error.
  68. (smalltalkError isKindOf: anErrorClass)
  69. ifTrue: [ aBlock value: smalltalkError ]
  70. ifFalse: [ smalltalkError signal ] ]
  71. ! !
  72. !BlockClosure methodsFor: 'evaluating'!
  73. applyTo: anObject arguments: aCollection
  74. <return self.apply(anObject, aCollection)>
  75. !
  76. ensure: aBlock
  77. <try{return self()}finally{aBlock._value()}>
  78. !
  79. new
  80. "Use the receiver as a JS constructor.
  81. *Do not* use this method to instanciate Smalltalk objects!!"
  82. <return new self()>
  83. !
  84. newValue: anObject
  85. "Use the receiver as a JS constructor.
  86. *Do not* use this method to instanciate Smalltalk objects!!"
  87. <return new self(anObject)>
  88. !
  89. newValue: anObject value: anObject2
  90. "Use the receiver as a JS constructor.
  91. *Do not* use this method to instanciate Smalltalk objects!!"
  92. <return new self(anObject, anObject2)>
  93. !
  94. newValue: anObject value: anObject2 value: anObject3
  95. "Use the receiver as a JS constructor.
  96. *Do not* use this method to instanciate Smalltalk objects!!"
  97. <return new self(anObject, anObject2,anObject3)>
  98. !
  99. timeToRun
  100. "Answer the number of milliseconds taken to execute this block."
  101. ^ Date millisecondsToRun: self
  102. !
  103. value
  104. "inlined in the Compiler"
  105. <return self();>
  106. !
  107. value: anArg
  108. "inlined in the Compiler"
  109. <return self(anArg);>
  110. !
  111. value: firstArg value: secondArg
  112. "inlined in the Compiler"
  113. <return self(firstArg, secondArg);>
  114. !
  115. value: firstArg value: secondArg value: thirdArg
  116. "inlined in the Compiler"
  117. <return self(firstArg, secondArg, thirdArg);>
  118. !
  119. valueWithPossibleArguments: aCollection
  120. <return self.apply(null, aCollection);>
  121. ! !
  122. !BlockClosure methodsFor: 'timeout/interval'!
  123. fork
  124. ForkPool default fork: self
  125. !
  126. valueWithInterval: aNumber
  127. <
  128. var interval = setInterval(self, aNumber);
  129. return smalltalk.Timeout._on_(interval);
  130. >
  131. !
  132. valueWithTimeout: aNumber
  133. <
  134. var timeout = setTimeout(self, aNumber);
  135. return smalltalk.Timeout._on_(timeout);
  136. >
  137. ! !
  138. Object subclass: #CompiledMethod
  139. instanceVariableNames: ''
  140. package: 'Kernel-Methods'!
  141. !CompiledMethod commentStamp!
  142. I represent a class method of the system. I hold the source and compiled code of a class method.
  143. ## API
  144. My instances can be accessed using `Behavior >> #methodAt:`
  145. Object methodAt: 'asString'
  146. Source code access:
  147. (String methodAt: 'lines') source
  148. Referenced classes:
  149. (String methodAt: 'lines') referencedClasses
  150. Messages sent from an instance:
  151. (String methodAt: 'lines') messageSends!
  152. !CompiledMethod methodsFor: 'accessing'!
  153. arguments
  154. <return self.args || []>
  155. !
  156. category
  157. ^(self basicAt: 'category') ifNil: [ self defaultCategory ]
  158. !
  159. category: aString
  160. | oldProtocol |
  161. oldProtocol := self protocol.
  162. self basicAt: 'category' put: aString.
  163. SystemAnnouncer current announce: (MethodMoved new
  164. method: self;
  165. oldProtocol: oldProtocol;
  166. yourself).
  167. self methodClass ifNotNil: [
  168. self methodClass organization addElement: aString.
  169. (self methodClass methods
  170. select: [ :each | each protocol = oldProtocol ])
  171. ifEmpty: [ self methodClass organization removeElement: oldProtocol ] ]
  172. !
  173. fn
  174. ^self basicAt: 'fn'
  175. !
  176. fn: aBlock
  177. self basicAt: 'fn' put: aBlock
  178. !
  179. messageSends
  180. ^self basicAt: 'messageSends'
  181. !
  182. methodClass
  183. ^self basicAt: 'methodClass'
  184. !
  185. protocol
  186. ^ self category
  187. !
  188. protocol: aString
  189. self category: aString
  190. !
  191. referencedClasses
  192. ^self basicAt: 'referencedClasses'
  193. !
  194. selector
  195. ^self basicAt: 'selector'
  196. !
  197. selector: aString
  198. self basicAt: 'selector' put: aString
  199. !
  200. source
  201. ^(self basicAt: 'source') ifNil: ['']
  202. !
  203. source: aString
  204. self basicAt: 'source' put: aString
  205. ! !
  206. !CompiledMethod methodsFor: 'defaults'!
  207. defaultCategory
  208. ^ 'as yet unclassified'
  209. ! !
  210. !CompiledMethod methodsFor: 'testing'!
  211. isCompiledMethod
  212. ^ true
  213. !
  214. isOverridden
  215. | selector |
  216. selector := self selector.
  217. self methodClass allSubclassesDo: [ :each |
  218. (each includesSelector: selector)
  219. ifTrue: [ ^ true ] ].
  220. ^ false
  221. !
  222. isOverride
  223. | superclass |
  224. superclass := self methodClass superclass.
  225. superclass ifNil: [ ^ false ].
  226. ^ (self methodClass superclass lookupSelector: self selector) notNil
  227. ! !
  228. Object subclass: #ForkPool
  229. instanceVariableNames: 'poolSize maxPoolSize queue worker'
  230. package: 'Kernel-Methods'!
  231. !ForkPool commentStamp!
  232. I am responsible for handling forked blocks.
  233. The pool size sets the maximum concurrent forked blocks.
  234. ## API
  235. The default instance is accessed with `#default`.
  236. The maximum concurrent forked blocks can be set with `#maxPoolSize:`.
  237. Forking is done via `BlockClosure >> #fork`!
  238. !ForkPool methodsFor: 'accessing'!
  239. maxPoolSize
  240. ^ maxPoolSize ifNil: [ self defaultMaxPoolSize ]
  241. !
  242. maxPoolSize: anInteger
  243. maxPoolSize := anInteger
  244. ! !
  245. !ForkPool methodsFor: 'actions'!
  246. fork: aBlock
  247. poolSize < self maxPoolSize ifTrue: [ self addWorker ].
  248. queue nextPut: aBlock
  249. ! !
  250. !ForkPool methodsFor: 'defaults'!
  251. defaultMaxPoolSize
  252. ^ self class defaultMaxPoolSize
  253. ! !
  254. !ForkPool methodsFor: 'initialization'!
  255. initialize
  256. super initialize.
  257. poolSize := 0.
  258. queue := Queue new.
  259. worker := self makeWorker
  260. !
  261. makeWorker
  262. | sentinel |
  263. sentinel := Object new.
  264. ^[ | block |
  265. poolSize := poolSize - 1.
  266. block := queue nextIfAbsent: [ sentinel ].
  267. block == sentinel ifFalse: [
  268. [ block value ] ensure: [ self addWorker ]]]
  269. ! !
  270. !ForkPool methodsFor: 'private'!
  271. addWorker
  272. worker valueWithTimeout: 0.
  273. poolSize := poolSize + 1
  274. ! !
  275. ForkPool class instanceVariableNames: 'default'!
  276. !ForkPool class methodsFor: 'accessing'!
  277. default
  278. ^default ifNil: [ default := self new ]
  279. !
  280. defaultMaxPoolSize
  281. ^100
  282. !
  283. resetDefault
  284. default := nil
  285. ! !
  286. Object subclass: #Message
  287. instanceVariableNames: 'selector arguments'
  288. package: 'Kernel-Methods'!
  289. !Message commentStamp!
  290. In general, the system does not use instances of me for efficiency reasons.
  291. However, when a message is not understood by its receiver, the interpreter will make up an instance of it in order to capture the information involved in an actual message transmission.
  292. This instance is sent it as an argument with the message `#doesNotUnderstand:` to the receiver.
  293. See boot.js, `messageNotUnderstood` and its counterpart `Object >> #doesNotUnderstand:`
  294. ## API
  295. Besides accessing methods, `#sendTo:` provides a convenient way to send a message to an object.!
  296. !Message methodsFor: 'accessing'!
  297. arguments
  298. ^arguments
  299. !
  300. arguments: anArray
  301. arguments := anArray
  302. !
  303. selector
  304. ^selector
  305. !
  306. selector: aString
  307. selector := aString
  308. ! !
  309. !Message methodsFor: 'actions'!
  310. sendTo: anObject
  311. ^ anObject perform: self selector withArguments: self arguments
  312. ! !
  313. !Message methodsFor: 'printing'!
  314. printOn: aStream
  315. super printOn: aStream.
  316. aStream
  317. nextPutAll: '(';
  318. nextPutAll: self selector;
  319. nextPutAll: ')'
  320. ! !
  321. !Message class methodsFor: 'instance creation'!
  322. selector: aString arguments: anArray
  323. ^self new
  324. selector: aString;
  325. arguments: anArray;
  326. yourself
  327. ! !
  328. Object subclass: #MessageSend
  329. instanceVariableNames: 'receiver message'
  330. package: 'Kernel-Methods'!
  331. !MessageSend commentStamp!
  332. I encapsulate message sends to objects. Arguments can be either predefined or supplied when the message send is performed.
  333. ## API
  334. Use `#value` to perform a message send with its predefined arguments and `#value:*` if additonal arguments have to supplied.!
  335. !MessageSend methodsFor: 'accessing'!
  336. arguments
  337. ^ message arguments
  338. !
  339. arguments: aCollection
  340. message arguments: aCollection
  341. !
  342. receiver
  343. ^ receiver
  344. !
  345. receiver: anObject
  346. receiver := anObject
  347. !
  348. selector
  349. ^ message selector
  350. !
  351. selector: aString
  352. message selector: aString
  353. ! !
  354. !MessageSend methodsFor: 'evaluating'!
  355. value
  356. ^ message sendTo: self receiver
  357. !
  358. value: anObject
  359. ^ message
  360. arguments: { anObject };
  361. sendTo: self receiver
  362. !
  363. value: firstArgument value: secondArgument
  364. ^ message
  365. arguments: { firstArgument. secondArgument };
  366. sendTo: self receiver
  367. !
  368. value: firstArgument value: secondArgument value: thirdArgument
  369. ^ message
  370. arguments: { firstArgument. secondArgument. thirdArgument };
  371. sendTo: self receiver
  372. !
  373. valueWithPossibleArguments: aCollection
  374. self arguments: aCollection.
  375. ^ self value
  376. ! !
  377. !MessageSend methodsFor: 'initialization'!
  378. initialize
  379. super initialize.
  380. message := Message new
  381. ! !
  382. !MessageSend methodsFor: 'printing'!
  383. printOn: aStream
  384. super printOn: aStream.
  385. aStream
  386. nextPutAll: '(';
  387. nextPutAll: self receiver;
  388. nextPutAll: ' >> ';
  389. nextPutAll: self selector;
  390. nextPutAll: ')'
  391. ! !
  392. Object subclass: #MethodContext
  393. instanceVariableNames: ''
  394. package: 'Kernel-Methods'!
  395. !MethodContext commentStamp!
  396. I hold all the dynamic state associated with the execution of either a method activation resulting from a message send. I am used to build the call stack while debugging.
  397. My instances are JavaScript `SmalltalkMethodContext` objects defined in `boot.js`.!
  398. !MethodContext methodsFor: 'accessing'!
  399. home
  400. <return self.methodContext || self.homeContext>
  401. !
  402. locals
  403. <return self.locals>
  404. !
  405. method
  406. ^self methodContext receiver class lookupSelector: self methodContext selector
  407. !
  408. methodContext
  409. self isBlockContext ifFalse: [ ^ self ].
  410. ^ self home
  411. !
  412. outerContext
  413. <return self.homeContext>
  414. !
  415. pc
  416. <return self.pc>
  417. !
  418. receiver
  419. <return self.receiver>
  420. !
  421. selector
  422. <
  423. if(self.selector) {
  424. return smalltalk.convertSelector(self.selector);
  425. } else {
  426. return nil;
  427. }
  428. >
  429. !
  430. temps
  431. self deprecatedAPI.
  432. ^ self locals
  433. ! !
  434. !MethodContext methodsFor: 'converting'!
  435. asString
  436. ^self isBlockContext
  437. ifTrue: [ 'a block (in ', self methodContext receiver class printString, ')' ]
  438. ifFalse: [ self receiver class printString, ' >> ', self selector ]
  439. ! !
  440. !MethodContext methodsFor: 'printing'!
  441. printOn: aStream
  442. super printOn: aStream.
  443. aStream
  444. nextPutAll: '(';
  445. nextPutAll: self asString;
  446. nextPutAll: ')'
  447. ! !
  448. !MethodContext methodsFor: 'testing'!
  449. isBlockContext
  450. "Block context do not have selectors."
  451. ^ self selector isNil
  452. ! !
  453. Object subclass: #NativeFunction
  454. instanceVariableNames: ''
  455. package: 'Kernel-Methods'!
  456. !NativeFunction commentStamp!
  457. I am a wrapper around native functions, such as `WebSocket`.
  458. For 'normal' functions (whose constructor is the JavaScript `Function` object), use `BlockClosure`.
  459. ## API
  460. See the class-side `instance creation` methods for instance creation.
  461. Created instances will most probably be instance of `JSObjectProxy`.
  462. ## Usage example:
  463. | ws |
  464. ws := NativeFunction constructor: 'WebSocket' value: 'ws://localhost'.
  465. ws at: 'onopen' put: [ ws send: 'hey there from Amber' ]!
  466. !NativeFunction class methodsFor: 'instance creation'!
  467. constructor: aString
  468. <
  469. var native=eval(aString);
  470. return new native();
  471. >
  472. !
  473. constructor: aString value:anObject
  474. <
  475. var native=eval(aString);
  476. return new native(anObject);
  477. >
  478. !
  479. constructor: aString value:anObject value: anObject2
  480. <
  481. var native=eval(aString);
  482. return new native(anObject,anObject2);
  483. >
  484. !
  485. constructor: aString value:anObject value: anObject2 value:anObject3
  486. <
  487. var native=eval(aString);
  488. return new native(anObject,anObject2, anObject3);
  489. >
  490. ! !
  491. !NativeFunction class methodsFor: 'testing'!
  492. exists: aString
  493. <
  494. if(aString in window) {
  495. return true
  496. } else {
  497. return false
  498. }
  499. >
  500. ! !