evalStdLib.ml 109 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2019 Haxe Foundation
  4. This program is free software; you can redistribute it and/or
  5. modify it under the terms of the GNU General Public License
  6. as published by the Free Software Foundation; either version 2
  7. of the License, or (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  15. *)
  16. open Extlib_leftovers
  17. open Globals
  18. open EvalValue
  19. open EvalEncode
  20. open EvalDecode
  21. open EvalContext
  22. open EvalExceptions
  23. open EvalPrinting
  24. open EvalMisc
  25. open EvalField
  26. open EvalHash
  27. open EvalString
  28. open EvalThread
  29. let catch_unix_error f arg =
  30. try
  31. f arg
  32. with Unix.Unix_error(err,cmd,args) ->
  33. exc_string (Printf.sprintf "%s(%s, %s)" (Unix.error_message err) cmd args)
  34. let ptmap_keys h =
  35. IntMap.fold (fun k _ acc -> k :: acc) h []
  36. let hashtbl_keys h =
  37. Hashtbl.fold (fun k _ acc -> k :: acc) h []
  38. module StdEvalVector = struct
  39. let this this = match this with
  40. | VVector vv -> vv
  41. | v -> unexpected_value v "vector"
  42. let blit = vifun4 (fun vthis srcPos dest destPos len ->
  43. Array.blit (this vthis) (decode_int srcPos) (decode_vector dest) (decode_int destPos) (decode_int len);
  44. vnull
  45. )
  46. let toArray = vifun0 (fun vthis ->
  47. let copy = Array.copy (this vthis) in
  48. encode_array_instance (EvalArray.create copy)
  49. )
  50. let fromArrayCopy = vfun1 (fun arr ->
  51. let a = decode_varray arr in
  52. encode_vector_instance (Array.sub a.avalues 0 a.alength)
  53. )
  54. let copy = vifun0 (fun vthis ->
  55. encode_vector_instance (Array.copy (this vthis))
  56. )
  57. let join = vifun1 (fun vthis sep ->
  58. let this = this vthis in
  59. let sep = decode_vstring sep in
  60. vstring ((EvalArray.array_join this (s_value 0) sep))
  61. )
  62. let map = vifun1 (fun vthis f ->
  63. let this = this vthis in
  64. let a = match f with
  65. | VFunction(f,_) ->
  66. Array.map (fun v -> f [v]) this
  67. | VFieldClosure(v1,f) ->
  68. Array.map (fun v -> f (v1 :: [v])) this
  69. | _ -> exc_string ("Cannot call " ^ (value_string f))
  70. in
  71. encode_vector_instance a
  72. )
  73. end
  74. module StdArray = struct
  75. let this this = match this with
  76. | VArray va -> va
  77. | v -> unexpected_value v "array"
  78. let concat = vifun1 (fun vthis a2 ->
  79. let a2 = decode_varray a2 in
  80. encode_array_instance (EvalArray.concat (this vthis) a2)
  81. )
  82. let copy = vifun0 (fun vthis ->
  83. encode_array_instance (EvalArray.copy (this vthis))
  84. )
  85. let filter = vifun1 (fun vthis f ->
  86. let this = this vthis in
  87. let a = EvalArray.filter this (fun v -> is_true (call_value_on vthis f [v])) in
  88. encode_array_instance a
  89. )
  90. let indexOf = vifun2 (fun vthis x fromIndex ->
  91. let this = this vthis in
  92. let fromIndex = default_int fromIndex 0 in
  93. let fromIndex = if fromIndex < 0 then this.alength + fromIndex else fromIndex in
  94. let fromIndex = if fromIndex < 0 then 0 else fromIndex in
  95. vint (EvalArray.indexOf this equals x fromIndex)
  96. )
  97. let insert = vifun2 (fun vthis pos x ->
  98. let this = this vthis in
  99. let pos = decode_int pos in
  100. if pos >= this.alength then begin
  101. ignore(EvalArray.push this x);
  102. end else begin
  103. let pos = if pos < 0 then this.alength + pos else pos in
  104. let pos = if pos < 0 then 0 else pos in
  105. EvalArray.insert this pos x
  106. end;
  107. vnull
  108. )
  109. let iterator = vifun0 (fun vthis ->
  110. let this = this vthis in
  111. let f_has_next,f_next = EvalArray.iterator this in
  112. encode_obj [
  113. key_hasNext,vifun0 (fun _ -> vbool (f_has_next()));
  114. key_next,vifun0 (fun _ -> f_next())
  115. ]
  116. )
  117. let join = vifun1 (fun vthis sep ->
  118. let sep = decode_vstring sep in
  119. let s = EvalArray.join (this vthis) (s_value 0) sep in
  120. vstring s
  121. )
  122. let keyValueIterator = vifun0 (fun vthis ->
  123. let ctx = get_ctx() in
  124. let path = key_haxe_iterators_array_key_value_iterator in
  125. let vit = encode_instance path in
  126. let fnew = get_instance_constructor ctx path null_pos in
  127. ignore(call_value_on vit (Lazy.force fnew) [vthis]);
  128. vit
  129. )
  130. let lastIndexOf = vifun2 (fun vthis x fromIndex ->
  131. let this = this vthis in
  132. let last = this.alength - 1 in
  133. let fromIndex = default_int fromIndex last in
  134. let fromIndex = if fromIndex < 0 then this.alength + fromIndex else fromIndex in
  135. let fromIndex = if fromIndex < 0 then 0 else if fromIndex > last then last else fromIndex in
  136. vint (EvalArray.lastIndexOf this equals x fromIndex)
  137. )
  138. let map = vifun1 (fun vthis f ->
  139. let this = this vthis in
  140. let a = match f with
  141. | VFunction(f,_) ->
  142. EvalArray.map this (fun v -> f [v])
  143. | VFieldClosure(v1,f) ->
  144. EvalArray.map this (fun v -> f (v1 :: [v]))
  145. | _ -> exc_string ("Cannot call " ^ (value_string f))
  146. in
  147. encode_array_instance a
  148. )
  149. let pop = vifun0 (fun vthis ->
  150. let this = this vthis in
  151. EvalArray.pop this
  152. )
  153. let push = vifun1 (fun vthis v ->
  154. let this = this vthis in
  155. vint32 (Int32.of_int (EvalArray.push this v))
  156. )
  157. let remove = vifun1 (fun vthis x ->
  158. let this = this vthis in
  159. vbool (EvalArray.remove this equals x)
  160. )
  161. let contains = vifun1 (fun vthis x ->
  162. let this = this vthis in
  163. vbool (EvalArray.contains this equals x)
  164. )
  165. let reverse = vifun0 (fun vthis ->
  166. let this = this vthis in
  167. EvalArray.reverse this;
  168. vnull
  169. )
  170. let shift = vifun0 (fun vthis ->
  171. let this = this vthis in
  172. EvalArray.shift this
  173. )
  174. let slice = vifun2 (fun vthis pos end' ->
  175. let this = this vthis in
  176. let pos = decode_int pos in
  177. let length = this.alength in
  178. let end' = default_int end' length in
  179. let end' = if end' > length then length else end' in
  180. let pos = if pos < 0 then length + pos else pos in
  181. let end' = if end' < 0 then length + end' else end' in
  182. let pos = if pos < 0 then 0 else pos in
  183. let end' = if end' < 0 then 0 else end' in
  184. encode_array_instance (EvalArray.slice this pos end')
  185. )
  186. let sort = vifun1 (fun vthis f ->
  187. let this = this vthis in
  188. EvalArray.sort this (fun a b -> decode_int (call_value_on vthis f [a;b]));
  189. vnull
  190. )
  191. let splice = vifun2 (fun vthis pos len ->
  192. let this = this vthis in
  193. let pos = decode_int pos in
  194. let len = decode_int len in
  195. let length = this.alength in
  196. if len < 0 || pos > length then
  197. encode_array []
  198. else begin
  199. let pos = if pos < 0 then length + pos else pos in
  200. let pos = if pos < 0 then 0 else pos in
  201. let delta = length - pos in
  202. let len = if len > delta then delta else len in
  203. let end' = pos + len in
  204. encode_array_instance (EvalArray.splice this pos len end')
  205. end
  206. )
  207. let toString = vifun0 (fun vthis ->
  208. vstring (s_array 0 0 (this vthis))
  209. )
  210. let unshift = vifun1 (fun vthis v ->
  211. let this = this vthis in
  212. EvalArray.unshift this v;
  213. vnull
  214. )
  215. let resize = vifun1 (fun vthis len ->
  216. let this = this vthis in
  217. let len = decode_int len in
  218. EvalArray.resize this len;
  219. vnull
  220. )
  221. end
  222. let outside_bounds () =
  223. let haxe_io_Error = get_static_prototype (get_ctx()) key_haxe_io_Error null_pos in
  224. exc (proto_field_direct haxe_io_Error key_OutsideBounds)
  225. module StdBytes = struct
  226. open EvalBytes
  227. let this vthis = match vthis with
  228. | VInstance {ikind = IBytes o} -> o
  229. | v -> unexpected_value v "bytes"
  230. let alloc = vfun1 (fun length ->
  231. let length = decode_int length in
  232. encode_bytes (Bytes.make length (Char.chr 0))
  233. )
  234. let encode_native v = match v with
  235. | VEnumValue {eindex = 1} -> true (* haxe.io.Encoding.RawNative *)
  236. | _ -> false
  237. let blit = vifun4 (fun vthis pos src srcpos len ->
  238. let s = this vthis in
  239. let pos = decode_int pos in
  240. let src = decode_bytes src in
  241. let srcpos = decode_int srcpos in
  242. let len = decode_int len in
  243. (try Bytes.blit src srcpos s pos len with _ -> outside_bounds());
  244. vnull
  245. )
  246. let compare = vifun1 (fun vthis other ->
  247. let this = this vthis in
  248. let other = decode_bytes other in
  249. vint (Pervasives.compare this other)
  250. )
  251. let fastGet = vfun2 (fun b pos ->
  252. let b = decode_bytes b in
  253. let pos = decode_int pos in
  254. try vint (int_of_char (Bytes.unsafe_get b pos)) with _ -> vnull
  255. )
  256. let fill = vifun3 (fun vthis pos len value ->
  257. let this = this vthis in
  258. let pos = decode_int pos in
  259. let len = decode_int len in
  260. let value = decode_int value in
  261. (try Bytes.fill this pos len (char_of_int (value land 0xFF)) with _ -> outside_bounds());
  262. vnull
  263. )
  264. let get = vifun1 (fun vthis pos ->
  265. let this = this vthis in
  266. let pos = decode_int pos in
  267. try vint (read_byte this pos) with _ -> vnull
  268. )
  269. let getData = vifun0 (fun vthis -> vthis)
  270. let getDouble = vifun1 (fun vthis pos ->
  271. try vfloat (Int64.float_of_bits (read_i64 (this vthis) (decode_int pos))) with _ -> outside_bounds()
  272. )
  273. let getFloat = vifun1 (fun vthis pos ->
  274. try vfloat (Int32.float_of_bits (read_i32 (this vthis) (decode_int pos))) with _ -> outside_bounds()
  275. )
  276. let getInt32 = vifun1 (fun vthis pos ->
  277. try vint32 (read_i32 (this vthis) (decode_int pos)) with exc -> outside_bounds()
  278. )
  279. let getInt64 = vifun1 (fun vthis pos ->
  280. let this = this vthis in
  281. let pos = decode_int pos in
  282. try
  283. let low = read_i32 this pos in
  284. let high = read_i32 this (pos + 4) in
  285. EvalIntegers.encode_haxe_i64 low high;
  286. with _ ->
  287. outside_bounds()
  288. )
  289. let getString = vifun3 (fun vthis pos len encoding ->
  290. let this = this vthis in
  291. let pos = decode_int pos in
  292. let len = decode_int len in
  293. let s = try Bytes.sub this pos len with _ -> outside_bounds() in
  294. create_unknown (Bytes.unsafe_to_string s)
  295. )
  296. let getUInt16 = vifun1 (fun vthis pos ->
  297. try vint (read_ui16 (this vthis) (decode_int pos)) with _ -> outside_bounds()
  298. )
  299. let ofData = vfun1 (fun v -> v)
  300. let ofString = vfun2 (fun v encoding ->
  301. let s = decode_vstring v in
  302. encode_bytes (Bytes.of_string s.sstring)
  303. )
  304. let ofHex = vfun1 (fun v ->
  305. let s = decode_string v in
  306. let len = String.length s in
  307. if (len land 1) <> 0 then exc_string "Not a hex string (odd number of digits)";
  308. let ret = (Bytes.make (len lsr 1) (Char.chr 0)) in
  309. for i = 0 to Bytes.length ret - 1 do
  310. let high = int_of_char s.[i * 2] in
  311. let low = int_of_char s.[i * 2 + 1] in
  312. let high = (high land 0xF) + ((high land 0x40) lsr 6) * 9 in
  313. let low = (low land 0xF) + ((low land 0x40) lsr 6) * 9 in
  314. Bytes.set ret i (char_of_int (((high lsl 4) lor low) land 0xFF));
  315. done;
  316. encode_bytes ret
  317. )
  318. let set = vifun2 (fun vthis pos v ->
  319. let this = this vthis in
  320. let pos = decode_int pos in
  321. let v = decode_int v in
  322. (try write_byte this pos v with _ -> ());
  323. vnull;
  324. )
  325. let setDouble = vifun2 (fun vthis pos v ->
  326. (try write_i64 (this vthis) (decode_int pos) (Int64.bits_of_float (num v)) with _ -> outside_bounds());
  327. vnull
  328. )
  329. let setFloat = vifun2 (fun vthis pos v ->
  330. let this = this vthis in
  331. let pos = decode_int pos in
  332. let v = num v in
  333. write_i32 this pos (Int32.bits_of_float v);
  334. vnull
  335. )
  336. let setInt32 = vifun2 (fun vthis pos v ->
  337. (try write_i32 (this vthis) (decode_int pos) (decode_i32 v) with _ -> outside_bounds());
  338. vnull;
  339. )
  340. let setInt64 = vifun2 (fun vthis pos v ->
  341. let v = decode_instance v in
  342. let pos = decode_int pos in
  343. let high = decode_i32 (instance_field v key_high) in
  344. let low = decode_i32 (instance_field v key_low) in
  345. let this = this vthis in
  346. try
  347. write_i32 this pos low;
  348. write_i32 this (pos + 4) high;
  349. vnull
  350. with _ ->
  351. outside_bounds()
  352. )
  353. let setUInt16 = vifun2 (fun vthis pos v ->
  354. (try write_ui16 (this vthis) (decode_int pos) (decode_int v land 0xFFFF) with _ -> outside_bounds());
  355. vnull
  356. )
  357. let sub = vifun2 (fun vthis pos len ->
  358. let this = this vthis in
  359. let pos = decode_int pos in
  360. let len = decode_int len in
  361. let s = try Bytes.sub this pos len with _ -> outside_bounds() in
  362. encode_bytes s
  363. )
  364. let toHex = vifun0 (fun vthis ->
  365. let this = this vthis in
  366. let chars = [|"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";"a";"b";"c";"d";"e";"f"|] in
  367. let l = Bytes.length this in
  368. let rec loop acc i =
  369. if i >= l then List.rev acc
  370. else begin
  371. let c = int_of_char (Bytes.get this i) in
  372. loop ((chars.(c land 15)) :: ((chars.(c lsr 4))) :: acc) (i + 1)
  373. end
  374. in
  375. encode_string (String.concat "" (loop [] 0))
  376. )
  377. let toString = vifun0 (fun vthis ->
  378. let this = this vthis in
  379. try
  380. UTF8.validate (Bytes.unsafe_to_string this);
  381. (create_unknown (Bytes.to_string this))
  382. with UTF8.Malformed_code ->
  383. exc_string "Invalid string"
  384. )
  385. end
  386. module StdBytesBuffer = struct
  387. let this vthis = match vthis with
  388. | VInstance {ikind = IOutput o} -> o
  389. | v -> unexpected_value v "output"
  390. let get_length = vifun0 (fun vthis ->
  391. let this = this vthis in
  392. vint (Buffer.length this)
  393. )
  394. let add_char this i =
  395. Buffer.add_char this (Char.unsafe_chr i)
  396. let add_i32 this v =
  397. let base = Int32.to_int v in
  398. let big = Int32.to_int (Int32.shift_right_logical v 24) in
  399. add_char this base;
  400. add_char this (base lsr 8);
  401. add_char this (base lsr 16);
  402. add_char this big
  403. let addByte = vifun1 (fun vthis byte ->
  404. let this = this vthis in
  405. let byte = decode_int byte in
  406. add_char this byte;
  407. vnull;
  408. )
  409. let add = vifun1 (fun vthis src ->
  410. let this = this vthis in
  411. let src = decode_bytes src in
  412. Buffer.add_bytes this src;
  413. vnull
  414. )
  415. let addString = vifun2 (fun vthis src encoding ->
  416. let this = this vthis in
  417. let src = decode_vstring src in
  418. Buffer.add_string this src.sstring;
  419. vnull
  420. )
  421. let addInt32 = vifun1 (fun vthis v ->
  422. let this = this vthis in
  423. let v = decode_i32 v in
  424. add_i32 this v;
  425. vnull
  426. )
  427. let addInt64 = vifun1 (fun vthis v ->
  428. let this = this vthis in
  429. let v = decode_instance v in
  430. let high = decode_i32 (instance_field v key_high) in
  431. let low = decode_i32 (instance_field v key_low) in
  432. add_i32 this low;
  433. add_i32 this high;
  434. vnull;
  435. )
  436. let addFloat = vifun1 (fun vthis v ->
  437. let this = this vthis in
  438. let v = num v in
  439. add_i32 this (Int32.bits_of_float v);
  440. vnull
  441. )
  442. let addDouble = vifun1 (fun vthis v ->
  443. let this = this vthis in
  444. let v = num v in
  445. let v = Int64.bits_of_float v in
  446. add_i32 this (Int64.to_int32 v);
  447. add_i32 this (Int64.to_int32 (Int64.shift_right_logical v 32));
  448. vnull
  449. )
  450. let addBytes = vifun3 (fun vthis src pos len ->
  451. let this = this vthis in
  452. let src = decode_bytes src in
  453. let pos = decode_int pos in
  454. let len = decode_int len in
  455. if pos < 0 || len < 0 || pos + len > Bytes.length src then outside_bounds();
  456. Buffer.add_subbytes this src pos len;
  457. vnull
  458. )
  459. let getBytes = vifun0 (fun vthis ->
  460. let this = this vthis in
  461. encode_bytes (Bytes.unsafe_of_string (Buffer.contents this))
  462. )
  463. end
  464. module StdCompress = struct
  465. open Extc
  466. type zfun = zstream -> src:string -> spos:int -> slen:int -> dst:bytes -> dpos:int -> dlen:int -> zflush -> zresult
  467. let this vthis = match vthis with
  468. | VInstance {ikind = IZip zip} -> zip
  469. | _ -> unexpected_value vthis "Compress"
  470. let exec (f : zfun) vthis src srcPos dst dstPos =
  471. let this = this vthis in
  472. let src = decode_bytes src in
  473. let srcPos = decode_int srcPos in
  474. let dst = decode_bytes dst in
  475. let dstPos = decode_int dstPos in
  476. let r = try f this.z (Bytes.unsafe_to_string src) srcPos (Bytes.length src - srcPos) dst dstPos (Bytes.length dst - dstPos) this.z_flush with _ -> exc_string "oops" in
  477. encode_obj [
  478. key_done,vbool r.z_finish;
  479. key_read,vint r.z_read;
  480. key_write,vint r.z_wrote
  481. ]
  482. let close = vifun0 (fun vthis ->
  483. zlib_deflate_end (this vthis).z;
  484. vnull
  485. )
  486. let execute = vifun4 (fun vthis src srcPos dst dstPos ->
  487. exec zlib_deflate vthis src srcPos dst dstPos
  488. )
  489. let run = vfun2 (fun s level ->
  490. let s = decode_bytes s in
  491. let level = decode_int level in
  492. let zip = zlib_deflate_init level in
  493. let d = Bytes.make (zlib_deflate_bound zip (Bytes.length s)) (char_of_int 0) in
  494. let r = zlib_deflate zip (Bytes.unsafe_to_string s) 0 (Bytes.length s) d 0 (Bytes.length d) Z_FINISH in
  495. zlib_deflate_end zip;
  496. if not r.z_finish || r.z_read <> (Bytes.length s) then exc_string "Compression failed";
  497. encode_bytes (Bytes.sub d 0 r.z_wrote)
  498. )
  499. let setFlushMode = vifun1 (fun vthis f ->
  500. let mode = match fst (decode_enum f) with
  501. | 0 -> Z_NO_FLUSH
  502. | 1 -> Z_SYNC_FLUSH
  503. | 2 -> Z_FULL_FLUSH
  504. | 3 -> Z_FINISH
  505. | 4 -> Z_PARTIAL_FLUSH
  506. | _ -> die "" __LOC__
  507. in
  508. (this vthis).z_flush <- mode;
  509. vnull
  510. )
  511. end
  512. module StdContext = struct
  513. let addBreakpoint = vfun2 (fun file line ->
  514. let file = decode_string file in
  515. let line = decode_int line in
  516. begin try
  517. ignore(EvalDebugMisc.add_breakpoint (get_ctx()) file line BPAny None);
  518. with Not_found ->
  519. exc_string ("Could not find file " ^ file)
  520. end;
  521. vnull
  522. )
  523. let breakHere = vfun0 (fun () ->
  524. if not ((get_ctx()).debug.support_debugger) then vnull
  525. else raise (EvalDebugMisc.BreakHere)
  526. )
  527. let callMacroApi = vfun1 (fun f ->
  528. let f = decode_string f in
  529. Hashtbl.find GlobalState.macro_lib f
  530. )
  531. let plugins = ref PMap.empty
  532. let plugin_data = ref None
  533. let register data = plugin_data := Some data
  534. let loadPlugin = vfun1 (fun filePath ->
  535. let filePath = decode_string filePath in
  536. let filePath = Dynlink.adapt_filename filePath in
  537. if PMap.mem filePath !plugins then
  538. PMap.find filePath !plugins
  539. else begin
  540. (try Dynlink.loadfile filePath with Dynlink.Error error -> exc_string (Dynlink.error_message error));
  541. match !plugin_data with
  542. | Some l ->
  543. let vapi = encode_obj_s l in
  544. plugins := PMap.add filePath vapi !plugins;
  545. vapi
  546. | None ->
  547. vnull
  548. end
  549. )
  550. end
  551. module StdCrc32 = struct
  552. let make = vfun1 (fun data ->
  553. let data = decode_bytes data in
  554. let crc32 = Extc.zlib_crc32 data (Bytes.length data) in
  555. vint32 crc32
  556. )
  557. end
  558. module StdDate = struct
  559. open Unix
  560. let encode_date d = encode_instance key_Date ~kind:(IDate d)
  561. let this vthis = match vthis with
  562. | VInstance {ikind = IDate d} -> d
  563. | v -> unexpected_value v "date"
  564. let fromTime = vfun1 (fun f -> encode_date ((num f) /. 1000.))
  565. let fromString = vfun1 (fun s ->
  566. let s = decode_string s in
  567. match String.length s with
  568. | 19 ->
  569. let r = Str.regexp "^\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\) \\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$" in
  570. if not (Str.string_match r s 0) then exc_string ("Invalid date format : " ^ s);
  571. let t = {
  572. tm_year = int_of_string (Str.matched_group 1 s) - 1900;
  573. tm_mon = int_of_string (Str.matched_group 2 s) - 1;
  574. tm_mday = int_of_string (Str.matched_group 3 s);
  575. tm_hour = int_of_string (Str.matched_group 4 s);
  576. tm_min = int_of_string (Str.matched_group 5 s);
  577. tm_sec = int_of_string (Str.matched_group 6 s);
  578. tm_wday = 0;
  579. tm_yday = 0;
  580. tm_isdst = false;
  581. } in
  582. encode_date (fst (catch_unix_error mktime t))
  583. | 10 ->
  584. let r = Str.regexp "^\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)$" in
  585. if not (Str.string_match r s 0) then exc_string ("Invalid date format : " ^ s);
  586. let t = {
  587. tm_year = int_of_string (Str.matched_group 1 s) - 1900;
  588. tm_mon = int_of_string (Str.matched_group 2 s) - 1;
  589. tm_mday = int_of_string (Str.matched_group 3 s);
  590. tm_hour = 0;
  591. tm_min = 0;
  592. tm_sec = 0;
  593. tm_wday = 0;
  594. tm_yday = 0;
  595. tm_isdst = false;
  596. } in
  597. encode_date (fst (catch_unix_error mktime t))
  598. | 8 ->
  599. let r = Str.regexp "^\\([0-9][0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$" in
  600. if not (Str.string_match r s 0) then exc_string ("Invalid date format : " ^ s);
  601. let h = int_of_string (Str.matched_group 1 s) in
  602. let m = int_of_string (Str.matched_group 2 s) in
  603. let s = int_of_string (Str.matched_group 3 s) in
  604. let t = h * 60 * 60 + m * 60 + s in
  605. encode_date (float_of_int t)
  606. | _ ->
  607. exc_string ("Invalid date format : " ^ s)
  608. )
  609. let getDate = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_mday)
  610. let getDay = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_wday)
  611. let getFullYear = vifun0 (fun vthis -> vint (((catch_unix_error localtime (this vthis)).tm_year) + 1900))
  612. let getHours = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_hour)
  613. let getMinutes = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_min)
  614. let getMonth = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_mon)
  615. let getSeconds = vifun0 (fun vthis -> vint (catch_unix_error localtime (this vthis)).tm_sec)
  616. let getUTCDate = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_mday)
  617. let getUTCDay = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_wday)
  618. let getUTCFullYear = vifun0 (fun vthis -> vint (((catch_unix_error gmtime (this vthis)).tm_year) + 1900))
  619. let getUTCHours = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_hour)
  620. let getUTCMinutes = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_min)
  621. let getUTCMonth = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_mon)
  622. let getUTCSeconds = vifun0 (fun vthis -> vint (catch_unix_error gmtime (this vthis)).tm_sec)
  623. let getTime = vifun0 (fun vthis -> vfloat ((this vthis) *. 1000.))
  624. let getTimezoneOffset = vifun0 (fun vthis ->
  625. let tmLocal = catch_unix_error localtime (this vthis) in
  626. let tmUTC = catch_unix_error gmtime (this vthis) in
  627. let tsLocal = fst (catch_unix_error mktime tmLocal) in
  628. let tsUTC = fst (catch_unix_error mktime tmUTC) in
  629. vint (int_of_float ((tsUTC -. tsLocal) /. 60.))
  630. )
  631. let now = vfun0 (fun () -> encode_date (catch_unix_error time()))
  632. let toString = vifun0 (fun vthis -> vstring (s_date (this vthis)))
  633. end
  634. module StdDeque = struct
  635. let this vthis = match vthis with
  636. | VInstance {ikind = IDeque d} -> d
  637. | _ -> unexpected_value vthis "Deque"
  638. let add = vifun1 (fun vthis i ->
  639. let this = this vthis in
  640. Deque.add this i;
  641. vnull
  642. )
  643. let pop = vifun1 (fun vthis blocking ->
  644. let this = this vthis in
  645. let blocking = decode_bool blocking in
  646. match Deque.pop this blocking with
  647. | None -> vnull
  648. | Some v -> v
  649. )
  650. let push = vifun1 (fun vthis i ->
  651. let this = this vthis in
  652. Deque.push this i;
  653. vnull
  654. )
  655. end
  656. module StdEReg = struct
  657. open Pcre2
  658. let create r opt =
  659. let open Pcre2 in
  660. let string_of_pcre_error = function
  661. | BadPattern(s,i) -> Printf.sprintf "at %i: %s" i s
  662. | Partial -> "Partial"
  663. | BadUTF -> "BadUTF"
  664. | BadUTFOffset -> "BadUTFOffset"
  665. | MatchLimit -> "MatchLimit"
  666. | DepthLimit -> "DepthLimit"
  667. | WorkspaceSize -> "WorkspaceSize"
  668. | InternalError s -> "InternalError: " ^ s
  669. in
  670. let global = ref false in
  671. let flags = ExtList.List.filter_map (function
  672. | 'i' -> Some `CASELESS
  673. | 's' -> Some `DOTALL
  674. | 'm' -> Some `MULTILINE
  675. | 'u' -> None
  676. | 'g' -> global := true; None
  677. | c -> failwith ("Unsupported regexp option '" ^ String.make 1 c ^ "'")
  678. ) (ExtString.String.explode opt) in
  679. let flags = `UTF :: `UCP :: flags in
  680. let rex = try regexp ~flags r with Error error -> failwith (string_of_pcre_error error) in
  681. let pcre = {
  682. r = rex;
  683. r_rex_string = create_ascii (Printf.sprintf "~/%s/%s" r opt);
  684. r_global = !global;
  685. r_string = "";
  686. r_groups = [||]
  687. } in
  688. IRegex pcre
  689. let maybe_run rex n f =
  690. let substrings = if Array.length rex.r_groups = 0 then exc_string "Invalid regex operation because no match was made" else rex.r_groups.(0) in
  691. if n < 0 || n >= num_of_subs substrings then exc_string "Invalid group"
  692. else try f (get_substring_ofs substrings n)
  693. with Not_found -> vnull
  694. let this this = match this with
  695. | VInstance {ikind = IRegex rex} -> rex
  696. | v -> unexpected_value v "EReg"
  697. let escape = vfun1 (fun s ->
  698. let s = decode_string s in
  699. create_unknown (Str.quote s)
  700. )
  701. let map = vifun2 (fun vthis s f ->
  702. let this = this vthis in
  703. let s = decode_string s in
  704. let l = String.length s in
  705. let buf = Buffer.create 0 in
  706. let rec loop pos =
  707. if pos >= l then
  708. ()
  709. else begin try
  710. let a = exec ~rex:this.r ~pos s in
  711. this.r_groups <- [|a|];
  712. let (first,last) = get_substring_ofs a 0 in
  713. Buffer.add_substring buf s pos (first - pos);
  714. Buffer.add_string buf (decode_string (call_value_on vthis f [vthis]));
  715. if last = first then begin
  716. if last >= l then
  717. ()
  718. else begin
  719. if this.r_global then begin
  720. Buffer.add_substring buf s first 1;
  721. loop (first + 1)
  722. end else
  723. Buffer.add_substring buf s first (l - first)
  724. end
  725. end else if this.r_global then
  726. loop last
  727. else
  728. Buffer.add_substring buf s last (l - last)
  729. with Not_found ->
  730. Buffer.add_substring buf s pos (l - pos)
  731. end
  732. in
  733. this.r_string <- s;
  734. loop 0;
  735. this.r_string <- "";
  736. this.r_groups <- [||];
  737. create_unknown (Buffer.contents buf)
  738. )
  739. let match' = vifun1 (fun vthis s ->
  740. let this = this vthis in
  741. let open Pcre2 in
  742. let s = decode_string s in
  743. this.r_string <- s;
  744. try
  745. let a = exec_all ~flags:[`NO_UTF_CHECK] ~rex:this.r s in
  746. this.r_groups <- a;
  747. vtrue
  748. with Not_found ->
  749. this.r_groups <- [||];
  750. vfalse
  751. | Pcre2.Error _ ->
  752. exc_string "PCRE Error (invalid unicode string?)"
  753. )
  754. let matched = vifun1 (fun vthis n ->
  755. let this = this vthis in
  756. let n = decode_int n in
  757. maybe_run this n (fun (first,last) ->
  758. create_unknown (ExtString.String.slice ~first ~last this.r_string)
  759. )
  760. )
  761. let matchedLeft = vifun0 (fun vthis ->
  762. let this = this vthis in
  763. maybe_run this 0 (fun (first,_) ->
  764. create_unknown (ExtString.String.slice ~last:first this.r_string)
  765. )
  766. )
  767. let matchedPos = vifun0 (fun vthis ->
  768. let this = this vthis in
  769. let rec byte_offset_to_char_offset_lol s i k o =
  770. if i = 0 then
  771. k
  772. else begin
  773. let n = UTF8.next s o in
  774. let d = n - o in
  775. byte_offset_to_char_offset_lol s (i - d) (k + 1) n
  776. end
  777. in
  778. maybe_run this 0 (fun (first,last) ->
  779. let first = byte_offset_to_char_offset_lol this.r_string first 0 0 in
  780. let last = byte_offset_to_char_offset_lol this.r_string last 0 0 in
  781. encode_obj [key_pos,vint first;key_len,vint (last - first)]
  782. )
  783. )
  784. let matchedRight = vifun0 (fun vthis ->
  785. let this = this vthis in
  786. maybe_run this 0 (fun (_,last) ->
  787. create_unknown (ExtString.String.slice ~first:last this.r_string)
  788. )
  789. )
  790. let matchSub = vifun3 (fun vthis s pos len ->
  791. let this = this vthis in
  792. let s = decode_string s in
  793. let pos = decode_int pos in
  794. let len_default = String.length s - pos in
  795. let len = default_int len len_default in
  796. let len = if len < 0 then len_default else len in
  797. begin try
  798. if pos + len > String.length s then raise Not_found;
  799. let str = String.sub s 0 (pos + len) in
  800. let a = Pcre2.exec_all ~flags:[`NO_UTF_CHECK] ~rex:this.r ~pos str in
  801. this.r_string <- s;
  802. this.r_groups <- a;
  803. vtrue
  804. with Not_found ->
  805. vfalse
  806. end
  807. )
  808. let replace = vifun2 (fun vthis s by ->
  809. let this = this vthis in
  810. let s = decode_string s in
  811. let by = decode_string by in
  812. let s = (if this.r_global then Pcre2.replace else Pcre2.replace_first) ~flags:[`NO_UTF_CHECK] ~rex:this.r ~templ:by s in
  813. create_unknown s
  814. )
  815. let split = vifun1 (fun vthis s ->
  816. let this = this vthis in
  817. let s = decode_string s in
  818. let slength = String.length s in
  819. if slength = 0 then
  820. encode_array [v_empty_string]
  821. else begin
  822. let copy_offset = ref 0 in
  823. let acc = DynArray.create () in
  824. let add first last =
  825. let sub = String.sub s first (last - first) in
  826. DynArray.add acc (create_unknown sub)
  827. in
  828. let exec = Pcre2.exec ~flags:[`NO_UTF_CHECK] ~rex:this.r in
  829. let step pos =
  830. try
  831. let substrings = exec ~pos s in
  832. let (first,last) = Pcre2.get_substring_ofs substrings 0 in
  833. add !copy_offset first;
  834. copy_offset := last;
  835. let next_start = if pos = last then last + 1 else last in
  836. if next_start >= slength then begin
  837. DynArray.add acc (create_unknown "");
  838. None
  839. end else
  840. Some next_start
  841. with Not_found ->
  842. add !copy_offset slength;
  843. None
  844. in
  845. let rec loop pos =
  846. match step pos with
  847. | Some next ->
  848. if this.r_global then
  849. loop next
  850. else
  851. add !copy_offset slength
  852. | _ ->
  853. ()
  854. in
  855. loop 0;
  856. encode_array (DynArray.to_list acc)
  857. end
  858. )
  859. end
  860. module StdFile = struct
  861. let create_out path binary flags =
  862. let path = decode_string path in
  863. let binary = match binary with
  864. | VTrue | VNull -> true
  865. | _ -> false
  866. in
  867. let perms = 0o666 in
  868. let l = Open_creat :: flags in
  869. let l = if binary then Open_binary :: l else l in
  870. let ch =
  871. try open_out_gen l perms path
  872. with Sys_error msg -> exc_string msg
  873. in
  874. encode_instance key_sys_io_FileOutput ~kind:(IOutChannel ch)
  875. let write_out path content =
  876. try
  877. let ch = open_out_bin path in
  878. output_string ch content;
  879. close_out ch;
  880. vnull
  881. with Sys_error s ->
  882. exc_string s
  883. let append = vfun2 (fun path binary ->
  884. create_out path binary [Open_append]
  885. )
  886. let update = vfun2 (fun path binary ->
  887. create_out path binary [Open_rdonly; Open_wronly]
  888. )
  889. let getBytes = vfun1 (fun path ->
  890. let path = decode_string path in
  891. try encode_bytes (Bytes.unsafe_of_string (Std.input_file ~bin:true path)) with Sys_error _ -> exc_string ("Could not read file " ^ path)
  892. )
  893. let getContent = vfun1 (fun path ->
  894. let path = decode_string path in
  895. try ((create_unknown (Std.input_file ~bin:true path))) with Sys_error _ -> exc_string ("Could not read file " ^ path)
  896. )
  897. let read = vfun2 (fun path binary ->
  898. let path = decode_string path in
  899. let binary = match binary with
  900. | VTrue | VNull -> true
  901. | _ -> false
  902. in
  903. let ch =
  904. try open_in_gen (Open_rdonly :: (if binary then [Open_binary] else [])) 0 path
  905. with Sys_error msg -> exc_string msg
  906. in
  907. encode_instance key_sys_io_FileInput ~kind:(IInChannel(ch,ref false))
  908. )
  909. let saveBytes = vfun2 (fun path bytes ->
  910. let path = decode_string path in
  911. let bytes = decode_bytes bytes in
  912. write_out path (Bytes.unsafe_to_string bytes)
  913. )
  914. let saveContent = vfun2 (fun path content ->
  915. let path = decode_string path in
  916. let content = decode_string content in
  917. write_out path content
  918. )
  919. let write = vfun2 (fun path binary ->
  920. create_out path binary [Open_wronly;Open_trunc]
  921. )
  922. end
  923. module StdFileInput = struct
  924. let raise_eof () =
  925. let v = encode_instance key_haxe_io_Eof in
  926. exc v
  927. let this vthis = match vthis with
  928. | VInstance {ikind = IInChannel(ch,eof)} -> ch,eof
  929. | _ -> unexpected_value vthis "FileInput"
  930. let close = vifun0 (fun vthis ->
  931. close_in (fst (this vthis));
  932. vnull
  933. )
  934. let eof = vifun0 (fun vthis ->
  935. vbool !(snd (this vthis))
  936. )
  937. let seek = vifun2 (fun vthis pos mode ->
  938. let ch,r = this vthis in
  939. r := false;
  940. let pos = decode_int pos in
  941. let mode,_ = decode_enum mode in
  942. seek_in ch (match mode with 0 -> pos | 1 -> pos_in ch + pos | 2 -> in_channel_length ch + pos | _ -> die "" __LOC__);
  943. vnull
  944. )
  945. let tell = vifun0 (fun vthis ->
  946. vint (pos_in (fst (this vthis)))
  947. )
  948. let readByte = vifun0 (fun vthis ->
  949. let ch,r = this vthis in
  950. let i = try
  951. input_char ch
  952. with _ ->
  953. r := true;
  954. raise_eof()
  955. in
  956. vint (int_of_char i)
  957. )
  958. let readBytes = vifun3 (fun vthis bytes pos len ->
  959. let ch,r = this vthis in
  960. let bytes = decode_bytes bytes in
  961. let pos = decode_int pos in
  962. let len = decode_int len in
  963. let i = input ch bytes pos len in
  964. if i = 0 then begin
  965. r := true;
  966. raise_eof()
  967. end;
  968. vint i
  969. )
  970. end
  971. module StdFileOutput = struct
  972. let this vthis = match vthis with
  973. | VInstance {ikind = IOutChannel ch} -> ch
  974. | _ -> unexpected_value vthis "FileOutput"
  975. let close = vifun0 (fun vthis ->
  976. close_out (this vthis);
  977. vnull
  978. )
  979. let flush = vifun0 (fun vthis ->
  980. flush (this vthis);
  981. vnull
  982. )
  983. let seek = vifun2 (fun vthis pos mode ->
  984. let this = this vthis in
  985. let pos = decode_int pos in
  986. let mode,_ = decode_enum mode in
  987. seek_out this (match mode with 0 -> pos | 1 -> pos_out this + pos | 2 -> out_channel_length this + pos | _ -> die "" __LOC__);
  988. vnull
  989. )
  990. let tell = vifun0 (fun vthis ->
  991. vint (pos_out (this vthis))
  992. )
  993. let writeByte = vifun1 (fun vthis c ->
  994. output_char (this vthis) (char_of_int (decode_int c));
  995. vnull
  996. )
  997. let writeBytes = vifun3 (fun vthis bytes pos len ->
  998. let this = this vthis in
  999. let bytes = decode_bytes bytes in
  1000. let pos = decode_int pos in
  1001. let len = decode_int len in
  1002. output this bytes pos len;
  1003. vint len
  1004. )
  1005. end
  1006. module StdFPHelper = struct
  1007. let doubleToI64 = vfun1 (fun v ->
  1008. let f = num v in
  1009. let i64 = Int64.bits_of_float f in
  1010. EvalIntegers.encode_haxe_i64_direct i64
  1011. )
  1012. let floatToI32 = vfun1 (fun f ->
  1013. let f = num f in
  1014. let i32 = Int32.bits_of_float f in
  1015. vint32 i32
  1016. )
  1017. let i32ToFloat = vfun1 (fun i ->
  1018. let i32 = decode_i32 i in
  1019. let f = Int32.float_of_bits i32 in
  1020. vfloat f
  1021. )
  1022. let i64ToDouble = vfun2 (fun low high ->
  1023. let low = decode_i32 low in
  1024. let high = decode_i32 high in
  1025. let b = Bytes.make 8 '0' in
  1026. EvalBytes.write_i32 b 0 low;
  1027. EvalBytes.write_i32 b 4 high;
  1028. let i64 = EvalBytes.read_i64 b 0 in
  1029. vfloat (Int64.float_of_bits i64)
  1030. )
  1031. end
  1032. module StdFileSystem = struct
  1033. let rec remove_trailing_slash p =
  1034. let l = String.length p in
  1035. if l = 0 then
  1036. "" (* don't be retarded *)
  1037. else match p.[l-1] with
  1038. | '\\' | '/' -> remove_trailing_slash (String.sub p 0 (l - 1))
  1039. | _ -> p
  1040. let patch_path s =
  1041. if String.length s > 1 && String.length s <= 3 && s.[1] = ':' then Path.add_trailing_slash s
  1042. else if s = "/" then "/"
  1043. else remove_trailing_slash s
  1044. let createDirectory = vfun1 (fun path ->
  1045. catch_unix_error Path.mkdir_from_path_unix_err (Path.add_trailing_slash (decode_string path));
  1046. vnull
  1047. )
  1048. let deleteDirectory = vfun1 (fun path ->
  1049. catch_unix_error Unix.rmdir (decode_string path);
  1050. vnull
  1051. )
  1052. let deleteFile = vfun1 (fun path ->
  1053. (try Sys.remove (decode_string path) with Sys_error s -> exc_string s);
  1054. vnull
  1055. )
  1056. let exists = vfun1 (fun path ->
  1057. let b = try Sys.file_exists (patch_path (decode_string path)) with Sys_error _ -> false in
  1058. vbool b
  1059. )
  1060. let fullPath = vfun1 (fun relPath ->
  1061. try create_unknown (Extc.get_full_path (decode_string relPath)) with exc -> exc_string (Printexc.to_string exc)
  1062. )
  1063. let isDirectory = vfun1 (fun dir ->
  1064. let b = try Sys.is_directory (patch_path(decode_string dir)) with Sys_error _ -> false in
  1065. vbool b
  1066. )
  1067. let readDirectory = vfun1 (fun dir ->
  1068. let dir = decode_string dir in
  1069. let d = try
  1070. if not (Sys.is_directory (patch_path dir)) then exc_string "No such directory";
  1071. Sys.readdir dir
  1072. with Sys_error s ->
  1073. exc_string s
  1074. in
  1075. encode_array (Array.to_list (Array.map (fun s -> create_unknown s) d))
  1076. )
  1077. let rename = vfun2 (fun path newPath ->
  1078. (try Sys.rename (decode_string path) (decode_string newPath) with Sys_error s -> exc_string s);
  1079. vnull
  1080. )
  1081. let stat = vfun1 (fun path ->
  1082. let s = catch_unix_error Unix.stat (patch_path (decode_string path)) in
  1083. encode_obj [
  1084. key_gid,vint s.st_gid;
  1085. key_uid,vint s.st_uid;
  1086. key_atime,StdDate.encode_date s.st_atime;
  1087. key_mtime,StdDate.encode_date s.st_mtime;
  1088. key_ctime,StdDate.encode_date s.st_ctime;
  1089. key_dev,vint s.st_dev;
  1090. key_ino,vint s.st_ino;
  1091. key_nlink,vint s.st_nlink;
  1092. key_rdev,vint s.st_rdev;
  1093. key_size,vint s.st_size;
  1094. key_mode,vint s.st_perm;
  1095. ]
  1096. )
  1097. end
  1098. module StdGc = struct
  1099. open Gc
  1100. let key_minor_heap_size = hash "minor_heap_size"
  1101. let key_major_heap_increment = hash "major_heap_increment"
  1102. let key_space_overhead = hash "space_overhead"
  1103. let key_verbose = hash "verbose"
  1104. let key_max_overhead = hash "max_overhead"
  1105. let key_stack_limit = hash "stack_limit"
  1106. let key_allocation_policy = hash "allocation_policy"
  1107. let key_minor_words = hash "minor_words"
  1108. let key_minor_words = hash "minor_words"
  1109. let key_promoted_words = hash "promoted_words"
  1110. let key_major_words = hash "major_words"
  1111. let key_minor_collections = hash "minor_collections"
  1112. let key_major_collections = hash "major_collections"
  1113. let key_heap_words = hash "heap_words"
  1114. let key_heap_chunks = hash "heap_chunks"
  1115. let key_live_words = hash "live_words"
  1116. let key_live_blocks = hash "live_blocks"
  1117. let key_free_words = hash "free_words"
  1118. let key_free_blocks = hash "free_blocks"
  1119. let key_largest_free = hash "largest_free"
  1120. let key_fragments = hash "fragments"
  1121. let key_compactions = hash "compactions"
  1122. let key_top_heap_words = hash "top_heap_words"
  1123. let key_stack_size = hash "stack_size"
  1124. let encode_stats stats =
  1125. encode_obj [
  1126. key_minor_words,vfloat stats.minor_words;
  1127. key_promoted_words,vfloat stats.promoted_words;
  1128. key_major_words,vfloat stats.major_words;
  1129. key_minor_collections,vint stats.minor_collections;
  1130. key_major_collections,vint stats.major_collections;
  1131. key_heap_words,vint stats.heap_words;
  1132. key_heap_chunks,vint stats.heap_chunks;
  1133. key_live_words,vint stats.live_words;
  1134. key_live_blocks,vint stats.live_blocks;
  1135. key_free_words,vint stats.free_words;
  1136. key_free_blocks,vint stats.free_blocks;
  1137. key_largest_free,vint stats.largest_free;
  1138. key_fragments,vint stats.fragments;
  1139. key_compactions,vint stats.compactions;
  1140. key_top_heap_words,vint stats.top_heap_words;
  1141. key_stack_size,vint stats.stack_size;
  1142. ]
  1143. let allocated_bytes = vfun0 (fun () -> vfloat (Gc.allocated_bytes()))
  1144. let compact = vfun0 (fun () -> Gc.compact(); vnull )
  1145. let counters = vfun0 (fun () ->
  1146. let (minor_words,promoted_words,major_words) = Gc.counters() in
  1147. encode_obj [
  1148. key_minor_words,vfloat minor_words;
  1149. key_promoted_words,vfloat promoted_words;
  1150. key_major_words,vfloat major_words;
  1151. ]
  1152. )
  1153. let finalise = vfun2 (fun f v ->
  1154. let f = fun v ->
  1155. ignore(call_value f [v])
  1156. in
  1157. Gc.finalise f v;
  1158. vnull
  1159. )
  1160. let finalise_release = vfun0 (fun () ->
  1161. Gc.finalise_release();
  1162. vnull
  1163. )
  1164. let full_major = vfun0 (fun () -> Gc.full_major(); vnull )
  1165. let get = vfun0 (fun () ->
  1166. let control = Gc.get() in
  1167. encode_obj [
  1168. key_minor_heap_size,vint control.minor_heap_size;
  1169. key_major_heap_increment,vint control.major_heap_increment;
  1170. key_space_overhead,vint control.space_overhead;
  1171. key_verbose,vint control.verbose;
  1172. key_max_overhead,vint control.max_overhead;
  1173. key_stack_limit,vint control.stack_limit;
  1174. key_allocation_policy,vint control.allocation_policy;
  1175. ]
  1176. )
  1177. let major = vfun0 (fun () -> Gc.major(); vnull )
  1178. let major_slice = vfun1 (fun n -> vint (Gc.major_slice (decode_int n)))
  1179. let minor = vfun0 (fun () -> Gc.minor(); vnull )
  1180. let print_stat = vfun1 (fun out_channel ->
  1181. let out_channel = match out_channel with
  1182. | VInstance {ikind = IOutChannel ch} -> ch
  1183. | _ -> unexpected_value out_channel "Output"
  1184. in
  1185. Gc.print_stat out_channel;
  1186. vnull
  1187. )
  1188. let quick_stat = vfun0 (fun () -> encode_stats (Gc.quick_stat()))
  1189. let set = vfun1 (fun r ->
  1190. let r = decode_object r in
  1191. let field key = decode_int (object_field r key) in
  1192. let control = { (Gc.get()) with
  1193. minor_heap_size = field key_minor_heap_size;
  1194. major_heap_increment = field key_major_heap_increment;
  1195. space_overhead = field key_space_overhead;
  1196. verbose = field key_verbose;
  1197. max_overhead = field key_max_overhead;
  1198. stack_limit = field key_stack_limit;
  1199. } in
  1200. (* Awkward hack to avoid warning. *)
  1201. let control = {control with allocation_policy = field key_allocation_policy} in
  1202. Gc.set control;
  1203. vnull
  1204. )
  1205. let stat = vfun0 (fun () -> encode_stats (Gc.stat()))
  1206. end
  1207. module StdHost = struct
  1208. let int32_addr h =
  1209. let base = Int32.to_int (Int32.logand h 0xFFFFFFl) in
  1210. let str = Printf.sprintf "%ld.%d.%d.%d" (Int32.shift_right_logical h 24) (base lsr 16) ((base lsr 8) land 0xFF) (base land 0xFF) in
  1211. catch_unix_error Unix.inet_addr_of_string str
  1212. let localhost = vfun0 (fun () ->
  1213. create_unknown (catch_unix_error Unix.gethostname())
  1214. )
  1215. let hostReverse = vfun1 (fun ip ->
  1216. let ip = decode_i32 ip in
  1217. try create_unknown (catch_unix_error Unix.gethostbyaddr (int32_addr ip)).h_name with Not_found -> exc_string "Could not reverse host"
  1218. )
  1219. let hostToString = vfun1 (fun ip ->
  1220. let ip = decode_i32 ip in
  1221. create_unknown (catch_unix_error Unix.string_of_inet_addr (int32_addr ip))
  1222. )
  1223. let resolve = vfun1 (fun name ->
  1224. let name = decode_string name in
  1225. let h = catch_unix_error Unix.gethostbyname name in
  1226. let addr = catch_unix_error Unix.string_of_inet_addr h.h_addr_list.(0) in
  1227. let a, b, c, d = Scanf.sscanf addr "%d.%d.%d.%d" (fun a b c d -> a,b,c,d) in
  1228. vint32 (Int32.logor (Int32.shift_left (Int32.of_int a) 24) (Int32.of_int (d lor (c lsl 8) lor (b lsl 16))))
  1229. )
  1230. end
  1231. module StdLock = struct
  1232. let this vthis = match vthis with
  1233. | VInstance {ikind = ILock lock} -> lock
  1234. | v -> unexpected_value v "Lock"
  1235. let release = vifun0 (fun vthis ->
  1236. let this = this vthis in
  1237. Deque.push this.ldeque vnull;
  1238. vnull
  1239. )
  1240. let wait = vifun1 (fun vthis timeout ->
  1241. let lock = this vthis in
  1242. let rec loop target_time =
  1243. match Deque.pop lock.ldeque false with
  1244. | None ->
  1245. if Sys.time() >= target_time then
  1246. vfalse
  1247. else begin
  1248. Thread.yield();
  1249. loop target_time
  1250. end
  1251. | Some _ ->
  1252. vtrue
  1253. in
  1254. match Deque.pop lock.ldeque false with
  1255. | None ->
  1256. begin match timeout with
  1257. | VNull ->
  1258. ignore(Deque.pop lock.ldeque true);
  1259. vtrue
  1260. | _ ->
  1261. let target_time = (Sys.time()) +. num timeout in
  1262. loop target_time
  1263. end
  1264. | Some _ ->
  1265. vtrue
  1266. )
  1267. end
  1268. let lineEnd = match Sys.os_type with
  1269. | "Win32" | "Cygwin" -> "\r\n"
  1270. | _ -> "\n"
  1271. module StdLog = struct
  1272. let key_fileName = hash "fileName"
  1273. let key_lineNumber = hash "lineNumber"
  1274. let key_customParams = hash "customParams"
  1275. let trace = vfun2 (fun v infos ->
  1276. let s = value_string v in
  1277. let s = match infos with
  1278. | VNull -> (Printf.sprintf "%s" s) ^ lineEnd
  1279. | _ -> let infos = decode_object infos in
  1280. let file_name = decode_string (object_field infos key_fileName) in
  1281. let line_number = decode_int (object_field infos key_lineNumber) in
  1282. let l = match object_field infos key_customParams with
  1283. | VArray va -> s :: (List.map value_string (EvalArray.to_list va))
  1284. | _ -> [s]
  1285. in
  1286. (Printf.sprintf "%s:%i: %s" file_name line_number (String.concat "," l)) ^ lineEnd in
  1287. ((get_ctx()).curapi.MacroApi.get_com()).Common.print s;
  1288. vnull
  1289. )
  1290. end
  1291. let encode_list_iterator l =
  1292. let l = ref l in
  1293. encode_obj [
  1294. key_hasNext,vifun0 (fun _ ->
  1295. match !l with [] -> vfalse | _ -> vtrue
  1296. );
  1297. key_next,vifun0 (fun _ -> match !l with
  1298. | [] -> vnull
  1299. | v :: l' -> l := l'; v
  1300. )
  1301. ]
  1302. let map_key_value_iterator path = vifun0 (fun vthis ->
  1303. let ctx = get_ctx() in
  1304. let vit = encode_instance path in
  1305. let fnew = get_instance_constructor ctx path null_pos in
  1306. ignore(call_value_on vit (Lazy.force fnew) [vthis]);
  1307. vit
  1308. )
  1309. module StdIntMap = struct
  1310. let this vthis = match vthis with
  1311. | VInstance {ikind = IIntMap h} -> h
  1312. | v -> unexpected_value v "int map"
  1313. let copy = vifun0 (fun vthis ->
  1314. let copied = IntHashtbl.copy (this vthis) in
  1315. encode_int_map_direct copied
  1316. )
  1317. let exists = vifun1 (fun vthis vkey ->
  1318. vbool (IntHashtbl.mem (this vthis) (decode_int vkey))
  1319. )
  1320. let get = vifun1 (fun vthis vkey ->
  1321. try IntHashtbl.find (this vthis) (decode_int vkey)
  1322. with Not_found -> vnull
  1323. )
  1324. let iterator = vifun0 (fun vthis ->
  1325. let keys = IntHashtbl.fold (fun _ v acc -> v :: acc) (this vthis) [] in
  1326. encode_list_iterator keys
  1327. )
  1328. let keys = vifun0 (fun vthis ->
  1329. let keys = IntHashtbl.fold (fun k _ acc -> vint k :: acc) (this vthis) [] in
  1330. encode_list_iterator keys
  1331. )
  1332. let keyValueIterator = map_key_value_iterator key_haxe_iterators_map_key_value_iterator
  1333. let remove = vifun1 (fun vthis vkey ->
  1334. let this = this vthis in
  1335. let key = decode_int vkey in
  1336. let b = IntHashtbl.mem this key in
  1337. IntHashtbl.remove this key;
  1338. vbool b
  1339. )
  1340. let set = vifun2 (fun vthis vkey vvalue ->
  1341. IntHashtbl.add (this vthis) (decode_int vkey) vvalue;
  1342. vnull
  1343. )
  1344. let toString = vifun0 (fun vthis ->
  1345. let this = this vthis in
  1346. let l = IntHashtbl.fold (fun key vvalue acc ->
  1347. (join empty_string [create_ascii (string_of_int key); create_ascii " => "; s_value 0 vvalue]) :: acc) this [] in
  1348. let s = join rcomma l in
  1349. let s = join empty_string [rbropen;s;rbrclose] in
  1350. vstring s
  1351. )
  1352. let clear = vifun0 (fun vthis ->
  1353. IntHashtbl.clear (this vthis);
  1354. vnull
  1355. )
  1356. end
  1357. module StdStringMap = struct
  1358. let this vthis = match vthis with
  1359. | VInstance {ikind = IStringMap h} -> h
  1360. | v -> unexpected_value v "string map"
  1361. let copy = vifun0 (fun vthis ->
  1362. let copied = StringHashtbl.copy (this vthis) in
  1363. encode_string_map_direct copied
  1364. )
  1365. let exists = vifun1 (fun vthis vkey ->
  1366. vbool (StringHashtbl.mem (this vthis) (decode_vstring vkey))
  1367. )
  1368. let get = vifun1 (fun vthis vkey ->
  1369. try snd (StringHashtbl.find (this vthis) (decode_vstring vkey))
  1370. with Not_found -> vnull
  1371. )
  1372. let iterator = vifun0 (fun vthis ->
  1373. let keys = StringHashtbl.fold (fun _ (_,v) acc -> v :: acc) (this vthis) [] in
  1374. encode_list_iterator keys
  1375. )
  1376. let keys = vifun0 (fun vthis ->
  1377. let keys = StringHashtbl.fold (fun _ (k,_) acc -> vstring k :: acc) (this vthis) [] in
  1378. encode_list_iterator keys
  1379. )
  1380. let keyValueIterator = map_key_value_iterator key_haxe_iterators_map_key_value_iterator
  1381. let remove = vifun1 (fun vthis vkey ->
  1382. let this = this vthis in
  1383. let key = decode_vstring vkey in
  1384. let b = StringHashtbl.mem this key in
  1385. StringHashtbl.remove this key;
  1386. vbool b
  1387. )
  1388. let set = vifun2 (fun vthis vkey vvalue ->
  1389. StringHashtbl.add (this vthis) (decode_vstring vkey) vvalue;
  1390. vnull
  1391. )
  1392. let toString = vifun0 (fun vthis ->
  1393. let this = this vthis in
  1394. let l = StringHashtbl.fold (fun _ (key,vvalue) acc ->
  1395. (join empty_string [key; create_ascii " => "; s_value 0 vvalue]) :: acc) this [] in
  1396. let s = join rcomma l in
  1397. let s = join empty_string [rbropen;s;rbrclose] in
  1398. vstring s
  1399. )
  1400. let clear = vifun0 (fun vthis ->
  1401. StringHashtbl.clear (this vthis);
  1402. vnull
  1403. )
  1404. end
  1405. module StdObjectMap = struct
  1406. let this vthis = match vthis with
  1407. | VInstance {ikind = IObjectMap h} -> Obj.magic h
  1408. | v -> unexpected_value v "int map"
  1409. let copy = vifun0 (fun vthis ->
  1410. let copied = ValueHashtbl.copy (this vthis) in
  1411. encode_object_map_direct copied
  1412. )
  1413. let exists = vifun1 (fun vthis vkey ->
  1414. vbool (ValueHashtbl.mem (this vthis) vkey)
  1415. )
  1416. let get = vifun1 (fun vthis vkey ->
  1417. try ValueHashtbl.find (this vthis) vkey
  1418. with Not_found -> vnull
  1419. )
  1420. let iterator = vifun0 (fun vthis ->
  1421. let keys = ValueHashtbl.fold (fun _ v acc -> v :: acc) (this vthis) [] in
  1422. encode_list_iterator keys
  1423. )
  1424. let keys = vifun0 (fun vthis ->
  1425. let keys = ValueHashtbl.fold (fun k _ acc -> k :: acc) (this vthis) [] in
  1426. encode_list_iterator keys
  1427. )
  1428. let keyValueIterator = map_key_value_iterator key_haxe_iterators_map_key_value_iterator
  1429. let remove = vifun1 (fun vthis vkey ->
  1430. let this = this vthis in
  1431. let b = ValueHashtbl.mem this vkey in
  1432. ValueHashtbl.remove this vkey;
  1433. vbool b
  1434. )
  1435. let set = vifun2 (fun vthis vkey vvalue ->
  1436. ValueHashtbl.replace (this vthis) vkey vvalue;
  1437. vnull
  1438. )
  1439. let toString = vifun0 (fun vthis ->
  1440. let this = this vthis in
  1441. let l = ValueHashtbl.fold (fun key vvalue acc ->
  1442. (join empty_string [s_value 0 key; create_ascii " => "; s_value 0 vvalue]) :: acc) this [] in
  1443. let s = join rcomma l in
  1444. let s = join empty_string [rbropen;s;rbrclose] in
  1445. vstring s
  1446. )
  1447. let clear = vifun0 (fun vthis ->
  1448. ValueHashtbl.reset (this vthis);
  1449. vnull
  1450. )
  1451. end
  1452. let random = Random.State.make_self_init()
  1453. module StdMath = struct
  1454. let to_int f = Int32.of_float (mod_float f 2147483648.0)
  1455. let nan = vfloat nan
  1456. let negative_infinity = vfloat neg_infinity
  1457. let pi = vfloat (4.0 *. atan 1.0)
  1458. let positive_infinity = vfloat infinity
  1459. let abs = vfun1 (fun v ->
  1460. match v with
  1461. | VInt32 i -> vint32 (Int32.abs i)
  1462. | VFloat f -> vfloat (abs_float f)
  1463. | _ -> unexpected_value v "number"
  1464. )
  1465. let acos = vfun1 (fun v -> vfloat (acos (num v)))
  1466. let asin = vfun1 (fun v -> vfloat (asin (num v)))
  1467. let atan = vfun1 (fun v -> vfloat (atan (num v)))
  1468. let atan2 = vfun2 (fun a b -> vfloat (atan2 (num a) (num b)))
  1469. let ceil = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (ceil (num v))))
  1470. let cos = vfun1 (fun v -> vfloat (cos (num v)))
  1471. let exp = vfun1 (fun v -> vfloat (exp (num v)))
  1472. let fceil = vfun1 (fun v -> vfloat (Pervasives.ceil (num v)))
  1473. let ffloor = vfun1 (fun v -> vfloat (Pervasives.floor (num v)))
  1474. let floor = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (floor (num v))))
  1475. let fround = vfun1 (fun v -> vfloat (Pervasives.floor (num v +. 0.5)))
  1476. let isFinite = vfun1 (fun v -> vbool (match v with VFloat f -> f <> infinity && f <> neg_infinity && f = f | _ -> true))
  1477. let isNaN = vfun1 (fun v -> vbool (match v with VFloat f -> f <> f | VInt32 _ -> false | _ -> true))
  1478. let log = vfun1 (fun v -> vfloat (Pervasives.log (num v)))
  1479. let max = vfun2 (fun a b ->
  1480. let a = num a in
  1481. let b = num b in
  1482. vfloat (if a < b then b else if b <> b then b else a);
  1483. )
  1484. let min = vfun2 (fun a b ->
  1485. let a = num a in
  1486. let b = num b in
  1487. vfloat (if a < b then a else if a <> a then a else b);
  1488. )
  1489. let pow = vfun2 (fun a b -> vfloat ((num a) ** (num b)))
  1490. let random = vfun0 (fun () -> vfloat (Random.State.float random 1.))
  1491. let round = vfun1 (fun v -> match v with VInt32 _ -> v | _ -> vint32 (to_int (Pervasives.floor (num v +. 0.5))))
  1492. let sin = vfun1 (fun v -> vfloat (sin (num v)))
  1493. let sqrt = vfun1 (fun v ->
  1494. let v = num v in
  1495. if v < 0. then nan else vfloat (sqrt v)
  1496. )
  1497. let tan = vfun1 (fun v -> vfloat (tan (num v)))
  1498. end
  1499. module StdMd5 = struct
  1500. let encode = vfun1 (fun s ->
  1501. let s = decode_string s in
  1502. encode_string (Digest.to_hex (Digest.string s))
  1503. )
  1504. let make = vfun1 (fun b ->
  1505. let b = decode_bytes b in
  1506. encode_bytes (Bytes.unsafe_of_string (Digest.string (Bytes.unsafe_to_string b)))
  1507. )
  1508. end
  1509. module StdMutex = struct
  1510. let this vthis = match vthis with
  1511. | VInstance {ikind=IMutex mutex} -> mutex
  1512. | _ -> unexpected_value vthis "Mutex"
  1513. let acquire = vifun0 (fun vthis ->
  1514. let mutex = this vthis in
  1515. let thread_id = Thread.id (Thread.self()) in
  1516. (match mutex.mowner with
  1517. | None ->
  1518. Mutex.lock mutex.mmutex;
  1519. mutex.mowner <- Some (thread_id,1)
  1520. | Some (id,n) ->
  1521. if id = thread_id then
  1522. mutex.mowner <- Some (thread_id,n + 1)
  1523. else begin
  1524. Mutex.lock mutex.mmutex;
  1525. mutex.mowner <- Some (thread_id,1)
  1526. end
  1527. );
  1528. vnull
  1529. )
  1530. let release = vifun0 (fun vthis ->
  1531. let mutex = this vthis in
  1532. (match mutex.mowner with
  1533. | Some (id,n) when n > 1 ->
  1534. mutex.mowner <- Some (id,n - 1)
  1535. | _ ->
  1536. mutex.mowner <- None;
  1537. Mutex.unlock mutex.mmutex;
  1538. );
  1539. vnull
  1540. )
  1541. let tryAcquire = vifun0 (fun vthis ->
  1542. let mutex = this vthis in
  1543. let thread_id = Thread.id (Thread.self()) in
  1544. match mutex.mowner with
  1545. | Some (id,n) when id = thread_id ->
  1546. mutex.mowner <- Some (thread_id,n + 1);
  1547. vtrue
  1548. | _ ->
  1549. if Mutex.try_lock mutex.mmutex then begin
  1550. mutex.mowner <- Some (thread_id,1);
  1551. vtrue
  1552. end else
  1553. vfalse
  1554. )
  1555. end
  1556. module StdNativeProcess = struct
  1557. let this vthis = match vthis with
  1558. | VInstance {ikind=IProcess proc} -> proc
  1559. | _ -> unexpected_value vthis "NativeProcess"
  1560. let call f vthis bytes pos len =
  1561. let this = this vthis in
  1562. let bytes = decode_bytes bytes in
  1563. let pos = decode_int pos in
  1564. let len = decode_int len in
  1565. f this (Bytes.unsafe_to_string bytes) pos len
  1566. let process_catch f vthis =
  1567. try f (this vthis)
  1568. with Failure msg -> exc_string msg
  1569. let close = vifun0 (fun vthis ->
  1570. process_catch Process.close vthis;
  1571. vnull
  1572. )
  1573. let exitCode = vifun0 (fun vthis ->
  1574. vint (process_catch Process.exit vthis)
  1575. )
  1576. let getPid = vifun0 (fun vthis ->
  1577. vint (process_catch Process.pid vthis)
  1578. )
  1579. let kill = vifun0 (fun vthis ->
  1580. process_catch Process.kill vthis;
  1581. vnull
  1582. )
  1583. let readStderr = vifun3 (fun vthis bytes pos len ->
  1584. try vint (call Process.read_stderr vthis bytes pos len) with _ -> exc_string "Could not read stderr"
  1585. )
  1586. let readStdout = vifun3 (fun vthis bytes pos len ->
  1587. try vint (call Process.read_stdout vthis bytes pos len) with _ -> exc_string "Could not read stdout"
  1588. )
  1589. let closeStdin = vifun0 (fun vthis ->
  1590. process_catch Process.close_stdin vthis;
  1591. vnull
  1592. )
  1593. let writeStdin = vifun3 (fun vthis bytes pos len ->
  1594. vint (call Process.write_stdin vthis bytes pos len)
  1595. )
  1596. end
  1597. module StdReflect = struct
  1598. let r_get_ = create_ascii "get_"
  1599. let r_set_ = create_ascii "set_"
  1600. let callMethod = vfun3 (fun o f args ->
  1601. call_value_on o f (decode_array args)
  1602. )
  1603. let compare = vfun2 (fun a b ->
  1604. vint (match compare a b with
  1605. | CEq -> 0
  1606. | CInf -> -1
  1607. | CSup -> 1
  1608. | CUndef -> -1)
  1609. )
  1610. let compareMethods = vfun2 (fun a b ->
  1611. let rec loop a b = a == b || match a,b with
  1612. | VFunction(f1,_),VFunction(f2,_) -> f1 == f2
  1613. | VFieldClosure(v1,f1),VFieldClosure(v2,f2) -> f1 == f2 && EvalMisc.compare v1 v2 = CEq
  1614. | _ -> false
  1615. in
  1616. vbool (loop a b)
  1617. )
  1618. let copy = vfun1 (fun o -> match vresolve o with
  1619. | VNull -> VNull
  1620. | VObject o -> VObject { o with ofields = Array.copy o.ofields }
  1621. | VInstance vi -> vinstance {
  1622. ifields = Array.copy vi.ifields;
  1623. iproto = vi.iproto;
  1624. ikind = vi.ikind;
  1625. }
  1626. | VString _ -> o
  1627. | VArray va -> VArray { va with avalues = Array.copy va.avalues }
  1628. | VVector vv -> VVector (Array.copy vv)
  1629. | _ -> unexpected_value o "object"
  1630. )
  1631. let deleteField = vfun2 (fun o name ->
  1632. let name = hash (decode_vstring name).sstring in
  1633. match vresolve o with
  1634. | VObject o ->
  1635. begin match o.oproto with
  1636. | OProto proto ->
  1637. let found = ref false in
  1638. let fields = IntMap.fold (fun name' i acc ->
  1639. if name = name' then begin
  1640. found := true;
  1641. acc
  1642. end else
  1643. (name',o.ofields.(i)) :: acc
  1644. ) proto.pinstance_names [] in
  1645. if !found then begin
  1646. update_object_prototype o fields;
  1647. vtrue
  1648. end else
  1649. vfalse
  1650. | ODictionary d ->
  1651. let has = IntMap.mem name d in
  1652. if has then o.oproto <- ODictionary (IntMap.remove name d);
  1653. vbool has
  1654. end
  1655. | _ ->
  1656. vfalse
  1657. )
  1658. let field' = vfun2 (fun o name ->
  1659. if o = vnull then vnull else dynamic_field o (hash (decode_vstring name).sstring)
  1660. )
  1661. let fields = vfun1 (fun o ->
  1662. let proto_fields proto = IntMap.fold (fun name _ acc -> name :: acc) proto.pnames [] in
  1663. let fields = match vresolve o with
  1664. | VObject o -> List.map fst (object_fields o)
  1665. | VInstance vi -> IntMap.fold (fun name _ acc -> name :: acc) vi.iproto.pinstance_names []
  1666. | VPrototype proto -> proto_fields proto
  1667. | VNull -> []
  1668. | VString _ | VArray _ | VVector _ -> [key_length]
  1669. | _ -> unexpected_value o "object"
  1670. in
  1671. encode_array (List.map (fun i -> encode_string (rev_hash i)) fields)
  1672. )
  1673. let getProperty = vfun2 (fun o name ->
  1674. if o = VNull then
  1675. vnull
  1676. else begin
  1677. let name = decode_vstring name in
  1678. let name_get = hash (concat r_get_ name).sstring in
  1679. let vget = field o name_get in
  1680. if vget <> VNull then call_value_on o vget []
  1681. else dynamic_field o (hash name.sstring)
  1682. end
  1683. )
  1684. let hasField = vfun2 (fun o field ->
  1685. let name = hash (decode_vstring field).sstring in
  1686. let b = match vresolve o with
  1687. | VObject o ->
  1688. begin match o.oproto with
  1689. | OProto proto -> IntMap.mem name proto.pinstance_names
  1690. | ODictionary d -> IntMap.mem name d
  1691. end
  1692. | VInstance vi -> IntMap.mem name vi.iproto.pinstance_names || IntMap.mem name vi.iproto.pnames
  1693. | VPrototype proto -> IntMap.mem name proto.pnames
  1694. | _ -> false (* issue #10993 *)
  1695. in
  1696. vbool b
  1697. )
  1698. let isEnumValue = vfun1 (fun v -> match v with
  1699. | VEnumValue _ -> vtrue
  1700. | _ -> vfalse
  1701. )
  1702. let isFunction = vfun1 (fun f ->
  1703. match f with
  1704. | VFunction _ | VFieldClosure _ -> vtrue
  1705. | _ -> vfalse
  1706. )
  1707. let isObject = vfun1 (fun v -> match vresolve v with
  1708. | VObject _ | VString _ | VArray _ | VVector _ | VInstance _ | VPrototype _ -> vtrue
  1709. | _ -> vfalse
  1710. )
  1711. let makeVarArgs = vfun1 (fun f ->
  1712. vstatic_function ((fun vl -> call_value f [encode_array vl]))
  1713. )
  1714. let setField = vfun3 (fun o name v ->
  1715. (try set_field_runtime o (hash (decode_vstring name).sstring) v with Not_found -> ()); vnull
  1716. )
  1717. let setProperty = vfun3 (fun o name v ->
  1718. let name = decode_vstring name in
  1719. let name_set = hash (concat r_set_ name).sstring in
  1720. let vset = field o name_set in
  1721. if vset <> VNull then call_value_on o vset [v]
  1722. else begin
  1723. (try set_field_runtime o (hash name.sstring) v with Not_found -> ());
  1724. vnull
  1725. end
  1726. )
  1727. end
  1728. module StdResource = struct
  1729. open Common
  1730. let listNames = vfun0 (fun () ->
  1731. encode_array (List.map create_unknown (hashtbl_keys ((get_ctx()).curapi.MacroApi.get_com()).resources))
  1732. )
  1733. let getString = vfun1 (fun name ->
  1734. try ((create_unknown (Hashtbl.find ((get_ctx()).curapi.MacroApi.get_com()).resources (decode_string name)))) with Not_found -> vnull
  1735. )
  1736. let getBytes = vfun1 (fun name ->
  1737. try encode_bytes (Bytes.unsafe_of_string (Hashtbl.find ((get_ctx()).curapi.MacroApi.get_com()).resources (decode_string name))) with Not_found -> vnull
  1738. )
  1739. end
  1740. module StdSha1 = struct
  1741. let encode = vfun1 (fun s ->
  1742. let s = decode_string s in
  1743. encode_string (Sha1.to_hex (Sha1.string s))
  1744. )
  1745. let make = vfun1 (fun b ->
  1746. let b = decode_bytes b in
  1747. encode_bytes (Bytes.unsafe_of_string (Sha1.to_bin (Sha1.string (Bytes.unsafe_to_string b))))
  1748. )
  1749. end
  1750. module StdSocket = struct
  1751. let inet_addr_to_int32 addr =
  1752. let s = catch_unix_error Unix.string_of_inet_addr addr in
  1753. match List.map Int32.of_string (ExtString.String.nsplit s ".") with
  1754. | [a;b;c;d] -> Int32.add (Int32.add (Int32.add (Int32.shift_left a 24) (Int32.shift_left b 16)) (Int32.shift_left c 8)) d
  1755. | _ -> die "" __LOC__
  1756. let this vthis = match vthis with
  1757. | VInstance {ikind = ISocket sock} -> sock
  1758. | _ -> unexpected_value vthis "NativeSocket"
  1759. let accept = vifun0 (fun vthis ->
  1760. let this = this vthis in
  1761. let socket,_ = catch_unix_error Unix.accept this in
  1762. encode_instance key_eval_vm_NativeSocket ~kind:(ISocket socket)
  1763. )
  1764. let bind = vifun2 (fun vthis host port ->
  1765. let this = this vthis in
  1766. let host = decode_i32 host in
  1767. let port = decode_int port in
  1768. catch_unix_error Unix.bind this (ADDR_INET (StdHost.int32_addr host,port));
  1769. vnull
  1770. )
  1771. let close = vifun0 (fun vthis ->
  1772. catch_unix_error Unix.close (this vthis);
  1773. vnull
  1774. )
  1775. let connect = vifun2 (fun vthis host port ->
  1776. let this = this vthis in
  1777. let host = decode_i32 host in
  1778. let port = decode_int port in
  1779. catch_unix_error (Unix.connect this) (ADDR_INET (StdHost.int32_addr host,port));
  1780. vnull
  1781. )
  1782. let host = vifun0 (fun vthis ->
  1783. match catch_unix_error Unix.getsockname (this vthis) with
  1784. | ADDR_INET (addr,port) ->
  1785. encode_obj [
  1786. key_ip,vint32 (inet_addr_to_int32 addr);
  1787. key_port,vint port;
  1788. ]
  1789. | _ -> die "" __LOC__
  1790. )
  1791. let listen = vifun1 (fun vthis connections ->
  1792. let this = this vthis in
  1793. let connections = decode_int connections in
  1794. catch_unix_error Unix.listen this connections;
  1795. vnull
  1796. )
  1797. let peer = vifun0 (fun vthis ->
  1798. match catch_unix_error Unix.getpeername (this vthis) with
  1799. | ADDR_INET (addr,port) ->
  1800. encode_obj [
  1801. key_ip,vint32 (inet_addr_to_int32 addr);
  1802. key_port,vint port;
  1803. ]
  1804. | _ -> die "" __LOC__
  1805. )
  1806. let receive = vifun3 (fun vthis buf pos len ->
  1807. let this = this vthis in
  1808. let buf = decode_bytes buf in
  1809. let pos = decode_int pos in
  1810. let len = decode_int len in
  1811. vint (catch_unix_error Unix.recv this buf pos len [])
  1812. )
  1813. let receiveChar = vifun0 (fun vthis ->
  1814. let buf = Bytes.make 1 '\000' in
  1815. ignore(catch_unix_error Unix.recv (this vthis) buf 0 1 []);
  1816. vint (int_of_char (Bytes.unsafe_get buf 0))
  1817. )
  1818. let select = vfun4 (fun read write others timeout ->
  1819. let proto = get_instance_prototype (get_ctx()) key_sys_net_Socket null_pos in
  1820. let i = get_instance_field_index proto key_socket null_pos in
  1821. let pair = function
  1822. | VInstance vi as v -> this vi.ifields.(i),v
  1823. | v -> unexpected_value v "NativeSocket"
  1824. in
  1825. let decode_optional_array = function
  1826. | VNull -> []
  1827. | VArray va -> EvalArray.to_list va
  1828. | v -> unexpected_value v "array"
  1829. in
  1830. let read = List.map pair (decode_optional_array read) in
  1831. let write = List.map pair (decode_optional_array write) in
  1832. let others = List.map pair (decode_optional_array others) in
  1833. let timeout = match timeout with VNull -> 0. | VInt32 i -> Int32.to_float i | VFloat f -> f | _ -> unexpected_value timeout "number" in
  1834. let read',write',others' = catch_unix_error Unix.select (List.map fst read) (List.map fst write) (List.map fst others) timeout in
  1835. let read = List.map (fun sock -> List.assq sock read) read' in
  1836. let write = List.map (fun sock -> List.assq sock write) write' in
  1837. let others = List.map (fun sock -> List.assq sock others) others' in
  1838. encode_obj [
  1839. key_read,encode_array read;
  1840. key_write,encode_array write;
  1841. key_others,encode_array others;
  1842. ]
  1843. )
  1844. let send = vifun3 (fun vthis buf pos len ->
  1845. let this = this vthis in
  1846. let buf = decode_bytes buf in
  1847. let pos = decode_int pos in
  1848. let len = decode_int len in
  1849. vint (catch_unix_error Unix.send this buf pos len [])
  1850. )
  1851. let sendChar = vifun1 (fun vthis char ->
  1852. let this = this vthis in
  1853. let char = decode_int char in
  1854. ignore(catch_unix_error Unix.send this (Bytes.make 1 (char_of_int char)) 0 1 []);
  1855. VNull
  1856. )
  1857. let setFastSend = vifun1 (fun vthis b ->
  1858. let this = this vthis in
  1859. let b = decode_bool b in
  1860. catch_unix_error Unix.setsockopt this TCP_NODELAY b;
  1861. vnull
  1862. )
  1863. let setBroadcast = vifun1 (fun vthis b ->
  1864. let this = this vthis in
  1865. let b = decode_bool b in
  1866. catch_unix_error Unix.setsockopt this SO_BROADCAST b;
  1867. vnull
  1868. )
  1869. let setTimeout = vifun1 (fun vthis timeout ->
  1870. let this = this vthis in
  1871. let timeout = match timeout with VNull -> 0. | VInt32 i -> Int32.to_float i | VFloat f -> f | _ -> unexpected_value timeout "number" in
  1872. let timeout = timeout *. 1000. in
  1873. catch_unix_error (fun () ->
  1874. Unix.setsockopt_float this SO_RCVTIMEO timeout;
  1875. Unix.setsockopt_float this SO_SNDTIMEO timeout;
  1876. ) ();
  1877. vnull
  1878. )
  1879. let shutdown = vifun2 (fun vthis read write ->
  1880. let this = this vthis in
  1881. let mode = match read,write with
  1882. | VTrue,VTrue -> Unix.SHUTDOWN_ALL
  1883. | VTrue,_ -> SHUTDOWN_RECEIVE
  1884. | _,VTrue -> SHUTDOWN_SEND
  1885. | _ -> exc_string "Nothing to shut down"
  1886. in
  1887. catch_unix_error Unix.shutdown this mode;
  1888. vnull
  1889. )
  1890. end
  1891. module StdStd = struct
  1892. let isOfType = vfun2 (fun v t -> match t with
  1893. | VNull -> vfalse
  1894. | VPrototype proto -> vbool (is v proto.ppath)
  1895. | _ -> vfalse
  1896. )
  1897. let is' = isOfType
  1898. let downcast = vfun2 (fun v t -> match t with
  1899. | VPrototype proto ->
  1900. if is v proto.ppath then v else vnull
  1901. | _ -> vfalse
  1902. )
  1903. let instance = downcast
  1904. let string = vfun1 (fun v -> match v with
  1905. | VString _ -> v
  1906. | _ -> vstring (s_value 0 v)
  1907. )
  1908. let int = vfun1 (fun v ->
  1909. try vint (int_of_float (num v)) with _ -> vnull
  1910. )
  1911. let parseInt = vfun1 (fun v ->
  1912. try vint32 (Numeric.parse_int (decode_string v)) with _ -> vnull
  1913. )
  1914. let parseFloat = vfun1 (fun v ->
  1915. try vfloat (Numeric.parse_float (decode_string v)) with _ -> vfloat nan
  1916. )
  1917. let random = vfun1 (fun v ->
  1918. let v = decode_i32 v in
  1919. vint32 (Random.State.int32 random (if v <= Int32.zero then Int32.one else v))
  1920. );
  1921. end
  1922. module StdString = struct
  1923. let this vthis = match vthis with
  1924. | VString s -> s
  1925. | v -> unexpected_value v "string"
  1926. let charAt = vifun1 (fun vthis index ->
  1927. let this = this vthis in
  1928. let i = decode_int index in
  1929. if i < 0 || i >= this.slength then v_empty_string
  1930. else vstring (from_char_code (char_at this i))
  1931. )
  1932. let charCodeAt = vifun1 (fun vthis index ->
  1933. let this = this vthis in
  1934. let i = decode_int index in
  1935. if i < 0 || i >= this.slength then vnull
  1936. else vint (char_at this i)
  1937. )
  1938. let fromCharCode = vfun1 (fun i ->
  1939. let i = decode_int i in
  1940. try
  1941. vstring (from_char_code i)
  1942. with
  1943. | Not_found ->
  1944. vnull
  1945. )
  1946. let indexOf = vifun2 (fun vthis str startIndex ->
  1947. let str = this str in
  1948. let this = this vthis in
  1949. let i = default_int startIndex 0 in
  1950. try
  1951. if str.slength = 0 then
  1952. vint (max 0 (min i this.slength))
  1953. else begin
  1954. let i =
  1955. if i >= this.slength then raise Not_found
  1956. else if i < 0 then max (this.slength + i) 0
  1957. else i
  1958. in
  1959. let b = get_offset this i in
  1960. let offset,_,_ = find_substring this str false i b in
  1961. vint offset
  1962. end
  1963. with Not_found ->
  1964. vint (-1)
  1965. )
  1966. let lastIndexOf = vifun2 (fun vthis str startIndex ->
  1967. let str = this str in
  1968. let this = this vthis in
  1969. try
  1970. if str.slength = 0 then begin
  1971. let i = default_int startIndex this.slength in
  1972. vint (max 0 (min i this.slength))
  1973. end else begin
  1974. let i = default_int startIndex (this.slength - str.slength) in
  1975. let i = if i < 0 then raise Not_found else if i >= this.slength - str.slength then this.slength - str.slength else i in
  1976. let b = get_offset this i in
  1977. let offset,_,_ = find_substring this str true i b in
  1978. vint offset
  1979. end
  1980. with Not_found ->
  1981. vint (-1)
  1982. )
  1983. let split = vifun1 (fun vthis delimiter ->
  1984. let this = this vthis in
  1985. let s = this.sstring in
  1986. let delimiter = decode_vstring delimiter in
  1987. let bl_delimiter = String.length delimiter.sstring in
  1988. let bl_this = String.length s in
  1989. let encode_range pos length clength =
  1990. let s = String.sub s pos length in
  1991. vstring (create_with_length s clength)
  1992. in
  1993. if bl_delimiter = 0 then begin
  1994. let acc = DynArray.create () in
  1995. UTF8.iter (fun uc ->
  1996. DynArray.add acc (vstring (create_with_length (UTF8.init 1 (fun _ -> uc)) 1));
  1997. ) s;
  1998. encode_array (DynArray.to_list acc)
  1999. end else if bl_delimiter > bl_this then
  2000. encode_array [encode_range 0 bl_this this.slength]
  2001. else begin
  2002. let acc = DynArray.create () in
  2003. let f = find_substring this delimiter false in
  2004. let rec loop c_index b_index =
  2005. try
  2006. let c_offset,b_offset,next = f c_index b_index in
  2007. DynArray.add acc (encode_range b_index (b_offset - b_index) (c_offset - c_index));
  2008. loop (c_offset + delimiter.slength) next;
  2009. with Not_found ->
  2010. DynArray.add acc (encode_range b_index (bl_this - b_index) (this.slength - c_index))
  2011. in
  2012. loop 0 0;
  2013. encode_array_instance (EvalArray.create (DynArray.to_array acc))
  2014. end
  2015. )
  2016. let substr = vifun2 (fun vthis pos len ->
  2017. let this = this vthis in
  2018. let cl_this = this.slength in
  2019. let c_pos = decode_int pos in
  2020. if c_pos >= cl_this then
  2021. v_empty_string
  2022. else begin
  2023. let c_pos = if c_pos < 0 then begin
  2024. let c_pos = this.slength + c_pos in
  2025. if c_pos < 0 then 0 else c_pos
  2026. end else c_pos in
  2027. begin
  2028. let c_len = match len with
  2029. | VNull -> (cl_this - c_pos)
  2030. | VInt32 i -> Int32.to_int i
  2031. | _ -> unexpected_value len "int"
  2032. in
  2033. let c_len =
  2034. if c_len < 0 then cl_this + c_len - c_pos
  2035. else if c_len > cl_this - c_pos then cl_this - c_pos
  2036. else c_len
  2037. in
  2038. vstring (substr this c_pos c_len);
  2039. end
  2040. end
  2041. )
  2042. let substring = vifun2 (fun vthis startIndex endIndex ->
  2043. let this = this vthis in
  2044. let c_first = decode_int startIndex in
  2045. let cl_this = this.slength in
  2046. let c_last = default_int endIndex cl_this in
  2047. let c_first = if c_first < 0 then 0 else c_first in
  2048. let c_last = if c_last < 0 then 0 else c_last in
  2049. let c_first,c_last = if c_first > c_last then c_last,c_first else c_first,c_last in
  2050. let c_last = if c_last > cl_this then cl_this else c_last in
  2051. if c_first > cl_this || c_first = c_last then
  2052. v_empty_string
  2053. else begin
  2054. begin
  2055. let b_offset1 = get_offset this c_first in
  2056. let c_len = c_last - c_first in
  2057. let b_len =
  2058. if c_last = cl_this then String.length this.sstring - b_offset1
  2059. else (UTF8.move this.sstring b_offset1 c_len) - b_offset1
  2060. in
  2061. vstring (create_with_length (String.sub this.sstring b_offset1 b_len) c_len)
  2062. end
  2063. end
  2064. )
  2065. let toLowerCase = vifun0 (fun vthis ->
  2066. let this = this vthis in
  2067. vstring (case_map this false)
  2068. )
  2069. let toString = vifun0 (fun vthis -> vthis)
  2070. let toUpperCase = vifun0 (fun vthis ->
  2071. let this = this vthis in
  2072. vstring (case_map this true)
  2073. )
  2074. let cca = charCodeAt
  2075. end
  2076. module StdStringBuf = struct
  2077. let this vthis = match vthis with
  2078. | VInstance {ikind = IBuffer sb} -> sb
  2079. | v -> unexpected_value v "string"
  2080. let add = vifun1 (fun vthis x ->
  2081. let this = this vthis in
  2082. let s = match x with
  2083. | VString s -> s
  2084. | _ -> create_ascii (value_string x)
  2085. in
  2086. VStringBuffer.add_string this s;
  2087. vnull;
  2088. )
  2089. let addChar = vifun1 (fun vthis c ->
  2090. let this = this vthis in
  2091. let i = decode_int c in
  2092. Buffer.add_string this.bbuffer (string_of_char_code i);
  2093. this.blength <- this.blength + 1;
  2094. vnull
  2095. )
  2096. let addSub = vifun3 (fun vthis s pos len ->
  2097. let this = this vthis in
  2098. let s = decode_vstring s in
  2099. let c_pos = decode_int pos in
  2100. let c_len = match len with
  2101. | VNull -> s.slength - c_pos
  2102. | VInt32 i -> Int32.to_int i
  2103. | _ -> unexpected_value len "int"
  2104. in
  2105. if c_len > 0 then begin
  2106. let b_offset1 = get_offset s c_pos in
  2107. let b_offset2 = UTF8.move s.sstring b_offset1 c_len in
  2108. VStringBuffer.add_substring this s b_offset1 (b_offset2 - b_offset1) c_len;
  2109. end;
  2110. vnull
  2111. )
  2112. let get_length = vifun0 (fun vthis ->
  2113. let this = this vthis in
  2114. vint this.blength
  2115. )
  2116. let toString = vifun0 (fun vthis ->
  2117. let this = this vthis in
  2118. let s = VStringBuffer.contents this in
  2119. vstring s
  2120. )
  2121. end
  2122. module StdStringTools = struct
  2123. let url_encode s =
  2124. let b = Buffer.create 0 in
  2125. Common.url_encode s (Buffer.add_char b);
  2126. Buffer.contents b
  2127. let fastCodeAt = StdString.charCodeAt
  2128. let replace = vfun3 (fun s sub by ->
  2129. let by = decode_vstring by in
  2130. let sub = decode_vstring sub in
  2131. let s' = decode_vstring s in
  2132. let bl_s = String.length s'.sstring in
  2133. let buf = UTF8.Buf.create bl_s in
  2134. let replace_count = ref 0 in
  2135. let create () =
  2136. vstring (create_with_length (UTF8.Buf.contents buf) (s'.slength + by.slength * !replace_count - sub.slength * !replace_count))
  2137. in
  2138. if sub.slength = 0 then begin
  2139. if by.slength = 0 then
  2140. s
  2141. else begin
  2142. UTF8.iter (fun uc ->
  2143. UTF8.Buf.add_char buf uc;
  2144. (* don't add for the final char *)
  2145. if !replace_count <> s'.slength - 1 then begin
  2146. UTF8.Buf.add_string buf by.sstring;
  2147. incr replace_count;
  2148. end
  2149. ) s'.sstring;
  2150. create ();
  2151. end
  2152. end else begin
  2153. let f = find_substring s' sub false in
  2154. let rec loop c_index b_index =
  2155. try
  2156. let c_offset,b_offset,next = f c_index b_index in
  2157. UTF8.Buf.add_string buf (String.sub s'.sstring b_index (b_offset - b_index));
  2158. UTF8.Buf.add_string buf by.sstring;
  2159. incr replace_count;
  2160. loop (c_offset + sub.slength) next;
  2161. with Not_found ->
  2162. UTF8.Buf.add_string buf (String.sub s'.sstring b_index (bl_s - b_index));
  2163. in
  2164. loop 0 0;
  2165. create()
  2166. end
  2167. )
  2168. let urlEncode = vfun1 (fun s ->
  2169. let s = decode_string s in
  2170. encode_string (url_encode s)
  2171. )
  2172. let urlDecode = vfun1 (fun s ->
  2173. let s = decode_string s in
  2174. let b = VStringBuffer.create () in
  2175. let add s =
  2176. VStringBuffer.add_string b s
  2177. in
  2178. let len = String.length s in
  2179. let decode c =
  2180. match c with
  2181. | '0'..'9' -> Some (int_of_char c - int_of_char '0')
  2182. | 'a'..'f' -> Some (int_of_char c - int_of_char 'a' + 10)
  2183. | 'A'..'F' -> Some (int_of_char c - int_of_char 'A' + 10)
  2184. | _ -> None
  2185. in
  2186. let decode_hex i =
  2187. let p1 = (try decode (String.get s i) with _ -> None) in
  2188. let p2 = (try decode (String.get s (i + 1)) with _ -> None) in
  2189. match p1, p2 with
  2190. | Some c1, Some c2 ->
  2191. Some (((c1 lsl 4) lor c2))
  2192. | _ ->
  2193. None
  2194. in
  2195. let expect_hex i =
  2196. match String.unsafe_get s i with
  2197. | '%' ->
  2198. begin match decode_hex (i + 1) with
  2199. | None -> exc_string "Malformed"
  2200. | Some c -> c
  2201. end
  2202. | _ -> exc_string "Malformed"
  2203. in
  2204. let rec loop i =
  2205. if i = len then () else
  2206. let c = String.unsafe_get s i in
  2207. match c with
  2208. | '%' ->
  2209. begin match decode_hex (i + 1) with
  2210. | Some c ->
  2211. if c < 0x80 then begin
  2212. add (create_ascii (String.make 1 (char_of_int c)));
  2213. loop (i + 3)
  2214. end else if c < 0xE0 then begin
  2215. let c2 = expect_hex (i + 3) in
  2216. add (from_char_code (((c land 0x3F) lsl 6) lor (c2 land 0x7F)));
  2217. loop (i + 6)
  2218. end else if c < 0xF0 then begin
  2219. let c2 = expect_hex (i + 3) in
  2220. let c3 = expect_hex (i + 6) in
  2221. add (from_char_code (((c land 0x1F) lsl 12) lor ((c2 land 0x7F) lsl 6) lor (c3 land 0x7F)));
  2222. loop (i + 9)
  2223. end else
  2224. let c2 = expect_hex (i + 3) in
  2225. let c3 = expect_hex (i + 6) in
  2226. let c4 = expect_hex (i + 9) in
  2227. let k = ((c land 0x0F) lsl 18) lor ((c2 land 0x7F) lsl 12) lor ((c3 land 0x7F) lsl 6) lor (c4 land 0x7F) in
  2228. add (from_char_code k);
  2229. loop (i + 12)
  2230. | None ->
  2231. loop (i + 1)
  2232. end;
  2233. | '+' ->
  2234. add (create_ascii (String.make 1 ' '));
  2235. loop (i + 1)
  2236. | c ->
  2237. add (create_ascii (String.make 1 c));
  2238. loop (i + 1)
  2239. in
  2240. loop 0;
  2241. vstring (VStringBuffer.contents b)
  2242. )
  2243. end
  2244. module StdSys = struct
  2245. open MacroApi
  2246. open Common
  2247. let args = vfun0 (fun () ->
  2248. encode_array (List.map create_unknown ((get_ctx()).curapi.MacroApi.get_com()).sys_args)
  2249. )
  2250. let _command = vfun1 (fun cmd ->
  2251. let cmd = decode_string cmd in
  2252. vint (((get_ctx()).curapi.get_com()).run_command cmd)
  2253. )
  2254. let cpuTime = vfun0 (fun () -> vfloat (Sys.time()))
  2255. let environment = vfun0 (fun () ->
  2256. let env = catch_unix_error Unix.environment() in
  2257. let h = StringHashtbl.create () in
  2258. Array.iter(fun s ->
  2259. let k, v = ExtString.String.split s "=" in
  2260. StringHashtbl.add h (create_ascii k) (create_unknown v)
  2261. ) env;
  2262. encode_string_map_direct h
  2263. )
  2264. let exit = vfun1 (fun code ->
  2265. raise (Sys_exit(decode_int code));
  2266. )
  2267. let getChar = vfun1 (fun echo ->
  2268. let echo = decode_bool echo in
  2269. vint (Extc.getch echo)
  2270. )
  2271. let getCwd = vfun0 (fun () ->
  2272. let dir = catch_unix_error Unix.getcwd() in
  2273. let l = String.length dir in
  2274. if l = 0 then
  2275. encode_string "./"
  2276. else match dir.[l - 1] with
  2277. | '/' | '\\' ->
  2278. create_unknown dir
  2279. | _ ->
  2280. create_unknown (dir ^ "/")
  2281. )
  2282. let getEnv = vfun1 (fun s ->
  2283. let s = decode_string s in
  2284. try create_unknown (catch_unix_error Unix.getenv s) with _ -> vnull
  2285. )
  2286. let print = vfun1 (fun v ->
  2287. let ctx = get_ctx() in
  2288. let com = ctx.curapi.get_com() in
  2289. com.print (value_string v);
  2290. vnull
  2291. )
  2292. let println = vfun1 (fun v ->
  2293. let ctx = get_ctx() in
  2294. let com = ctx.curapi.get_com() in
  2295. com.print (value_string v ^ lineEnd);
  2296. vnull
  2297. )
  2298. let programPath = vfun0 (fun () ->
  2299. let ctx = get_ctx() in
  2300. let com = ctx.curapi.get_com() in
  2301. match com.main_class with
  2302. | None -> vnull
  2303. | Some p ->
  2304. match ctx.curapi.get_type (s_type_path p) with
  2305. | Some(Type.TInst (c, _)) -> create_unknown (Extc.get_full_path c.Type.cl_pos.Globals.pfile)
  2306. | _ -> vnull
  2307. )
  2308. let putEnv = vfun2 (fun s -> function
  2309. | v when v = vnull ->
  2310. let _ = Luv.Env.unsetenv (decode_string s) in vnull
  2311. | v ->
  2312. let s = decode_string s in
  2313. let v = decode_string v in
  2314. catch_unix_error Unix.putenv s v;
  2315. vnull
  2316. )
  2317. let setCwd = vfun1 (fun s ->
  2318. catch_unix_error Unix.chdir (decode_string s);
  2319. vnull
  2320. )
  2321. let setTimeLocale = vfun1 (fun _ -> vfalse)
  2322. let sleep = vfun1 (fun f ->
  2323. let time = Sys.time() in
  2324. Thread.yield();
  2325. let diff = Sys.time() -. time in
  2326. Thread.delay ((num f) -. diff);
  2327. vnull
  2328. )
  2329. let stderr = vfun0 (fun () ->
  2330. encode_instance key_sys_io_FileOutput ~kind:(IOutChannel stderr)
  2331. )
  2332. let stdin = vfun0 (fun () ->
  2333. encode_instance key_sys_io_FileInput ~kind:(IInChannel(stdin,ref false))
  2334. )
  2335. let stdout = vfun0 (fun () ->
  2336. encode_instance key_sys_io_FileOutput ~kind:(IOutChannel stdout)
  2337. )
  2338. let systemName =
  2339. let cached_sys_name = ref None in
  2340. vfun0 (fun () ->
  2341. let s = match Sys.os_type with
  2342. | "Unix" ->
  2343. (match !cached_sys_name with
  2344. | Some n -> n
  2345. | None ->
  2346. let ic, pid = catch_unix_error Process_helper.open_process_args_in_pid "uname" [| "uname" |] in
  2347. let uname = (match input_line ic with
  2348. | "Darwin" -> "Mac"
  2349. | n -> n
  2350. ) in
  2351. Pervasives.ignore (Process_helper.close_process_in_pid (ic, pid));
  2352. cached_sys_name := Some uname;
  2353. uname)
  2354. | "Win32" | "Cygwin" -> "Windows"
  2355. | s -> s
  2356. in
  2357. encode_string s
  2358. )
  2359. let time = vfun0 (fun () -> vfloat (catch_unix_error Unix.gettimeofday()))
  2360. end
  2361. module StdThread = struct
  2362. let this vthis = match vthis with
  2363. | VInstance {ikind = IThread thread} -> thread
  2364. | _ -> unexpected_value vthis "Thread"
  2365. let delay = vfun1 (fun f ->
  2366. Thread.delay (num f);
  2367. vnull
  2368. )
  2369. let exit = vfun0 (fun () ->
  2370. Thread.exit();
  2371. vnull
  2372. )
  2373. let id = vifun0 (fun vthis ->
  2374. vint (Thread.id (this vthis).tthread)
  2375. )
  2376. let get_events = vifun0 (fun vthis ->
  2377. (this vthis).tevents
  2378. )
  2379. let set_events = vifun1 (fun vthis v ->
  2380. (this vthis).tevents <- v;
  2381. v
  2382. )
  2383. let join = vfun1 (fun thread ->
  2384. Thread.join (this thread).tthread;
  2385. vnull
  2386. )
  2387. let kill = vifun0 (fun vthis ->
  2388. Thread.kill (this vthis).tthread;
  2389. vnull
  2390. )
  2391. let self = vfun0 (fun () ->
  2392. let eval = get_eval (get_ctx()) in
  2393. encode_instance key_eval_vm_Thread ~kind:(IThread eval.thread)
  2394. )
  2395. let readMessage = vfun1 (fun blocking ->
  2396. let eval = get_eval (get_ctx()) in
  2397. let blocking = decode_bool blocking in
  2398. Option.get (Deque.pop eval.thread.tdeque blocking)
  2399. )
  2400. let sendMessage = vifun1 (fun vthis msg ->
  2401. let this = this vthis in
  2402. Deque.push this.tdeque msg;
  2403. vnull
  2404. )
  2405. let yield = vfun0 (fun () ->
  2406. Thread.yield();
  2407. vnull
  2408. )
  2409. end
  2410. module StdTls = struct
  2411. let this vthis = match vthis with
  2412. | VInstance {ikind = ITls i} -> i
  2413. | _ -> unexpected_value vthis "Thread"
  2414. let get_value = vifun0 (fun vthis ->
  2415. let this = this vthis in
  2416. try
  2417. let id = Thread.id (Thread.self()) in
  2418. let eval = IntMap.find id (get_ctx()).evals in
  2419. IntMap.find this eval.thread.tstorage
  2420. with Not_found ->
  2421. vnull
  2422. )
  2423. let set_value = vifun1 (fun vthis v ->
  2424. let this = this vthis in
  2425. let eval = get_eval (get_ctx()) in
  2426. eval.thread.tstorage <- IntMap.add this v eval.thread.tstorage;
  2427. v
  2428. )
  2429. end
  2430. module StdType = struct
  2431. open Ast
  2432. let create_enum v constr params =
  2433. let vf = field v constr in
  2434. match vf,params with
  2435. | VEnumValue _,VNull -> vf
  2436. | VEnumValue _,VArray va when va.alength = 0 -> vf
  2437. | VFunction _,VArray va -> call_value vf (EvalArray.to_list va)
  2438. | _ -> unexpected_value params "array"
  2439. let allEnums = vfun1 (fun v ->
  2440. match v with
  2441. | VPrototype ({pkind = PEnum names} as proto) ->
  2442. begin try
  2443. let l = ExtList.List.filter_map (fun (s,_) ->
  2444. try
  2445. begin match proto_field_direct proto (hash s) with
  2446. | VEnumValue _ as v -> Some v
  2447. | _ -> None
  2448. end
  2449. with Not_found ->
  2450. None
  2451. ) names in
  2452. encode_array l
  2453. with Not_found ->
  2454. vnull
  2455. end
  2456. | _ ->
  2457. vnull
  2458. )
  2459. let createEmptyInstance = vfun1 (fun v ->
  2460. match v with
  2461. | VPrototype {pkind = PClass _; ppath = path} ->
  2462. begin try
  2463. (Hashtbl.find (get_ctx()).builtins.empty_constructor_builtins path) ()
  2464. with Not_found ->
  2465. encode_instance path
  2466. end
  2467. | _ -> vnull
  2468. )
  2469. let createEnum = vfun3 (fun e constr params ->
  2470. let constr = hash (decode_vstring constr).sstring in
  2471. create_enum e constr params
  2472. )
  2473. let createEnumIndex = vfun3 (fun e index params ->
  2474. let index = decode_int index in
  2475. match e with
  2476. | VPrototype {pkind = PEnum names} ->
  2477. begin try
  2478. create_enum e (hash (fst (List.nth names index))) params
  2479. with Not_found ->
  2480. vnull
  2481. end
  2482. | _ ->
  2483. vnull
  2484. )
  2485. let createInstance = vfun2 (fun v vl ->
  2486. match v with
  2487. | VPrototype {pkind = PClass _; ppath = path} ->
  2488. let ctx = get_ctx() in
  2489. begin try
  2490. let f = get_special_instance_constructor_raise ctx path in
  2491. f (decode_array vl)
  2492. with Not_found ->
  2493. let vthis = encode_instance path in
  2494. let fnew = get_instance_constructor ctx path null_pos in
  2495. ignore(call_value_on vthis (Lazy.force fnew) (decode_array vl));
  2496. vthis
  2497. end
  2498. | _ ->
  2499. unexpected_value v "Class"
  2500. )
  2501. let enumConstructor = vfun1 (fun v -> match v with
  2502. | VEnumValue ve ->
  2503. begin try
  2504. begin match (get_static_prototype_raise (get_ctx()) ve.epath).pkind with
  2505. | PEnum names -> encode_string (fst (List.nth names ve.eindex))
  2506. | _ -> raise Not_found
  2507. end
  2508. with Not_found ->
  2509. vnull
  2510. end
  2511. | v -> unexpected_value v "enum value"
  2512. )
  2513. let enumEq = vfun2 (fun a b ->
  2514. let rec weird_eq a b = match a,b with
  2515. | VEnumValue a,VEnumValue b -> a == b || a.eindex = b.eindex && arrays_equal weird_eq a.eargs b.eargs && a.epath = b.epath
  2516. | _ -> equals a b
  2517. in
  2518. vbool (weird_eq a b)
  2519. )
  2520. let enumIndex = vfun1 (fun v -> match v with
  2521. | VEnumValue ev -> (try vint32 (Int32.of_int ev.eindex) with Not_found -> vnull)
  2522. | v -> unexpected_value v "enum value"
  2523. )
  2524. let enumParameters = vfun1 (fun v -> match v with
  2525. | VEnumValue ev ->
  2526. let va = EvalArray.create ev.eargs in
  2527. VArray va
  2528. | v -> unexpected_value v "enum value"
  2529. )
  2530. let getClass = vfun1 (fun v ->
  2531. match v with
  2532. | VInstance ({iproto = {pkind = PInstance}} as vi) -> get_static_prototype_as_value (get_ctx()) vi.iproto.ppath null_pos
  2533. | VString _ -> get_static_prototype_as_value (get_ctx()) key_String null_pos
  2534. | VArray _ -> get_static_prototype_as_value (get_ctx()) key_Array null_pos
  2535. | VVector _ -> get_static_prototype_as_value (get_ctx()) key_eval_Vector null_pos
  2536. | _ -> vnull
  2537. )
  2538. let getClassFields = vfun1 (fun v ->
  2539. match v with
  2540. | VPrototype {pkind = PClass _;pnames = names} ->
  2541. encode_array (IntMap.fold (fun name _ acc -> (encode_string (rev_hash name)) :: acc) names []);
  2542. | _ ->
  2543. vnull
  2544. )
  2545. let getClassName = vfun1 (fun v ->
  2546. match v with
  2547. | VPrototype {pkind = PClass _; ppath = path} -> encode_string (rev_hash path)
  2548. | _ -> vnull
  2549. )
  2550. let getEnum = vfun1 (fun v ->
  2551. match v with
  2552. | VEnumValue ve -> get_static_prototype_as_value (get_ctx()) ve.epath null_pos
  2553. | _ -> vnull
  2554. )
  2555. let getEnumConstructs = vfun1 (fun v ->
  2556. match v with
  2557. | VPrototype {pkind = PEnum names} ->
  2558. begin try
  2559. encode_array (List.map (fun (n,_) -> encode_string n) names)
  2560. with Not_found ->
  2561. vnull
  2562. end
  2563. | _ ->
  2564. vnull
  2565. )
  2566. let getEnumName = vfun1 (fun v ->
  2567. match v with
  2568. | VPrototype {pkind = PEnum _; ppath = path} -> encode_string (rev_hash path)
  2569. | _ -> vnull
  2570. )
  2571. let getInstanceFields = vfun1 (fun v ->
  2572. match v with
  2573. | VPrototype proto ->
  2574. begin try
  2575. let rec loop acc proto =
  2576. let acc = match proto.pparent with
  2577. | None -> acc
  2578. | Some proto -> loop acc proto
  2579. in
  2580. let acc = IntMap.fold (fun name _ acc -> IntMap.add name 0 acc) proto.pinstance_names acc in
  2581. IntMap.fold (fun name _ acc -> IntMap.add name 0 acc) proto.pnames acc
  2582. in
  2583. let proto = get_instance_prototype (get_ctx()) proto.ppath null_pos in
  2584. encode_array (List.map (fun i -> encode_string (rev_hash i)) (ptmap_keys (loop IntMap.empty proto)))
  2585. with Not_found ->
  2586. vnull
  2587. end
  2588. | _ ->
  2589. vnull
  2590. )
  2591. let getSuperClass = vfun1 (fun v ->
  2592. match v with
  2593. | VPrototype {pkind = PClass _; pparent = Some proto} -> proto.pvalue
  2594. | _ -> vnull
  2595. )
  2596. let resolveClass = vfun1 (fun v ->
  2597. let name = (decode_vstring v).sstring in
  2598. try (get_static_prototype_raise (get_ctx()) (hash name)).pvalue with Not_found -> vnull
  2599. )
  2600. let resolveEnum = vfun1 (fun v ->
  2601. let name = (decode_vstring v).sstring in
  2602. try
  2603. let proto = get_static_prototype_raise (get_ctx()) (hash name) in
  2604. begin match proto.pkind with
  2605. | PEnum _ -> proto.pvalue
  2606. | _ -> vnull
  2607. end
  2608. with Not_found ->
  2609. vnull
  2610. )
  2611. let typeof = vfun1 (fun v ->
  2612. let ctx = (get_ctx()) in
  2613. let rec loop v = match v with
  2614. | VNull -> 0,[||]
  2615. | VInt32 _ -> 1,[||]
  2616. | VFloat _ -> 2,[||]
  2617. | VTrue | VFalse -> 3,[||]
  2618. | VInstance vi -> 6,[|get_static_prototype_as_value ctx vi.iproto.ppath null_pos|]
  2619. | VString _ -> 6,[|get_static_prototype_as_value ctx key_String null_pos|]
  2620. | VArray _ -> 6,[|get_static_prototype_as_value ctx key_Array null_pos|]
  2621. | VVector _ -> 6,[|get_static_prototype_as_value ctx key_eval_Vector null_pos|]
  2622. | VObject _ | VPrototype _ ->
  2623. 4,[||]
  2624. | VFunction _
  2625. | VFieldClosure _ ->
  2626. 5,[||]
  2627. | VEnumValue ve ->
  2628. 7,[|get_static_prototype_as_value ctx ve.epath null_pos|]
  2629. | VLazy f ->
  2630. loop (!f())
  2631. | VInt64 _ | VUInt64 _ | VNativeString _ | VHandle _ -> 8,[||]
  2632. in
  2633. let i,vl = loop v in
  2634. encode_enum_value key_ValueType i vl None
  2635. )
  2636. end
  2637. module StdUncompress = struct
  2638. open Extc
  2639. let this vthis = match vthis with
  2640. | VInstance {ikind = IZip zip} -> zip
  2641. | _ -> unexpected_value vthis "Uncompress"
  2642. let close = vifun0 (fun vthis ->
  2643. zlib_inflate_end (this vthis).z;
  2644. vnull
  2645. )
  2646. let execute = vifun4 (fun vthis src srcPos dst dstPos ->
  2647. StdCompress.exec zlib_inflate vthis src srcPos dst dstPos
  2648. )
  2649. let run = vfun2 (fun src bufsize ->
  2650. let src = decode_bytes src in
  2651. let bufsize = default_int bufsize (1 lsl 16) in
  2652. let zip = zlib_inflate_init () in
  2653. let buf = Buffer.create 0 in
  2654. let tmp = Bytes.make bufsize (char_of_int 0) in
  2655. let rec loop pos =
  2656. let r = zlib_inflate zip (Bytes.unsafe_to_string src) pos (Bytes.length src - pos) tmp 0 bufsize Z_SYNC_FLUSH in
  2657. Buffer.add_subbytes buf tmp 0 r.z_wrote;
  2658. if not r.z_finish then loop (pos + r.z_read)
  2659. in
  2660. loop 0;
  2661. encode_bytes (Bytes.unsafe_of_string (Buffer.contents buf))
  2662. )
  2663. let setFlushMode = StdCompress.setFlushMode
  2664. end
  2665. module StdUtf8 = struct
  2666. let this vthis = match vthis with
  2667. | VInstance {ikind = IUtf8 buf} -> buf
  2668. | v -> unexpected_value v "string"
  2669. let addChar = vifun1 (fun vthis c ->
  2670. UTF8.Buf.add_char (this vthis) (UCharExt.uchar_of_int (decode_int c));
  2671. vnull
  2672. )
  2673. let charCodeAt = StdString.charCodeAt
  2674. let compare = vfun2 (fun a b ->
  2675. let a = decode_string a in
  2676. let b = decode_string b in
  2677. vint (Pervasives.compare a b)
  2678. )
  2679. let decode = vfun1 (fun s ->
  2680. let s = decode_string s in
  2681. let buf = Bytes.create (UTF8.length s) in
  2682. let i = ref 0 in
  2683. UTF8.iter (fun uc ->
  2684. Bytes.unsafe_set buf !i (UCharExt.char_of uc);
  2685. incr i
  2686. ) s;
  2687. let s = Bytes.unsafe_to_string buf in
  2688. create_unknown s
  2689. )
  2690. let encode = vfun1 (fun s ->
  2691. let s = decode_string s in
  2692. create_unknown (UTF8.init (String.length s) (fun i -> UCharExt.of_char s.[i]))
  2693. )
  2694. let iter = vfun2 (fun s f ->
  2695. let s = decode_string s in
  2696. UTF8.iter (fun uc -> ignore(call_value f [vint (UCharExt.int_of_uchar uc)])) s;
  2697. vnull
  2698. )
  2699. let length = vfun1 (fun s ->
  2700. let s = decode_vstring s in
  2701. vint (s.slength)
  2702. )
  2703. let sub = StdString.substr
  2704. let toString = vifun0 (fun vthis ->
  2705. let this = this vthis in
  2706. vstring (create_ascii ((UTF8.Buf.contents this)))
  2707. )
  2708. let validate = vfun1 (fun s ->
  2709. let s = decode_string s in
  2710. try
  2711. UTF8.validate s;
  2712. vtrue
  2713. with UTF8.Malformed_code ->
  2714. vfalse
  2715. )
  2716. end
  2717. module StdNativeString = struct
  2718. let from_string = vfun1 (fun v ->
  2719. match decode_optional decode_vstring v with
  2720. | None -> vnull
  2721. | Some s -> vnative_string s.sstring
  2722. )
  2723. let from_bytes = vfun1 (fun v ->
  2724. let b = decode_bytes v in
  2725. vnative_string (Bytes.to_string b)
  2726. )
  2727. let to_string = vfun1 (fun v ->
  2728. let s = decode_native_string v in
  2729. create_unknown s
  2730. )
  2731. let to_bytes = vfun1 (fun v ->
  2732. let s = decode_native_string v in
  2733. encode_bytes (Bytes.of_string s)
  2734. )
  2735. let concat = vfun2 (fun v1 v2 ->
  2736. let s1 = decode_native_string v1
  2737. and s2 = decode_native_string v2 in
  2738. vnative_string (s1 ^ s2)
  2739. )
  2740. let char = vfun2 (fun v1 v2 ->
  2741. let s = decode_native_string v1
  2742. and index = decode_int v2 in
  2743. try encode_string (String.make 1 s.[index])
  2744. with Invalid_argument s -> throw_string s null_pos
  2745. )
  2746. let code = vfun2 (fun v1 v2 ->
  2747. let s = decode_native_string v1
  2748. and index = decode_int v2 in
  2749. try vint (int_of_char s.[index])
  2750. with Invalid_argument s -> throw_string s null_pos
  2751. )
  2752. let get_length = vfun1 (fun v ->
  2753. let s = decode_native_string v in
  2754. vint (String.length s)
  2755. )
  2756. let sub = vfun3 (fun v1 v2 v3 ->
  2757. let s = decode_native_string v1
  2758. and start = decode_int v2 in
  2759. let max_length = String.length s - start in
  2760. try
  2761. if v3 = VNull then
  2762. vnative_string (String.sub s start max_length)
  2763. else
  2764. let length =
  2765. let l = decode_int v3 in
  2766. if l > max_length then max_length else l
  2767. in
  2768. vnative_string (String.sub s start length)
  2769. with Invalid_argument _ ->
  2770. throw_string "Invalid arguments for eval.NativeString.sub" null_pos
  2771. )
  2772. end
  2773. let init_fields builtins path static_fields instance_fields =
  2774. let map (name,v) = (hash name,v) in
  2775. let path = path_hash path in
  2776. builtins.static_builtins <- IntMap.add path (List.map map static_fields) builtins.static_builtins;
  2777. builtins.instance_builtins <- IntMap.add path (List.map map instance_fields) builtins.instance_builtins
  2778. let init_maps builtins =
  2779. init_fields builtins (["haxe";"ds"],"IntMap") [] [
  2780. "copy",StdIntMap.copy;
  2781. "exists",StdIntMap.exists;
  2782. "get",StdIntMap.get;
  2783. "iterator",StdIntMap.iterator;
  2784. "keys",StdIntMap.keys;
  2785. "keyValueIterator",StdIntMap.keyValueIterator;
  2786. "remove",StdIntMap.remove;
  2787. "set",StdIntMap.set;
  2788. "toString",StdIntMap.toString;
  2789. "clear",StdIntMap.clear;
  2790. ];
  2791. init_fields builtins (["haxe";"ds"],"ObjectMap") [] [
  2792. "copy",StdObjectMap.copy;
  2793. "exists",StdObjectMap.exists;
  2794. "get",StdObjectMap.get;
  2795. "iterator",StdObjectMap.iterator;
  2796. "keys",StdObjectMap.keys;
  2797. "keyValueIterator",StdObjectMap.keyValueIterator;
  2798. "remove",StdObjectMap.remove;
  2799. "set",StdObjectMap.set;
  2800. "toString",StdObjectMap.toString;
  2801. "clear",StdObjectMap.clear;
  2802. ];
  2803. init_fields builtins (["haxe";"ds"],"StringMap") [] [
  2804. "copy",StdStringMap.copy;
  2805. "exists",StdStringMap.exists;
  2806. "get",StdStringMap.get;
  2807. "iterator",StdStringMap.iterator;
  2808. "keys",StdStringMap.keys;
  2809. "keyValueIterator",StdStringMap.keyValueIterator;
  2810. "remove",StdStringMap.remove;
  2811. "set",StdStringMap.set;
  2812. "toString",StdStringMap.toString;
  2813. "clear",StdStringMap.clear;
  2814. ]
  2815. let init_constructors builtins =
  2816. let add = Hashtbl.add builtins.constructor_builtins in
  2817. add key_Array (fun _ -> encode_array_instance (EvalArray.create [||]));
  2818. add key_eval_Vector
  2819. (fun vl ->
  2820. match vl with
  2821. | [size] ->
  2822. encode_vector_instance (Array.make (decode_int size) vnull)
  2823. | _ -> die "" __LOC__
  2824. );
  2825. add key_Date
  2826. (fun vl ->
  2827. begin match List.map decode_int vl with
  2828. | [y;m;d;h;mi;s] ->
  2829. let f = catch_unix_error (fun () ->
  2830. let t = Unix.localtime 0. in
  2831. Unix.mktime {t with tm_sec=s;tm_min=mi;tm_hour=h;tm_mday=d;tm_mon=m;tm_year=y - 1900}
  2832. ) () in
  2833. encode_instance key_Date ~kind:(IDate (fst f))
  2834. | _ -> die "" __LOC__
  2835. end
  2836. );
  2837. add key_EReg
  2838. (fun vl -> match vl with
  2839. | [r;opt] -> encode_instance key_EReg ~kind:(StdEReg.create (decode_string r) (decode_string opt))
  2840. | _ -> die "" __LOC__
  2841. );
  2842. add key_String
  2843. (fun vl -> match vl with
  2844. | [s] -> s
  2845. | _ -> die "" __LOC__
  2846. );
  2847. add key_StringBuf (fun _ -> encode_instance key_StringBuf ~kind:(IBuffer (VStringBuffer.create())));
  2848. add key_haxe_Utf8
  2849. (fun vl -> match vl with
  2850. | [size] -> encode_instance key_haxe_Utf8 ~kind:(IUtf8 (UTF8.Buf.create (default_int size 0)))
  2851. | _ -> die "" __LOC__
  2852. );
  2853. add key_haxe_ds_StringMap (fun _ -> encode_string_map_direct (StringHashtbl.create ()));
  2854. add key_haxe_ds_IntMap (fun _ -> encode_int_map_direct (IntHashtbl.create ()));
  2855. add key_haxe_ds_ObjectMap (fun _ -> encode_object_map_direct (Obj.magic (ValueHashtbl.create 0)));
  2856. add key_haxe_io_BytesBuffer (fun _ -> encode_instance key_haxe_io_BytesBuffer ~kind:(IOutput (Buffer.create 0)));
  2857. add key_haxe_io_Bytes
  2858. (fun vl -> match vl with
  2859. | [length;b] ->
  2860. let length = decode_int length in
  2861. let b = decode_bytes b in
  2862. let blit_length = if length > Bytes.length b then Bytes.length b else length in
  2863. let b' = Bytes.create length in
  2864. Bytes.blit b 0 b' 0 blit_length;
  2865. encode_bytes b'
  2866. | _ ->
  2867. die "" __LOC__
  2868. );
  2869. add key_sys_io__Process_NativeProcess
  2870. (fun vl -> match vl with
  2871. | [cmd;args] ->
  2872. let cmd = decode_string cmd in
  2873. let args = match args with
  2874. | VNull -> None
  2875. | VArray va -> Some (Array.map decode_string (Array.sub va.avalues 0 va.alength))
  2876. | _ -> unexpected_value args "array"
  2877. in
  2878. encode_instance key_sys_io__Process_NativeProcess ~kind:(IProcess (try Process.run cmd args with Failure msg -> exc_string msg))
  2879. | _ -> die "" __LOC__
  2880. );
  2881. add key_eval_vm_NativeSocket
  2882. (fun _ ->
  2883. encode_instance key_eval_vm_NativeSocket ~kind:(ISocket ((catch_unix_error Unix.socket Unix.PF_INET Unix.SOCK_STREAM) 0))
  2884. );
  2885. add key_haxe_zip_Compress
  2886. (fun vl -> match vl with
  2887. | [level] ->
  2888. let level = decode_int level in
  2889. let z = Extc.zlib_deflate_init level in
  2890. encode_instance key_haxe_zip_Compress ~kind:(IZip { z = z; z_flush = Extc.Z_NO_FLUSH })
  2891. | _ -> die "" __LOC__
  2892. );
  2893. add key_haxe_zip_Uncompress
  2894. (fun vl -> match vl with
  2895. | [windowBits] ->
  2896. let windowBits = default_int windowBits 15 in
  2897. let z = Extc.zlib_inflate_init2 windowBits in
  2898. encode_instance key_haxe_zip_Uncompress ~kind:(IZip { z = z; z_flush = Extc.Z_NO_FLUSH })
  2899. | _ -> die "" __LOC__
  2900. );
  2901. add key_eval_vm_Thread
  2902. (fun vl -> match vl with
  2903. | [f] ->
  2904. let ctx = get_ctx() in
  2905. if ctx.is_macro then exc_string "Creating threads in macros is not supported";
  2906. let thread = EvalThread.spawn ctx (fun () -> call_value f []) in
  2907. encode_instance key_eval_vm_Thread ~kind:(IThread thread)
  2908. | _ -> die "" __LOC__
  2909. );
  2910. add key_sys_net_Mutex
  2911. (fun _ ->
  2912. let mutex = {
  2913. mmutex = Mutex.create();
  2914. mowner = None;
  2915. } in
  2916. encode_instance key_sys_net_Mutex ~kind:(IMutex mutex)
  2917. );
  2918. add key_sys_net_Lock
  2919. (fun _ ->
  2920. let lock = {
  2921. ldeque = Deque.create();
  2922. } in
  2923. encode_instance key_sys_net_Lock ~kind:(ILock lock)
  2924. );
  2925. let tls_counter = ref (-1) in
  2926. add key_sys_net_Tls
  2927. (fun _ ->
  2928. incr tls_counter;
  2929. encode_instance key_sys_net_Tls ~kind:(ITls !tls_counter)
  2930. );
  2931. add key_sys_net_Deque
  2932. (fun _ ->
  2933. encode_instance key_sys_net_Deque ~kind:(IDeque (Deque.create()))
  2934. );
  2935. EvalSsl.init_constructors add
  2936. let init_empty_constructors builtins =
  2937. let h = builtins.empty_constructor_builtins in
  2938. Hashtbl.add h key_Array (fun () -> encode_array_instance (EvalArray.create [||]));
  2939. Hashtbl.add h key_eval_Vector (fun () -> encode_vector_instance (Array.make 0 vnull));
  2940. Hashtbl.add h key_Date (fun () -> encode_instance key_Date ~kind:(IDate 0.));
  2941. Hashtbl.add h key_EReg (fun () -> encode_instance key_EReg ~kind:(IRegex {r = Pcre2.regexp ""; r_rex_string = create_ascii "~//"; r_global = false; r_string = ""; r_groups = [||]}));
  2942. Hashtbl.add h key_String (fun () -> v_empty_string);
  2943. Hashtbl.add h key_haxe_ds_StringMap (fun () -> encode_instance key_haxe_ds_StringMap ~kind:(IStringMap (StringHashtbl.create ())));
  2944. Hashtbl.add h key_haxe_ds_IntMap (fun () -> encode_instance key_haxe_ds_IntMap ~kind:(IIntMap (IntHashtbl.create ())));
  2945. Hashtbl.add h key_haxe_ds_ObjectMap (fun () -> encode_instance key_haxe_ds_ObjectMap ~kind:(IObjectMap (Obj.magic (ValueHashtbl.create 0))));
  2946. Hashtbl.add h key_haxe_io_BytesBuffer (fun () -> encode_instance key_haxe_io_BytesBuffer ~kind:(IOutput (Buffer.create 0)))
  2947. let init_standard_library builtins =
  2948. init_constructors builtins;
  2949. init_empty_constructors builtins;
  2950. init_maps builtins;
  2951. init_fields builtins ([],"Array") [] [
  2952. "concat",StdArray.concat;
  2953. "copy",StdArray.copy;
  2954. "filter",StdArray.filter;
  2955. "indexOf",StdArray.indexOf;
  2956. "insert",StdArray.insert;
  2957. "iterator",StdArray.iterator;
  2958. "join",StdArray.join;
  2959. "keyValueIterator",StdArray.keyValueIterator;
  2960. "lastIndexOf",StdArray.lastIndexOf;
  2961. "map",StdArray.map;
  2962. "pop",StdArray.pop;
  2963. "push",StdArray.push;
  2964. "remove",StdArray.remove;
  2965. "resize",StdArray.resize;
  2966. "contains",StdArray.contains;
  2967. "reverse",StdArray.reverse;
  2968. "shift",StdArray.shift;
  2969. "slice",StdArray.slice;
  2970. "sort",StdArray.sort;
  2971. "splice",StdArray.splice;
  2972. "toString",StdArray.toString;
  2973. "unshift",StdArray.unshift;
  2974. ];
  2975. init_fields builtins (["eval"],"Vector") [
  2976. "fromArrayCopy",StdEvalVector.fromArrayCopy;
  2977. ] [
  2978. "blit",StdEvalVector.blit;
  2979. "toArray",StdEvalVector.toArray;
  2980. "copy",StdEvalVector.copy;
  2981. "join",StdEvalVector.join;
  2982. "map",StdEvalVector.map;
  2983. ];
  2984. init_fields builtins (["haxe";"io"],"Bytes") [
  2985. "alloc",StdBytes.alloc;
  2986. "fastGet",StdBytes.fastGet;
  2987. "ofData",StdBytes.ofData;
  2988. "ofString",StdBytes.ofString;
  2989. "ofHex",StdBytes.ofHex;
  2990. ] [
  2991. "blit",StdBytes.blit;
  2992. "compare",StdBytes.compare;
  2993. "fill",StdBytes.fill;
  2994. "get",StdBytes.get;
  2995. "getData",StdBytes.getData;
  2996. "getDouble",StdBytes.getDouble;
  2997. "getFloat",StdBytes.getFloat;
  2998. "getInt32",StdBytes.getInt32;
  2999. "getInt64",StdBytes.getInt64;
  3000. "getString",StdBytes.getString;
  3001. "getUInt16",StdBytes.getUInt16;
  3002. "set",StdBytes.set;
  3003. "setDouble",StdBytes.setDouble;
  3004. "setFloat",StdBytes.setFloat;
  3005. "setInt32",StdBytes.setInt32;
  3006. "setInt64",StdBytes.setInt64;
  3007. "setUInt16",StdBytes.setUInt16;
  3008. "sub",StdBytes.sub;
  3009. "toHex",StdBytes.toHex;
  3010. "toString",StdBytes.toString;
  3011. ];
  3012. init_fields builtins (["haxe";"io"],"BytesBuffer") [] [
  3013. "get_length",StdBytesBuffer.get_length;
  3014. "addByte",StdBytesBuffer.addByte;
  3015. "add",StdBytesBuffer.add;
  3016. "addString",StdBytesBuffer.addString;
  3017. "addInt32",StdBytesBuffer.addInt32;
  3018. "addInt64",StdBytesBuffer.addInt64;
  3019. "addFloat",StdBytesBuffer.addFloat;
  3020. "addDouble",StdBytesBuffer.addDouble;
  3021. "addBytes",StdBytesBuffer.addBytes;
  3022. "getBytes",StdBytesBuffer.getBytes;
  3023. ];
  3024. init_fields builtins (["haxe"],"NativeStackTrace") [
  3025. "_callStack",EvalStackTrace.getCallStack;
  3026. "exceptionStack",EvalStackTrace.getExceptionStack;
  3027. ] [];
  3028. init_fields builtins (["haxe";"zip"],"Compress") [
  3029. "run",StdCompress.run;
  3030. ] [
  3031. "close",StdCompress.close;
  3032. "execute",StdCompress.execute;
  3033. "setFlushMode",StdCompress.setFlushMode;
  3034. ];
  3035. init_fields builtins (["eval";"vm"],"Context") [
  3036. "addBreakpoint",StdContext.addBreakpoint;
  3037. "breakHere",StdContext.breakHere;
  3038. "callMacroApi",StdContext.callMacroApi;
  3039. "loadPlugin",StdContext.loadPlugin;
  3040. ] [];
  3041. init_fields builtins (["haxe";"crypto"],"Crc32") [
  3042. "make",StdCrc32.make;
  3043. ] [];
  3044. init_fields builtins ([],"Date") [
  3045. "fromString",StdDate.fromString;
  3046. "fromTime",StdDate.fromTime;
  3047. "now",StdDate.now;
  3048. ] [
  3049. "getDate",StdDate.getDate;
  3050. "getDay",StdDate.getDay;
  3051. "getFullYear",StdDate.getFullYear;
  3052. "getHours",StdDate.getHours;
  3053. "getMinutes",StdDate.getMinutes;
  3054. "getMonth",StdDate.getMonth;
  3055. "getSeconds",StdDate.getSeconds;
  3056. "getUTCDate",StdDate.getUTCDate;
  3057. "getUTCDay",StdDate.getUTCDay;
  3058. "getUTCFullYear",StdDate.getUTCFullYear;
  3059. "getUTCHours",StdDate.getUTCHours;
  3060. "getUTCMinutes",StdDate.getUTCMinutes;
  3061. "getUTCMonth",StdDate.getUTCMonth;
  3062. "getUTCSeconds",StdDate.getUTCSeconds;
  3063. "getTime",StdDate.getTime;
  3064. "getTimezoneOffset",StdDate.getTimezoneOffset;
  3065. "toString",StdDate.toString;
  3066. ];
  3067. init_fields builtins (["sys";"thread"],"Deque") [] [
  3068. "add",StdDeque.add;
  3069. "push",StdDeque.push;
  3070. "pop",StdDeque.pop;
  3071. ];
  3072. init_fields builtins ([],"EReg") [
  3073. "escape",StdEReg.escape;
  3074. ] [
  3075. "map",StdEReg.map;
  3076. "match",StdEReg.match';
  3077. "matched",StdEReg.matched;
  3078. "matchedLeft",StdEReg.matchedLeft;
  3079. "matchedPos",StdEReg.matchedPos;
  3080. "matchedRight",StdEReg.matchedRight;
  3081. "matchSub",StdEReg.matchSub;
  3082. "replace",StdEReg.replace;
  3083. "split",StdEReg.split;
  3084. ];
  3085. init_fields builtins (["sys";"io"],"File") [
  3086. "append",StdFile.append;
  3087. "getBytes",StdFile.getBytes;
  3088. "getContent",StdFile.getContent;
  3089. "read",StdFile.read;
  3090. "saveBytes",StdFile.saveBytes;
  3091. "saveContent",StdFile.saveContent;
  3092. "update",StdFile.update;
  3093. "write",StdFile.write;
  3094. ] [];
  3095. init_fields builtins (["sys";"io"],"FileInput") [] [
  3096. "close",StdFileInput.close;
  3097. "eof",StdFileInput.eof;
  3098. "seek",StdFileInput.seek;
  3099. "tell",StdFileInput.tell;
  3100. "readByte",StdFileInput.readByte;
  3101. "readBytes",StdFileInput.readBytes;
  3102. ];
  3103. init_fields builtins (["sys";"io"],"FileOutput") [] [
  3104. "close",StdFileOutput.close;
  3105. "flush",StdFileOutput.flush;
  3106. "seek",StdFileOutput.seek;
  3107. "tell",StdFileOutput.tell;
  3108. "writeByte",StdFileOutput.writeByte;
  3109. "writeBytes",StdFileOutput.writeBytes;
  3110. ];
  3111. init_fields builtins (["haxe";"io"],"FPHelper") [
  3112. "doubleToI64",StdFPHelper.doubleToI64;
  3113. "floatToI32",StdFPHelper.floatToI32;
  3114. "i32ToFloat",StdFPHelper.i32ToFloat;
  3115. "i64ToDouble",StdFPHelper.i64ToDouble;
  3116. ] [];
  3117. init_fields builtins (["sys"],"FileSystem") [
  3118. "createDirectory",StdFileSystem.createDirectory;
  3119. "deleteFile",StdFileSystem.deleteFile;
  3120. "deleteDirectory",StdFileSystem.deleteDirectory;
  3121. "exists",StdFileSystem.exists;
  3122. "fullPath",StdFileSystem.fullPath;
  3123. "isDirectory",StdFileSystem.isDirectory;
  3124. "rename",StdFileSystem.rename;
  3125. "readDirectory",StdFileSystem.readDirectory;
  3126. "stat",StdFileSystem.stat;
  3127. ] [];
  3128. init_fields builtins (["eval";"vm"],"Gc") [
  3129. "allocated_bytes",StdGc.allocated_bytes;
  3130. "compact",StdGc.compact;
  3131. "counters",StdGc.counters;
  3132. "finalise",StdGc.finalise;
  3133. "finalise_release",StdGc.finalise_release;
  3134. "full_major",StdGc.full_major;
  3135. "get",StdGc.get;
  3136. "major",StdGc.major;
  3137. "major_slice",StdGc.major_slice;
  3138. "minor",StdGc.minor;
  3139. "print_stat",StdGc.print_stat;
  3140. "quick_stat",StdGc.quick_stat;
  3141. "set",StdGc.set;
  3142. "stat",StdGc.stat;
  3143. ] [];
  3144. init_fields builtins (["sys";"net"],"Host") [
  3145. "localhost",StdHost.localhost;
  3146. "hostReverse",StdHost.hostReverse;
  3147. "hostToString",StdHost.hostToString;
  3148. "resolve",StdHost.resolve;
  3149. ] [];
  3150. init_fields builtins (["sys";"thread"],"Lock") [] [
  3151. "release",StdLock.release;
  3152. "wait",StdLock.wait;
  3153. ];
  3154. init_fields builtins (["haxe"],"Log") [
  3155. "trace",StdLog.trace;
  3156. ] [];
  3157. init_fields builtins ([],"Math") [
  3158. "NaN",StdMath.nan;
  3159. "NEGATIVE_INFINITY",StdMath.negative_infinity;
  3160. "PI",StdMath.pi;
  3161. "POSITIVE_INFINITY",StdMath.positive_infinity;
  3162. "abs",StdMath.abs;
  3163. "acos",StdMath.acos;
  3164. "asin",StdMath.asin;
  3165. "atan",StdMath.atan;
  3166. "atan2",StdMath.atan2;
  3167. "ceil",StdMath.ceil;
  3168. "cos",StdMath.cos;
  3169. "exp",StdMath.exp;
  3170. "fceil",StdMath.fceil;
  3171. "ffloor",StdMath.ffloor;
  3172. "floor",StdMath.floor;
  3173. "fround",StdMath.fround;
  3174. "isFinite",StdMath.isFinite;
  3175. "isNaN",StdMath.isNaN;
  3176. "log",StdMath.log;
  3177. "max",StdMath.max;
  3178. "min",StdMath.min;
  3179. "pow",StdMath.pow;
  3180. "random",StdMath.random;
  3181. "round",StdMath.round;
  3182. "sin",StdMath.sin;
  3183. "sqrt",StdMath.sqrt;
  3184. "tan",StdMath.tan;
  3185. ] [];
  3186. init_fields builtins (["haxe";"crypto"],"Md5") [
  3187. "encode",StdMd5.encode;
  3188. "make",StdMd5.make;
  3189. ] [];
  3190. init_fields builtins (["sys";"thread"],"Mutex") [] [
  3191. "acquire",StdMutex.acquire;
  3192. "tryAcquire",StdMutex.tryAcquire;
  3193. "release",StdMutex.release;
  3194. ];
  3195. init_fields builtins (["sys";"io";"_Process"],"NativeProcess") [ ] [
  3196. "close",StdNativeProcess.close;
  3197. "exitCode",StdNativeProcess.exitCode;
  3198. "getPid",StdNativeProcess.getPid;
  3199. "kill",StdNativeProcess.kill;
  3200. "readStderr",StdNativeProcess.readStderr;
  3201. "readStdout",StdNativeProcess.readStdout;
  3202. "closeStdin",StdNativeProcess.closeStdin;
  3203. "writeStdin",StdNativeProcess.writeStdin;
  3204. ];
  3205. init_fields builtins ([],"Reflect") [
  3206. "callMethod",StdReflect.callMethod;
  3207. "compare",StdReflect.compare;
  3208. "compareMethods",StdReflect.compareMethods;
  3209. "copy",StdReflect.copy;
  3210. "deleteField",StdReflect.deleteField;
  3211. "field",StdReflect.field';
  3212. "fields",StdReflect.fields;
  3213. "getProperty",StdReflect.getProperty;
  3214. "hasField",StdReflect.hasField;
  3215. "isEnumValue",StdReflect.isEnumValue;
  3216. "isFunction",StdReflect.isFunction;
  3217. "isObject",StdReflect.isObject;
  3218. "makeVarArgs",StdReflect.makeVarArgs;
  3219. "setField",StdReflect.setField;
  3220. "setProperty",StdReflect.setProperty;
  3221. ] [];
  3222. init_fields builtins (["haxe"],"Resource") [
  3223. "listNames",StdResource.listNames;
  3224. "getString",StdResource.getString;
  3225. "getBytes",StdResource.getBytes;
  3226. ] [];
  3227. init_fields builtins (["haxe";"crypto"],"Sha1") [
  3228. "encode",StdSha1.encode;
  3229. "make",StdSha1.make;
  3230. ] [];
  3231. init_fields builtins (["eval";"vm"],"NativeSocket") [
  3232. "select",StdSocket.select;
  3233. ] [
  3234. "accept",StdSocket.accept;
  3235. "bind",StdSocket.bind;
  3236. "close",StdSocket.close;
  3237. "connect",StdSocket.connect;
  3238. "host",StdSocket.host;
  3239. "listen",StdSocket.listen;
  3240. "peer",StdSocket.peer;
  3241. "receive",StdSocket.receive;
  3242. "receiveChar",StdSocket.receiveChar;
  3243. "send",StdSocket.send;
  3244. "sendChar",StdSocket.sendChar;
  3245. "setFastSend",StdSocket.setFastSend;
  3246. "setBroadcast", StdSocket.setBroadcast;
  3247. "setTimeout",StdSocket.setTimeout;
  3248. "shutdown",StdSocket.shutdown;
  3249. ];
  3250. init_fields builtins ([],"Std") [
  3251. "downcast",StdStd.downcast;
  3252. "instance",StdStd.instance;
  3253. "int",StdStd.int;
  3254. "is",StdStd.is';
  3255. "isOfType",StdStd.isOfType;
  3256. "parseFloat",StdStd.parseFloat;
  3257. "parseInt",StdStd.parseInt;
  3258. "string",StdStd.string;
  3259. "random",StdStd.random;
  3260. ] [];
  3261. init_fields builtins ([],"String") [
  3262. "fromCharCode",StdString.fromCharCode;
  3263. ] [
  3264. "charAt",StdString.charAt;
  3265. "charCodeAt",StdString.charCodeAt;
  3266. "indexOf",StdString.indexOf;
  3267. "lastIndexOf",StdString.lastIndexOf;
  3268. "split",StdString.split;
  3269. "substr",StdString.substr;
  3270. "substring",StdString.substring;
  3271. "toLowerCase",StdString.toLowerCase;
  3272. "toString",StdString.toString;
  3273. "toUpperCase",StdString.toUpperCase;
  3274. "cca",StdString.cca;
  3275. ];
  3276. init_fields builtins ([],"StringBuf") [] [
  3277. "add",StdStringBuf.add;
  3278. "addChar",StdStringBuf.addChar;
  3279. "addSub",StdStringBuf.addSub;
  3280. "get_length",StdStringBuf.get_length;
  3281. "toString",StdStringBuf.toString;
  3282. ];
  3283. init_fields builtins ([],"StringTools") [
  3284. "fastCodeAt",StdStringTools.fastCodeAt;
  3285. "replace",StdStringTools.replace;
  3286. "urlEncode",StdStringTools.urlEncode;
  3287. "urlDecode",StdStringTools.urlDecode;
  3288. ] [];
  3289. init_fields builtins ([],"Sys") [
  3290. "args",StdSys.args;
  3291. "_command",StdSys._command;
  3292. "cpuTime",StdSys.cpuTime;
  3293. "environment",StdSys.environment;
  3294. "exit",StdSys.exit;
  3295. "getChar",StdSys.getChar;
  3296. "getCwd",StdSys.getCwd;
  3297. "getEnv",StdSys.getEnv;
  3298. "print",StdSys.print;
  3299. "println",StdSys.println;
  3300. "programPath",StdSys.programPath;
  3301. "putEnv",StdSys.putEnv;
  3302. "setCwd",StdSys.setCwd;
  3303. "setTimeLocale",StdSys.setTimeLocale;
  3304. "sleep",StdSys.sleep;
  3305. "stderr",StdSys.stderr;
  3306. "stdin",StdSys.stdin;
  3307. "stdout",StdSys.stdout;
  3308. "systemName",StdSys.systemName;
  3309. "time",StdSys.time;
  3310. ] [];
  3311. init_fields builtins (["eval";"vm"],"NativeThread") [
  3312. "delay",StdThread.delay;
  3313. "exit",StdThread.exit;
  3314. "join",StdThread.join;
  3315. "readMessage",StdThread.readMessage;
  3316. "self",StdThread.self;
  3317. "yield",StdThread.yield;
  3318. ] [
  3319. "id",StdThread.id;
  3320. "get_events",StdThread.get_events;
  3321. "set_events",StdThread.set_events;
  3322. "kill",StdThread.kill;
  3323. "sendMessage",StdThread.sendMessage;
  3324. ];
  3325. init_fields builtins (["sys";"thread"],"Tls") [] [
  3326. "get_value",StdTls.get_value;
  3327. "set_value",StdTls.set_value;
  3328. ];
  3329. init_fields builtins ([],"Type") [
  3330. "allEnums",StdType.allEnums;
  3331. "createEmptyInstance",StdType.createEmptyInstance;
  3332. "createEnum",StdType.createEnum;
  3333. "createEnumIndex",StdType.createEnumIndex;
  3334. "createInstance",StdType.createInstance;
  3335. "enumConstructor",StdType.enumConstructor;
  3336. "enumEq",StdType.enumEq;
  3337. "enumIndex",StdType.enumIndex;
  3338. "enumParameters",StdType.enumParameters;
  3339. "getClass",StdType.getClass;
  3340. "getClassFields",StdType.getClassFields;
  3341. "getClassName",StdType.getClassName;
  3342. "getEnum",StdType.getEnum;
  3343. "getEnumConstructs",StdType.getEnumConstructs;
  3344. "getEnumName",StdType.getEnumName;
  3345. "getInstanceFields",StdType.getInstanceFields;
  3346. "getSuperClass",StdType.getSuperClass;
  3347. "resolveClass",StdType.resolveClass;
  3348. "resolveEnum",StdType.resolveEnum;
  3349. "typeof",StdType.typeof;
  3350. ] [];
  3351. init_fields builtins (["haxe";"zip"],"Uncompress") [
  3352. "run",StdUncompress.run;
  3353. ] [
  3354. "close",StdUncompress.close;
  3355. "execute",StdUncompress.execute;
  3356. "setFlushMode",StdUncompress.setFlushMode;
  3357. ];
  3358. init_fields builtins (["haxe"],"Utf8") [
  3359. "charCodeAt",StdUtf8.charCodeAt;
  3360. "compare",StdUtf8.compare;
  3361. "decode",StdUtf8.decode;
  3362. "encode",StdUtf8.encode;
  3363. "iter",StdUtf8.iter;
  3364. "length",StdUtf8.length;
  3365. "sub",StdUtf8.sub;
  3366. "validate",StdUtf8.validate;
  3367. ] [
  3368. "addChar",StdUtf8.addChar;
  3369. "toString",StdUtf8.toString;
  3370. ];
  3371. init_fields builtins (["eval";"_NativeString"],"NativeString_Impl_") [
  3372. "fromBytes",StdNativeString.from_bytes;
  3373. "fromString",StdNativeString.from_string;
  3374. "toBytes",StdNativeString.to_bytes;
  3375. "toString",StdNativeString.to_string;
  3376. "concat",StdNativeString.concat;
  3377. "char",StdNativeString.char;
  3378. "code",StdNativeString.code;
  3379. "get_length",StdNativeString.get_length;
  3380. "sub",StdNativeString.sub;
  3381. ] [];
  3382. init_fields builtins (["eval";"integers";"_UInt64"],"UInt64_Impl_") EvalIntegers.uint64_fields [];
  3383. init_fields builtins (["eval";"integers";"_Int64"],"Int64_Impl_") EvalIntegers.int64_fields [];
  3384. init_fields builtins (["eval";"luv";"_UVError"],"UVError_Impl_") EvalLuv.uv_error_fields [];
  3385. init_fields builtins (["eval";"luv";"_Loop"],"Loop_Impl_") EvalLuv.loop_fields [];
  3386. init_fields builtins (["eval";"luv";"_Loop"],"LoopOption_Impl_") ["sigprof",vint Luv.Loop.Option.sigprof] [];
  3387. init_fields builtins (["eval";"luv";"_Handle"],"Handle_Impl_") EvalLuv.handle_fields [];
  3388. init_fields builtins (["eval";"luv";"_Idle"], "Idle_Impl_") EvalLuv.idle_fields [];
  3389. init_fields builtins (["eval";"luv";"_Async"], "Async_Impl_") EvalLuv.async_fields [];
  3390. init_fields builtins (["eval";"luv";"_Timer"], "Timer_Impl_") EvalLuv.timer_fields [];
  3391. init_fields builtins (["eval";"luv";"_Buffer"], "Buffer_Impl_") EvalLuv.buffer_fields [];
  3392. init_fields builtins (["eval";"luv";"_SockAddr"], "SockAddr_Impl_") EvalLuv.sockaddr_fields [];
  3393. init_fields builtins (["eval";"luv";"_Tcp"], "Tcp_Impl_") EvalLuv.tcp_fields [];
  3394. init_fields builtins (["eval";"luv";"_Udp"], "Udp_Impl_") EvalLuv.udp_fields [];
  3395. init_fields builtins (["eval";"luv";"_ConnectedUdp"], "ConnectedUdp_Impl_") EvalLuv.connected_udp_fields [];
  3396. init_fields builtins (["eval";"luv";"_Pipe"], "Pipe_Impl_") EvalLuv.pipe_fields [];
  3397. init_fields builtins (["eval";"luv";"_Tty"], "Tty_Impl_") EvalLuv.tty_fields [];
  3398. init_fields builtins (["eval";"luv";"_Stream"], "Stream_Impl_") EvalLuv.stream_fields [];
  3399. init_fields builtins (["eval";"luv";"_Signal"], "Signal_Impl_") EvalLuv.signal_fields [];
  3400. init_fields builtins (["eval";"luv";"_Signal"], "SigNum_Impl_") EvalLuv.signum_fields [];
  3401. init_fields builtins (["eval";"luv";"_Process"], "Process_Impl_") EvalLuv.process_fields [];
  3402. init_fields builtins (["eval";"luv";"_Request"], "Request_Impl_") EvalLuv.request_fields [];
  3403. init_fields builtins (["eval";"luv"], "Dns") EvalLuv.dns_fields [];
  3404. init_fields builtins (["eval";"luv";"_File"], "File_Impl_") EvalLuv.file_fields [];
  3405. init_fields builtins (["eval";"luv";"_Dir"], "Dir_Impl_") EvalLuv.dir_fields [];
  3406. init_fields builtins (["eval";"luv"], "FileSync") EvalLuv.file_sync_fields [];
  3407. init_fields builtins (["eval";"luv"], "DirSync") EvalLuv.dir_sync_fields [];
  3408. init_fields builtins (["eval";"luv";"_FsEvent"], "FsEvent_Impl_") EvalLuv.fs_event_fields [];
  3409. init_fields builtins (["eval";"luv"], "ThreadPool") EvalLuv.thread_pool_fields [];
  3410. init_fields builtins (["eval";"luv";"_Thread"], "Thread_Impl_") EvalLuv.thread_fields [];
  3411. init_fields builtins (["eval";"luv";"_Once"], "Once_Impl_") EvalLuv.once_fields [];
  3412. init_fields builtins (["eval";"luv";"_Mutex"], "Mutex_Impl_") EvalLuv.mutex_fields [];
  3413. init_fields builtins (["eval";"luv";"_RwLock"], "RwLock_Impl_") EvalLuv.rwlock_fields [];
  3414. init_fields builtins (["eval";"luv";"_Semaphore"], "Semaphore_Impl_") EvalLuv.semaphore_fields [];
  3415. init_fields builtins (["eval";"luv";"_Condition"], "Condition_Impl_") EvalLuv.condition_fields [];
  3416. init_fields builtins (["eval";"luv";"_Barrier"], "Barrier_Impl_") EvalLuv.barrier_fields [];
  3417. init_fields builtins (["eval";"luv"], "Env") EvalLuv.env_fields [];
  3418. init_fields builtins (["eval";"luv"], "Time") EvalLuv.time_fields [];
  3419. init_fields builtins (["eval";"luv"], "Path") EvalLuv.path_fields [];
  3420. init_fields builtins (["eval";"luv"], "Random") EvalLuv.random_fields [];
  3421. init_fields builtins (["eval";"luv"], "RandomSync") EvalLuv.random_sync_fields [];
  3422. init_fields builtins (["eval";"luv"], "Network") EvalLuv.network_fields [];
  3423. init_fields builtins (["eval";"luv";"_FsPoll"], "FsPoll_Impl_") EvalLuv.fs_poll_fields [];
  3424. init_fields builtins (["eval";"luv"], "Resource") EvalLuv.resource_fields [];
  3425. init_fields builtins (["eval";"luv"], "SystemInfo") EvalLuv.system_info_fields [];
  3426. init_fields builtins (["eval";"luv"], "Pid") EvalLuv.pid_fields [];
  3427. init_fields builtins (["eval";"luv"], "Passwd") EvalLuv.passwd_fields [];
  3428. init_fields builtins (["eval";"luv"], "Metrics") EvalLuv.metrics_fields [];
  3429. init_fields builtins (["eval";"luv";"_Prepare"], "Prepare_Impl_") EvalLuv.prepare_fields [];
  3430. init_fields builtins (["eval";"luv";"_Check"], "Check_Impl_") EvalLuv.check_fields [];
  3431. init_fields builtins (["eval";"luv"], "Version") EvalLuv.version_fields [];
  3432. EvalSsl.init_fields init_fields builtins