1
0

Importer-Exporter.st 13 KB

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