Importer-Exporter.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476
  1. Smalltalk current createPackage: 'Importer-Exporter'!
  2. Object subclass: #ChunkParser
  3. instanceVariableNames: 'stream'
  4. package: 'Importer-Exporter'!
  5. !ChunkParser commentStamp!
  6. I am responsible for parsing aStream contents in the chunk format.
  7. ## API
  8. ChunkParser new
  9. stream: aStream;
  10. nextChunk!
  11. !ChunkParser methodsFor: 'accessing'!
  12. stream: aStream
  13. stream := aStream
  14. ! !
  15. !ChunkParser methodsFor: 'reading'!
  16. nextChunk
  17. "The chunk format (Smalltalk Interchange Format or Fileout format)
  18. is a trivial format but can be a bit tricky to understand:
  19. - Uses the exclamation mark as delimiter of chunks.
  20. - Inside a chunk a normal exclamation mark must be doubled.
  21. - A non empty chunk must be a valid Smalltalk expression.
  22. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  23. - The object created by the expression then takes over reading chunks.
  24. This metod returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  25. | char result chunk |
  26. result := '' writeStream.
  27. [char := stream next.
  28. char notNil] whileTrue: [
  29. char = '!!' ifTrue: [
  30. stream peek = '!!'
  31. ifTrue: [stream next "skipping the escape double"]
  32. ifFalse: [^result contents trimBoth "chunk end marker found"]].
  33. result nextPut: char].
  34. ^nil "a chunk needs to end with !!"
  35. ! !
  36. !ChunkParser class methodsFor: 'not yet classified'!
  37. on: aStream
  38. ^self new stream: aStream
  39. ! !
  40. Object subclass: #Exporter
  41. instanceVariableNames: ''
  42. package: 'Importer-Exporter'!
  43. !Exporter commentStamp!
  44. I am responsible for outputting Amber code into a JavaScript string.
  45. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  46. ## Use case
  47. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).
  48. ## API
  49. Use `#exportAll`, `#exportClass:` or `#exportPackage:` methods.!
  50. !Exporter methodsFor: 'fileOut'!
  51. exportAll
  52. "Export all packages in the system."
  53. ^String streamContents: [:stream |
  54. Smalltalk current packages do: [:pkg |
  55. stream nextPutAll: (self exportPackage: pkg name)]]
  56. !
  57. exportClass: aClass
  58. "Export a single class. Subclasses override these methods."
  59. ^String streamContents: [:stream |
  60. self exportDefinitionOf: aClass on: stream.
  61. self exportMethodsOf: aClass on: stream.
  62. self exportMetaDefinitionOf: aClass on: stream.
  63. self exportMethodsOf: aClass class on: stream]
  64. !
  65. exportPackage: packageName
  66. "Export a given package by name."
  67. | package |
  68. ^String streamContents: [:stream |
  69. self exportPackagePrologueOn: stream.
  70. [
  71. package := Smalltalk current packageAt: packageName.
  72. self exportPackageDefinitionOf: package on: stream.
  73. "Export classes in dependency order.
  74. Update (issue #171): Remove duplicates for export"
  75. package sortedClasses asSet do: [:each |
  76. stream nextPutAll: (self exportClass: each)].
  77. self exportPackageExtensionsOf: package on: stream
  78. ] ensure: [
  79. self exportPackageEpilogueOn: stream
  80. ]]
  81. ! !
  82. !Exporter methodsFor: 'private'!
  83. classNameFor: aClass
  84. ^aClass isMetaclass
  85. ifTrue: [aClass instanceClass name, '.klass']
  86. ifFalse: [
  87. aClass isNil
  88. ifTrue: ['nil']
  89. ifFalse: [aClass name]]
  90. !
  91. exportDefinitionOf: aClass on: aStream
  92. aStream
  93. nextPutAll: 'smalltalk.addClass(';
  94. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  95. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  96. nextPutAll: ', ['.
  97. aClass instanceVariableNames
  98. do: [:each | aStream nextPutAll: '''', each, '''']
  99. separatedBy: [aStream nextPutAll: ', '].
  100. aStream
  101. nextPutAll: '], ''';
  102. nextPutAll: aClass category, '''';
  103. nextPutAll: ');'.
  104. aClass comment notEmpty ifTrue: [
  105. aStream
  106. lf;
  107. nextPutAll: 'smalltalk.';
  108. nextPutAll: (self classNameFor: aClass);
  109. nextPutAll: '.comment=';
  110. nextPutAll: aClass comment asJavascript;
  111. nextPutAll: ';'].
  112. aStream lf
  113. !
  114. exportMetaDefinitionOf: aClass on: aStream
  115. aClass class instanceVariableNames isEmpty ifFalse: [
  116. aStream
  117. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  118. nextPutAll: '.iVarNames = ['.
  119. aClass class instanceVariableNames
  120. do: [:each | aStream nextPutAll: '''', each, '''']
  121. separatedBy: [aStream nextPutAll: ','].
  122. aStream nextPutAll: '];', String lf]
  123. !
  124. exportMethod: aMethod of: aClass on: aStream
  125. aStream
  126. nextPutAll: 'smalltalk.addMethod(';lf;
  127. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  128. nextPutAll: 'smalltalk.method({';lf;
  129. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  130. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  131. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  132. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  133. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  134. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  135. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  136. aStream
  137. lf;
  138. nextPutAll: '}),';lf;
  139. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  140. nextPutAll: ');';lf;lf
  141. !
  142. exportMethodsOf: aClass on: aStream
  143. "Issue #143: sort methods alphabetically"
  144. ((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:each |
  145. (each category match: '^\*') ifFalse: [
  146. self exportMethod: each of: aClass on: aStream]].
  147. aStream lf
  148. !
  149. exportPackageDefinitionOf: package on: aStream
  150. aStream
  151. nextPutAll: 'smalltalk.addPackage(';
  152. nextPutAll: '''', package name, ''');';
  153. lf
  154. !
  155. exportPackageEpilogueOn: aStream
  156. aStream
  157. nextPutAll: '})(global_smalltalk,global_nil,global__st);';
  158. lf
  159. !
  160. exportPackageExtensionsOf: package on: aStream
  161. "Issue #143: sort classes and methods alphabetically"
  162. | name |
  163. name := package name.
  164. (Package sortedClasses: Smalltalk current classes) do: [:each |
  165. {each. each class} do: [:aClass |
  166. ((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:method |
  167. (method category match: '^\*', name) ifTrue: [
  168. self exportMethod: method of: aClass on: aStream ]]]]
  169. !
  170. exportPackagePrologueOn: aStream
  171. aStream
  172. nextPutAll: '(function(smalltalk,nil,_st){';
  173. lf
  174. ! !
  175. Exporter subclass: #ChunkExporter
  176. instanceVariableNames: ''
  177. package: 'Importer-Exporter'!
  178. !ChunkExporter commentStamp!
  179. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  180. I do not output any compiled code.!
  181. !ChunkExporter methodsFor: 'private'!
  182. chunkEscape: aString
  183. "Replace all occurrences of !! with !!!! and trim at both ends."
  184. ^(aString replace: '!!' with: '!!!!') trimBoth
  185. !
  186. classNameFor: aClass
  187. ^aClass isMetaclass
  188. ifTrue: [aClass instanceClass name, ' class']
  189. ifFalse: [
  190. aClass isNil
  191. ifTrue: ['nil']
  192. ifFalse: [aClass name]]
  193. !
  194. exportDefinitionOf: aClass on: aStream
  195. "Chunk format."
  196. aStream
  197. nextPutAll: (self classNameFor: aClass superclass);
  198. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  199. tab; nextPutAll: 'instanceVariableNames: '''.
  200. aClass instanceVariableNames
  201. do: [:each | aStream nextPutAll: each]
  202. separatedBy: [aStream nextPutAll: ' '].
  203. aStream
  204. nextPutAll: ''''; lf;
  205. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  206. aClass comment notEmpty ifTrue: [
  207. aStream
  208. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  209. nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
  210. aStream lf
  211. !
  212. exportMetaDefinitionOf: aClass on: aStream
  213. aClass class instanceVariableNames isEmpty ifFalse: [
  214. aStream
  215. nextPutAll: (self classNameFor: aClass class);
  216. nextPutAll: ' instanceVariableNames: '''.
  217. aClass class instanceVariableNames
  218. do: [:each | aStream nextPutAll: each]
  219. separatedBy: [aStream nextPutAll: ' '].
  220. aStream
  221. nextPutAll: '''!!'; lf; lf]
  222. !
  223. exportMethod: aMethod of: aClass on: aStream
  224. aStream
  225. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  226. nextPutAll: '!!'
  227. !
  228. exportMethods: methods category: category of: aClass on: aStream
  229. "Issue #143: sort methods alphabetically"
  230. aStream
  231. nextPutAll: '!!', (self classNameFor: aClass);
  232. nextPutAll: ' methodsFor: ''', category, '''!!'.
  233. (methods sorted: [:a :b | a selector <= b selector]) do: [:each |
  234. self exportMethod: each of: aClass on: aStream].
  235. aStream nextPutAll: ' !!'; lf; lf
  236. !
  237. exportMethodsOf: aClass on: aStream
  238. "Issue #143: sort protocol alphabetically"
  239. | map |
  240. map := Dictionary new.
  241. aClass protocolsDo: [:category :methods |
  242. (category match: '^\*') ifFalse: [ map at: category put: methods ]].
  243. (map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
  244. methods := map at: category.
  245. self
  246. exportMethods: methods
  247. category: category
  248. of: aClass
  249. on: aStream ]
  250. !
  251. exportPackageDefinitionOf: package on: aStream
  252. "Chunk format."
  253. aStream
  254. nextPutAll: 'Smalltalk current createPackage: ''', package name, '''!!';
  255. lf
  256. !
  257. exportPackageEpilogueOn: aStream
  258. !
  259. exportPackageExtensionsOf: package on: aStream
  260. "We need to override this one too since we need to group
  261. all methods in a given protocol under a leading methodsFor: chunk
  262. for that class."
  263. "Issue #143: sort protocol alphabetically"
  264. | name map |
  265. name := package name.
  266. (Package sortedClasses: Smalltalk current classes) do: [:each |
  267. {each. each class} do: [:aClass |
  268. map := Dictionary new.
  269. aClass protocolsDo: [:category :methods |
  270. (category match: '^\*', name) ifTrue: [ map at: category put: methods ]].
  271. (map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
  272. methods := map at: category.
  273. self exportMethods: methods category: category of: aClass on: aStream ]]]
  274. !
  275. exportPackagePrologueOn: aStream
  276. ! !
  277. Exporter subclass: #StrippedExporter
  278. instanceVariableNames: ''
  279. package: 'Importer-Exporter'!
  280. !StrippedExporter commentStamp!
  281. I export Amber code into a JavaScript string, but without any optional associated data like the Amber source code.!
  282. !StrippedExporter methodsFor: 'private'!
  283. exportDefinitionOf: aClass on: aStream
  284. aStream
  285. nextPutAll: 'smalltalk.addClass(';
  286. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  287. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  288. nextPutAll: ', ['.
  289. aClass instanceVariableNames
  290. do: [:each | aStream nextPutAll: '''', each, '''']
  291. separatedBy: [aStream nextPutAll: ', '].
  292. aStream
  293. nextPutAll: '], ''';
  294. nextPutAll: aClass category, '''';
  295. nextPutAll: ');'.
  296. aStream lf
  297. !
  298. exportMethod: aMethod of: aClass on: aStream
  299. aStream
  300. nextPutAll: 'smalltalk.addMethod(';lf;
  301. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  302. nextPutAll: 'smalltalk.method({';lf;
  303. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  304. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  305. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;
  306. nextPutAll: '}),';lf;
  307. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  308. nextPutAll: ');';lf;lf
  309. ! !
  310. Object subclass: #Importer
  311. instanceVariableNames: ''
  312. package: 'Importer-Exporter'!
  313. !Importer commentStamp!
  314. I can import Amber code from a string in the chunk format.
  315. ## API
  316. Importer new import: aString!
  317. !Importer methodsFor: 'fileIn'!
  318. import: aStream
  319. | chunk result parser lastEmpty |
  320. parser := ChunkParser on: aStream.
  321. lastEmpty := false.
  322. [chunk := parser nextChunk.
  323. chunk isNil] whileFalse: [
  324. chunk isEmpty
  325. ifTrue: [lastEmpty := true]
  326. ifFalse: [
  327. result := Compiler new evaluateExpression: chunk.
  328. lastEmpty
  329. ifTrue: [
  330. lastEmpty := false.
  331. result scanFrom: parser]]]
  332. ! !
  333. Object subclass: #PackageHandler
  334. instanceVariableNames: ''
  335. package: 'Importer-Exporter'!
  336. !PackageHandler commentStamp!
  337. I am responsible for handling package loading and committing.
  338. I should not be used directly. Instead, use the corresponding `Package` methods.!
  339. !PackageHandler methodsFor: 'committing'!
  340. commit: aPackage
  341. {
  342. Exporter -> (aPackage commitPathJs, '/', aPackage name, '.js').
  343. StrippedExporter -> (aPackage commitPathJs, '/', aPackage name, '.deploy.js').
  344. ChunkExporter -> (aPackage commitPathSt, '/', aPackage name, '.st')
  345. }
  346. do: [ :commitStrategy|| fileContents |
  347. fileContents := (commitStrategy key new exportPackage: aPackage name).
  348. self ajaxPutAt: commitStrategy value data: fileContents ]
  349. displayingProgress: 'Committing package ', aPackage name
  350. ! !
  351. !PackageHandler methodsFor: 'loading'!
  352. loadPackage: packageName prefix: aString
  353. | url |
  354. url := '/', aString, '/js/', packageName, '.js'.
  355. jQuery
  356. ajax: url
  357. options: #{
  358. 'type' -> 'GET'.
  359. 'dataType' -> 'script'.
  360. 'complete' -> [ :jqXHR :textStatus |
  361. jqXHR readyState = 4
  362. ifTrue: [ self setupPackageNamed: packageName prefix: aString ] ].
  363. 'error' -> [ window alert: 'Could not load package at: ', url ]
  364. }
  365. !
  366. loadPackages: aCollection prefix: aString
  367. aCollection do: [ :each |
  368. self loadPackage: each prefix: aString ]
  369. ! !
  370. !PackageHandler methodsFor: 'private'!
  371. ajaxPutAt: aURL data: aString
  372. jQuery
  373. ajax: aURL
  374. options: #{
  375. 'type' -> 'PUT'.
  376. 'data' -> aString.
  377. 'contentType' -> 'text/plain;charset=UTF-8'.
  378. 'error' -> [ :xhr | self error: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
  379. !
  380. setupPackageNamed: packageName prefix: aString
  381. (Package named: packageName)
  382. setupClasses;
  383. commitPathJs: '/', aString, '/js';
  384. commitPathSt: '/', aString, '/st'
  385. ! !
  386. !PackageHandler class methodsFor: 'loading'!
  387. loadPackages: aCollection prefix: aString
  388. ^ self new loadPackages: aCollection prefix: aString
  389. ! !
  390. !Package methodsFor: '*Importer-Exporter'!
  391. commit
  392. ^ PackageHandler new commit: self
  393. ! !