1
0

Importer-Exporter.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453
  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. package := Smalltalk current packageAt: packageName.
  70. self exportPackageDefinitionOf: package on: stream.
  71. "Export classes in dependency order.
  72. Update (issue #171): Remove duplicates for export"
  73. package sortedClasses asSet do: [:each |
  74. stream nextPutAll: (self exportClass: each)].
  75. self exportPackageExtensionsOf: package on: stream]
  76. ! !
  77. !Exporter methodsFor: 'private'!
  78. classNameFor: aClass
  79. ^aClass isMetaclass
  80. ifTrue: [aClass instanceClass name, '.klass']
  81. ifFalse: [
  82. aClass isNil
  83. ifTrue: ['nil']
  84. ifFalse: [aClass name]]
  85. !
  86. exportDefinitionOf: aClass on: aStream
  87. aStream
  88. nextPutAll: 'smalltalk.addClass(';
  89. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  90. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  91. nextPutAll: ', ['.
  92. aClass instanceVariableNames
  93. do: [:each | aStream nextPutAll: '''', each, '''']
  94. separatedBy: [aStream nextPutAll: ', '].
  95. aStream
  96. nextPutAll: '], ''';
  97. nextPutAll: aClass category, '''';
  98. nextPutAll: ');'.
  99. aClass comment notEmpty ifTrue: [
  100. aStream
  101. lf;
  102. nextPutAll: 'smalltalk.';
  103. nextPutAll: (self classNameFor: aClass);
  104. nextPutAll: '.comment=';
  105. nextPutAll: aClass comment asJavascript;
  106. nextPutAll: ';'].
  107. aStream lf
  108. !
  109. exportMetaDefinitionOf: aClass on: aStream
  110. aClass class instanceVariableNames isEmpty ifFalse: [
  111. aStream
  112. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  113. nextPutAll: '.iVarNames = ['.
  114. aClass class instanceVariableNames
  115. do: [:each | aStream nextPutAll: '''', each, '''']
  116. separatedBy: [aStream nextPutAll: ','].
  117. aStream nextPutAll: '];', String lf]
  118. !
  119. exportMethod: aMethod of: aClass on: aStream
  120. aStream
  121. nextPutAll: 'smalltalk.addMethod(';lf;
  122. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  123. nextPutAll: 'smalltalk.method({';lf;
  124. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  125. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  126. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  127. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  128. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  129. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  130. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  131. aStream
  132. lf;
  133. nextPutAll: '}),';lf;
  134. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  135. nextPutAll: ');';lf;lf
  136. !
  137. exportMethodsOf: aClass on: aStream
  138. "Issue #143: sort methods alphabetically"
  139. ((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:each |
  140. (each category match: '^\*') ifFalse: [
  141. self exportMethod: each of: aClass on: aStream]].
  142. aStream lf
  143. !
  144. exportPackageDefinitionOf: package on: aStream
  145. aStream
  146. nextPutAll: 'smalltalk.addPackage(';
  147. nextPutAll: '''', package name, ''');';
  148. lf
  149. !
  150. exportPackageExtensionsOf: package on: aStream
  151. "Issue #143: sort classes and methods alphabetically"
  152. | name |
  153. name := package name.
  154. (Package sortedClasses: Smalltalk current classes) do: [:each |
  155. {each. each class} do: [:aClass |
  156. ((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:method |
  157. (method category match: '^\*', name) ifTrue: [
  158. self exportMethod: method of: aClass on: aStream ]]]]
  159. ! !
  160. Exporter subclass: #ChunkExporter
  161. instanceVariableNames: ''
  162. package: 'Importer-Exporter'!
  163. !ChunkExporter commentStamp!
  164. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  165. I do not output any compiled code.!
  166. !ChunkExporter methodsFor: 'private'!
  167. chunkEscape: aString
  168. "Replace all occurrences of !! with !!!! and trim at both ends."
  169. ^(aString replace: '!!' with: '!!!!') trimBoth
  170. !
  171. classNameFor: aClass
  172. ^aClass isMetaclass
  173. ifTrue: [aClass instanceClass name, ' class']
  174. ifFalse: [
  175. aClass isNil
  176. ifTrue: ['nil']
  177. ifFalse: [aClass name]]
  178. !
  179. exportDefinitionOf: aClass on: aStream
  180. "Chunk format."
  181. aStream
  182. nextPutAll: (self classNameFor: aClass superclass);
  183. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  184. tab; nextPutAll: 'instanceVariableNames: '''.
  185. aClass instanceVariableNames
  186. do: [:each | aStream nextPutAll: each]
  187. separatedBy: [aStream nextPutAll: ' '].
  188. aStream
  189. nextPutAll: ''''; lf;
  190. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  191. aClass comment notEmpty ifTrue: [
  192. aStream
  193. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  194. nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
  195. aStream lf
  196. !
  197. exportMetaDefinitionOf: aClass on: aStream
  198. aClass class instanceVariableNames isEmpty ifFalse: [
  199. aStream
  200. nextPutAll: (self classNameFor: aClass class);
  201. nextPutAll: ' instanceVariableNames: '''.
  202. aClass class instanceVariableNames
  203. do: [:each | aStream nextPutAll: each]
  204. separatedBy: [aStream nextPutAll: ' '].
  205. aStream
  206. nextPutAll: '''!!'; lf; lf]
  207. !
  208. exportMethod: aMethod of: aClass on: aStream
  209. aStream
  210. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  211. nextPutAll: '!!'
  212. !
  213. exportMethods: methods category: category of: aClass on: aStream
  214. "Issue #143: sort methods alphabetically"
  215. aStream
  216. nextPutAll: '!!', (self classNameFor: aClass);
  217. nextPutAll: ' methodsFor: ''', category, '''!!'.
  218. (methods sorted: [:a :b | a selector <= b selector]) do: [:each |
  219. self exportMethod: each of: aClass on: aStream].
  220. aStream nextPutAll: ' !!'; lf; lf
  221. !
  222. exportMethodsOf: aClass on: aStream
  223. "Issue #143: sort protocol alphabetically"
  224. | map |
  225. map := Dictionary new.
  226. aClass protocolsDo: [:category :methods |
  227. (category match: '^\*') ifFalse: [ map at: category put: methods ]].
  228. (map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
  229. methods := map at: category.
  230. self
  231. exportMethods: methods
  232. category: category
  233. of: aClass
  234. on: aStream ]
  235. !
  236. exportPackageDefinitionOf: package on: aStream
  237. "Chunk format."
  238. aStream
  239. nextPutAll: 'Smalltalk current createPackage: ''', package name, '''!!';
  240. lf
  241. !
  242. exportPackageExtensionsOf: package on: aStream
  243. "We need to override this one too since we need to group
  244. all methods in a given protocol under a leading methodsFor: chunk
  245. for that class."
  246. "Issue #143: sort protocol alphabetically"
  247. | name map |
  248. name := package name.
  249. (Package sortedClasses: Smalltalk current classes) do: [:each |
  250. {each. each class} do: [:aClass |
  251. map := Dictionary new.
  252. aClass protocolsDo: [:category :methods |
  253. (category match: '^\*', name) ifTrue: [ map at: category put: methods ]].
  254. (map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
  255. methods := map at: category.
  256. self exportMethods: methods category: category of: aClass on: aStream ]]]
  257. ! !
  258. Exporter subclass: #StrippedExporter
  259. instanceVariableNames: ''
  260. package: 'Importer-Exporter'!
  261. !StrippedExporter commentStamp!
  262. I export Amber code into a JavaScript string, but without any optional associated data like the Amber source code.!
  263. !StrippedExporter methodsFor: 'private'!
  264. exportDefinitionOf: aClass on: aStream
  265. aStream
  266. nextPutAll: 'smalltalk.addClass(';
  267. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  268. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  269. nextPutAll: ', ['.
  270. aClass instanceVariableNames
  271. do: [:each | aStream nextPutAll: '''', each, '''']
  272. separatedBy: [aStream nextPutAll: ', '].
  273. aStream
  274. nextPutAll: '], ''';
  275. nextPutAll: aClass category, '''';
  276. nextPutAll: ');'.
  277. aStream lf
  278. !
  279. exportMethod: aMethod of: aClass on: aStream
  280. aStream
  281. nextPutAll: 'smalltalk.addMethod(';lf;
  282. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  283. nextPutAll: 'smalltalk.method({';lf;
  284. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  285. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  286. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;
  287. nextPutAll: '}),';lf;
  288. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  289. nextPutAll: ');';lf;lf
  290. ! !
  291. Object subclass: #Importer
  292. instanceVariableNames: ''
  293. package: 'Importer-Exporter'!
  294. !Importer commentStamp!
  295. I can import Amber code from a string in the chunk format.
  296. ## API
  297. Importer new import: aString!
  298. !Importer methodsFor: 'fileIn'!
  299. import: aStream
  300. | chunk result parser lastEmpty |
  301. parser := ChunkParser on: aStream.
  302. lastEmpty := false.
  303. [chunk := parser nextChunk.
  304. chunk isNil] whileFalse: [
  305. chunk isEmpty
  306. ifTrue: [lastEmpty := true]
  307. ifFalse: [
  308. result := Compiler new evaluateExpression: chunk.
  309. lastEmpty
  310. ifTrue: [
  311. lastEmpty := false.
  312. result scanFrom: parser]]]
  313. ! !
  314. Object subclass: #PackageHandler
  315. instanceVariableNames: ''
  316. package: 'Importer-Exporter'!
  317. !PackageHandler commentStamp!
  318. I am responsible for handling package loading and committing.
  319. I should not be used directly. Instead, use the corresponding `Package` methods.!
  320. !PackageHandler methodsFor: 'committing'!
  321. commit: aPackage
  322. {
  323. Exporter -> (aPackage commitPathJs, '/', aPackage name, '.js').
  324. StrippedExporter -> (aPackage commitPathJs, '/', aPackage name, '.deploy.js').
  325. ChunkExporter -> (aPackage commitPathSt, '/', aPackage name, '.st')
  326. }
  327. do: [ :commitStrategy|| fileContents |
  328. fileContents := (commitStrategy key new exportPackage: aPackage name).
  329. self ajaxPutAt: commitStrategy value data: fileContents ]
  330. displayingProgress: 'Committing package ', aPackage name
  331. ! !
  332. !PackageHandler methodsFor: 'loading'!
  333. loadPackage: packageName prefix: aString
  334. | url |
  335. url := '/', aString, '/js/', packageName, '.js'.
  336. jQuery
  337. ajax: url
  338. options: #{
  339. 'type' -> 'GET'.
  340. 'dataType' -> 'script'.
  341. 'complete' -> [ :jqXHR :textStatus |
  342. jqXHR readyState = 4
  343. ifTrue: [ self setupPackageNamed: packageName prefix: aString ] ].
  344. 'error' -> [ window alert: 'Could not load package at: ', url ]
  345. }
  346. !
  347. loadPackages: aCollection prefix: aString
  348. aCollection do: [ :each |
  349. self loadPackage: each prefix: aString ]
  350. ! !
  351. !PackageHandler methodsFor: 'private'!
  352. ajaxPutAt: aURL data: aString
  353. jQuery
  354. ajax: aURL
  355. options: #{
  356. 'type' -> 'PUT'.
  357. 'data' -> aString.
  358. 'contentType' -> 'text/plain;charset=UTF-8'.
  359. 'error' -> [ :xhr | self error: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
  360. !
  361. setupPackageNamed: packageName prefix: aString
  362. (Package named: packageName)
  363. setupClasses;
  364. commitPathJs: '/', aString, '/js';
  365. commitPathSt: '/', aString, '/st'
  366. ! !
  367. !PackageHandler class methodsFor: 'loading'!
  368. loadPackages: aCollection prefix: aString
  369. ^ self new loadPackages: aCollection prefix: aString
  370. ! !
  371. !Package methodsFor: '*Importer-Exporter'!
  372. commit
  373. ^ PackageHandler new commit: self
  374. ! !